1 (* -*- mode: tuareg -*- ******************************************************)
3 (* Written by and (c) Francois Fleuret, 2002 *)
4 (* Contact <francois.fleuret@inria.fr> for info and bug reports *)
6 (* This program is free software; you can redistribute it and/or modify *)
7 (* it under the terms of the GNU General Public License as published by *)
8 (* the Free Software Foundation. See the file LICENSE for more details. *)
10 (*****************************************************************************)
12 let buffer_length = 4096
14 exception Network_error of string
18 String.set s 3 (char_of_int (n land 255));
19 String.set s 2 (char_of_int ((n lsr 8) land 255));
20 String.set s 1 (char_of_int ((n lsr 16) land 255));
21 String.set s 0 (char_of_int ((n lsr 24) land 255));
26 int_of_char (String.get s 3) +
27 256 * (int_of_char (String.get s 2) +
28 256 * (int_of_char (String.get s 1) +
29 256 * int_of_char (String.get s 0)))
33 (* What a shame that I have to do this ... *)
36 let rec decode_rec k =
38 let l = String.index_from s k '.' in (int_of_string (String.sub s k (l-k)))::(decode_rec (l+1))
40 Not_found -> [ int_of_string (String.sub s k ((String.length s) - k)) ]
42 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)
43 in Int64.to_string k;;
45 let connect (hostname: string) (port: int) =
47 let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
48 Unix.connect s (Unix.ADDR_INET(((Unix.gethostbyname hostname).Unix.h_addr_list).(0), port));
51 Not_found -> raise (Network_error("Unknown host " ^ hostname))
52 | Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
56 let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
57 Unix.bind s (Unix.ADDR_INET(Unix.inet_addr_any, port));
61 Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
63 type rstream = { rdescr: Unix.file_descr; buffer: string; mutable pos: int }
65 let read_lines (rc: rstream) (reader: string -> unit) =
67 (* We read as much available characters as we can to fill up the
69 let s = Unix.read rc.rdescr rc.buffer rc.pos (buffer_length - rc.pos) in
71 then raise (Network_error((string_of_int s) ^ " character(s) read"))
72 else rc.pos <- rc.pos + s;
73 (* the 'read' function applies the reader to the new lines we got,
74 starting at character 'current' *)
75 let rec read current =
77 (* if we are already after the end, finish *)
78 if(current >= rc.pos) then raise Not_found;
79 (* Look for a \n in the remaining part of the buffer *)
80 let cr = (String.index_from rc.buffer current '\n') in
81 (* If it is afte`r the 'fresh' data, it means we do not have \n
82 remaining, raise a Not_found *)
83 if (cr >= rc.pos) then raise Not_found;
84 (* We have found a \n, applies the reader to the line it ends *)
85 reader (String.sub rc.buffer current (cr - current));
88 (* No more lines in the buffer *)
90 (* moves the remaining characters to the beginning of the buffer *)
91 if(current < rc.pos) then String.blit rc.buffer current rc.buffer 0 (rc.pos - current);
92 (* refreshes the index where to put next incoming characters *)
93 rc.pos <- (rc.pos - current);
96 Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)))
98 let linizer = fun (d: Unix.file_descr) (reader: string -> unit) () ->
99 read_lines { rdescr = d; buffer = String.create buffer_length; pos = 0 } reader;;
101 let read_binary (fd: Unix.file_descr) (reader: string -> unit) =
103 let buffer = String.create buffer_length in
104 let s = Unix.read fd buffer 0 buffer_length in
106 then raise (Network_error((string_of_int s) ^ " character(s) read"));
107 reader (String.sub buffer 0 s)
109 Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)));;
111 let binarizer = fun (d: Unix.file_descr) (reader: string -> unit) () -> read_binary d reader;;
113 (******************************************************************************)
114 (* A tokenizer takes a string and a separator and returns two functions *)
115 (* unit -> string, the first returning the tokens one after another, and the *)
116 (* second returning the remaining part of the string. *)
117 (******************************************************************************)
119 let (tokenizer: string -> char -> (unit -> string) * (unit -> string)) = fun line c ->
123 let token () = let n = !index in
125 let m = (String.index_from line n c) in
127 while !index < (String.length line) && (String.get line !index = c) do index := !index+1; done;
128 String.sub (line) n (m - n)
130 Not_found -> if !index < (String.length line)
132 index := (String.length line);
133 String.sub (line) n (!index - n)
138 if !index < (String.length line)
139 then let n = !index in (index := (String.length line); String.sub (line) n (!index - n))