connection.ml

   1
   2 (*************************************************************************)
   3 (* This program is free software: you can redistribute it and/or modify  *)
   4 (* it under the terms of the version 3 of the GNU General Public License *)
   5 (* as published by the Free Software Foundation.                         *)
   6 (*                                                                       *)
   7 (* This program is distributed in the hope that it will be useful, but   *)
   8 (* WITHOUT ANY WARRANTY; without even the implied warranty of            *)
   9 (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      *)
  10 (* General Public License for more details.                              *)
  11 (*                                                                       *)
  12 (* You should have received a copy of the GNU General Public License     *)
  13 (* along with this program. If not, see <http://www.gnu.org/licenses/>.  *)
  14 (*                                                                       *)
  15 (* Written and (C) by Francois Fleuret                                   *)
  16 (* Contact <francois.fleuret@idiap.ch> for comments & bug reports        *)
  17 (*************************************************************************)
  18
  19 let buffer_length = 4096
  20
  21 exception Network_error of string
  22
  23 let bytes_of_int n =
  24   let s = "0000" in
  25   String.set s 3 (char_of_int (n land 255));
  26   String.set s 2 (char_of_int ((n lsr 8) land 255));
  27   String.set s 1 (char_of_int ((n lsr 16) land 255));
  28   String.set s 0 (char_of_int ((n lsr 24) land 255));
  29   s;;
  30
  31 let int_of_bytes s =
  32   try
  33     int_of_char (String.get s 3) +
  34       256 * (int_of_char (String.get s 2) +
  35                256 * (int_of_char (String.get s 1) +
  36                         256 * int_of_char (String.get s 0)))
  37   with
  38     _ -> -1;;
  39
  40 (* What a shame that I have to do this ... *)
  41
  42 let dot_to_number s =
  43   let rec decode_rec k =
  44   try
  45     let l = String.index_from s k '.' in (int_of_string (String.sub s k (l-k)))::(decode_rec (l+1))
  46   with
  47     Not_found -> [ int_of_string (String.sub s k ((String.length s) - k)) ]
  48   in
  49   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)
  50   in Int64.to_string k;;
  51
  52 let connect (hostname: string) (port: int) =
  53   try
  54     let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  55     Unix.connect s (Unix.ADDR_INET(((Unix.gethostbyname hostname).Unix.h_addr_list).(0), port));
  56     s
  57   with
  58     Not_found -> raise (Network_error("Unknown host " ^ hostname))
  59   | Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
  60
  61 let listen port =
  62   try
  63     let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  64     Unix.bind s (Unix.ADDR_INET(Unix.inet_addr_any, port));
  65     Unix.listen s 4;
  66     s
  67   with
  68     Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
  69
  70 type rstream = { rdescr: Unix.file_descr; buffer: string; mutable pos: int }
  71
  72 let read_lines (rc: rstream) (reader: string -> unit) =
  73   try
  74     (* We read as much available characters as we can to fill up the
  75     buffer *)
  76     let s = Unix.read rc.rdescr rc.buffer rc.pos (buffer_length - rc.pos) in
  77     if s <= 0
  78     then raise (Network_error((string_of_int s) ^ " character(s) read"))
  79     else rc.pos <- rc.pos + s;
  80     (* the 'read' function applies the reader to the new lines we got,
  81     starting at character 'current' *)
  82     let rec read current =
  83       try
  84         (* if we are already after the end, finish *)
  85         if(current >= rc.pos) then raise Not_found;
  86         (* Look for a \n in the remaining part of the buffer *)
  87         let cr = (String.index_from rc.buffer current '\n') in
  88         (* If it is afte`r the 'fresh' data, it means we do not have \n
  89         remaining, raise a Not_found *)
  90         if (cr >= rc.pos) then raise Not_found;
  91         (* We have found a \n, applies the reader to the line it ends *)
  92         reader (String.sub rc.buffer current (cr - current));
  93         read (cr+1)
  94       with
  95         (* No more lines in the buffer *)
  96         Not_found ->
  97           (* moves the remaining characters to the beginning of the buffer *)
  98           if(current < rc.pos) then String.blit rc.buffer current rc.buffer 0 (rc.pos - current);
  99           (* refreshes the index where to put next incoming characters *)
 100           rc.pos <- (rc.pos - current);
 101     in read 0
 102   with
 103     Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)))
 104
 105 let linizer = fun (d: Unix.file_descr) (reader: string -> unit) () ->
 106   read_lines { rdescr = d; buffer = String.create buffer_length; pos = 0 } reader;;
 107
 108 let read_binary (fd: Unix.file_descr) (reader: string -> unit) =
 109   try
 110     let buffer = String.create buffer_length in
 111     let s = Unix.read fd buffer 0 buffer_length in
 112     if s <= 0
 113     then raise (Network_error((string_of_int s) ^ " character(s) read"));
 114     reader (String.sub buffer 0 s)
 115   with
 116     Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)));;
 117
 118 let binarizer = fun (d: Unix.file_descr) (reader: string -> unit) () -> read_binary d reader;;
 119
 120 (******************************************************************************)
 121 (* A tokenizer takes a string and a separator and returns two functions       *)
 122 (* unit -> string, the first returning the tokens one after another, and the  *)
 123 (* second returning the remaining part of the string.                         *)
 124 (******************************************************************************)
 125
 126 let (tokenizer: string -> char -> (unit -> string) * (unit -> string)) = fun line c ->
 127
 128 let index = ref 0 in
 129
 130 let token () = let n = !index in
 131 try
 132   let m = (String.index_from line n c) in
 133   index := m + 1;
 134   while !index < (String.length line) && (String.get line !index = c) do index := !index+1; done;
 135   String.sub (line) n (m - n)
 136 with
 137   Not_found -> if !index < (String.length line)
 138   then begin
 139     index := (String.length line);
 140     String.sub (line) n (!index - n)
 141   end
 142   else raise Not_found
 143
 144 and tail () =
 145   if !index < (String.length line)
 146   then let n = !index in (index := (String.length line); String.sub (line) n (!index - n))
 147   else raise Not_found
 148
 149 in (token, tail);;