X-Git-Url: https://fleuret.org/cgi-bin/gitweb/gitweb.cgi?p=ircml.git;a=blobdiff_plain;f=connection.ml;fp=connection.ml;h=156401e444a0ea4d09b9189c963ed37905061c3b;hp=0000000000000000000000000000000000000000;hb=41ed4cf0af1eab1c7b14246f8e1e09fd7b8f3ac9;hpb=269a81852a0c30b83f32eb997de5483558eaafc2 diff --git a/connection.ml b/connection.ml new file mode 100644 index 0000000..156401e --- /dev/null +++ b/connection.ml @@ -0,0 +1,142 @@ +(* -*- mode: tuareg -*- ******************************************************) +(* *) +(* Written by and (c) Francois Fleuret, 2002 *) +(* Contact 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);;