--- /dev/null
+(* -*- mode: tuareg -*- ******************************************************)
+(* *)
+(* Written by and (c) Francois Fleuret, 2002 *)
+(* Contact <francois.fleuret@inria.fr> for info and bug reports *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License as published by *)
+(* the Free Software Foundation. See the file LICENSE for more details. *)
+(* *)
+(*****************************************************************************)
+
+let buffer_length = 4096
+
+exception Network_error of string
+
+let bytes_of_int n =
+ let s = "0000" in
+ String.set s 3 (char_of_int (n land 255));
+ String.set s 2 (char_of_int ((n lsr 8) land 255));
+ String.set s 1 (char_of_int ((n lsr 16) land 255));
+ String.set s 0 (char_of_int ((n lsr 24) land 255));
+ s;;
+
+let int_of_bytes s =
+ try
+ int_of_char (String.get s 3) +
+ 256 * (int_of_char (String.get s 2) +
+ 256 * (int_of_char (String.get s 1) +
+ 256 * int_of_char (String.get s 0)))
+ with
+ _ -> -1;;
+
+(* What a shame that I have to do this ... *)
+
+let dot_to_number s =
+ let rec decode_rec k =
+ try
+ let l = String.index_from s k '.' in (int_of_string (String.sub s k (l-k)))::(decode_rec (l+1))
+ with
+ Not_found -> [ int_of_string (String.sub s k ((String.length s) - k)) ]
+ in
+ let k = List.fold_left (fun x y -> Int64.add (Int64.mul (Int64.of_int 256) x) (Int64.of_int y)) Int64.zero (decode_rec 0)
+ in Int64.to_string k;;
+
+let connect (hostname: string) (port: int) =
+ try
+ let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+ Unix.connect s (Unix.ADDR_INET(((Unix.gethostbyname hostname).Unix.h_addr_list).(0), port));
+ s
+ with
+ Not_found -> raise (Network_error("Unknown host " ^ hostname))
+ | Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
+
+let listen port =
+ try
+ let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+ Unix.bind s (Unix.ADDR_INET(Unix.inet_addr_any, port));
+ Unix.listen s 4;
+ s
+ with
+ Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
+
+type rstream = { rdescr: Unix.file_descr; buffer: string; mutable pos: int }
+
+let read_lines (rc: rstream) (reader: string -> unit) =
+ try
+ (* We read as much available characters as we can to fill up the
+ buffer *)
+ let s = Unix.read rc.rdescr rc.buffer rc.pos (buffer_length - rc.pos) in
+ if s <= 0
+ then raise (Network_error((string_of_int s) ^ " character(s) read"))
+ else rc.pos <- rc.pos + s;
+ (* the 'read' function applies the reader to the new lines we got,
+ starting at character 'current' *)
+ let rec read current =
+ try
+ (* if we are already after the end, finish *)
+ if(current >= rc.pos) then raise Not_found;
+ (* Look for a \n in the remaining part of the buffer *)
+ let cr = (String.index_from rc.buffer current '\n') in
+ (* If it is afte`r the 'fresh' data, it means we do not have \n
+ remaining, raise a Not_found *)
+ if (cr >= rc.pos) then raise Not_found;
+ (* We have found a \n, applies the reader to the line it ends *)
+ reader (String.sub rc.buffer current (cr - current));
+ read (cr+1)
+ with
+ (* No more lines in the buffer *)
+ Not_found ->
+ (* moves the remaining characters to the beginning of the buffer *)
+ if(current < rc.pos) then String.blit rc.buffer current rc.buffer 0 (rc.pos - current);
+ (* refreshes the index where to put next incoming characters *)
+ rc.pos <- (rc.pos - current);
+ in read 0
+ with
+ Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)))
+
+let linizer = fun (d: Unix.file_descr) (reader: string -> unit) () ->
+ read_lines { rdescr = d; buffer = String.create buffer_length; pos = 0 } reader;;
+
+let read_binary (fd: Unix.file_descr) (reader: string -> unit) =
+ try
+ let buffer = String.create buffer_length in
+ let s = Unix.read fd buffer 0 buffer_length in
+ if s <= 0
+ then raise (Network_error((string_of_int s) ^ " character(s) read"));
+ reader (String.sub buffer 0 s)
+ with
+ Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)));;
+
+let binarizer = fun (d: Unix.file_descr) (reader: string -> unit) () -> read_binary d reader;;
+
+(******************************************************************************)
+(* A tokenizer takes a string and a separator and returns two functions *)
+(* unit -> string, the first returning the tokens one after another, and the *)
+(* second returning the remaining part of the string. *)
+(******************************************************************************)
+
+let (tokenizer: string -> char -> (unit -> string) * (unit -> string)) = fun line c ->
+
+let index = ref 0 in
+
+let token () = let n = !index in
+try
+ let m = (String.index_from line n c) in
+ index := m + 1;
+ while !index < (String.length line) && (String.get line !index = c) do index := !index+1; done;
+ String.sub (line) n (m - n)
+with
+ Not_found -> if !index < (String.length line)
+ then begin
+ index := (String.length line);
+ String.sub (line) n (!index - n)
+ end
+ else raise Not_found
+
+and tail () =
+ if !index < (String.length line)
+ then let n = !index in (index := (String.length line); String.sub (line) n (!index - n))
+ else raise Not_found
+
+in (token, tail);;
projects / ircml.git / blobdiff