connection.ml

   1 (* -*- mode: tuareg -*- ******************************************************)
   2 (*                                                                           *)
   3 (*   Written by and (c) Francois Fleuret, 2002                               *)
   4 (*   Contact <francois.fleuret@inria.fr> for info and bug reports            *)
   5 (*                                                                           *)
   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.    *)
   9 (*                                                                           *)
  10 (*****************************************************************************)
  11
  12 let buffer_length = 4096
  13
  14 exception Network_error of string
  15
  16 let bytes_of_int n =
  17   let s = "0000" in
  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));
  22   s;;
  23
  24 let int_of_bytes s =
  25   try
  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)))
  30   with
  31     _ -> -1;;
  32
  33 (* What a shame that I have to do this ... *)
  34
  35 let dot_to_number s =
  36   let rec decode_rec k =
  37   try
  38     let l = String.index_from s k '.' in (int_of_string (String.sub s k (l-k)))::(decode_rec (l+1))
  39   with
  40     Not_found -> [ int_of_string (String.sub s k ((String.length s) - k)) ]
  41   in
  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;;
  44
  45 let connect (hostname: string) (port: int) =
  46   try
  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));
  49     s
  50   with
  51     Not_found -> raise (Network_error("Unknown host " ^ hostname))
  52   | Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
  53
  54 let listen port =
  55   try
  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));
  58     Unix.listen s 4;
  59     s
  60   with
  61     Unix.Unix_error(e, fname, fparam) -> raise (Network_error(fname ^ ": " ^ Unix.error_message(e)))
  62
  63 type rstream = { rdescr: Unix.file_descr; buffer: string; mutable pos: int }
  64
  65 let read_lines (rc: rstream) (reader: string -> unit) =
  66   try
  67     (* We read as much available characters as we can to fill up the
  68     buffer *)
  69     let s = Unix.read rc.rdescr rc.buffer rc.pos (buffer_length - rc.pos) in
  70     if s <= 0
  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 =
  76       try
  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));
  86         read (cr+1)
  87       with
  88         (* No more lines in the buffer *)
  89         Not_found ->
  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);
  94     in read 0
  95   with
  96     Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)))
  97
  98 let linizer = fun (d: Unix.file_descr) (reader: string -> unit) () ->
  99   read_lines { rdescr = d; buffer = String.create buffer_length; pos = 0 } reader;;
 100
 101 let read_binary (fd: Unix.file_descr) (reader: string -> unit) =
 102   try
 103     let buffer = String.create buffer_length in
 104     let s = Unix.read fd buffer 0 buffer_length in
 105     if s <= 0
 106     then raise (Network_error((string_of_int s) ^ " character(s) read"));
 107     reader (String.sub buffer 0 s)
 108   with
 109     Unix.Unix_error(e, fname, fparam) -> raise (Network_error (fname ^ ": " ^ (Unix.error_message e)));;
 110
 111 let binarizer = fun (d: Unix.file_descr) (reader: string -> unit) () -> read_binary d reader;;
 112
 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 (******************************************************************************)
 118
 119 let (tokenizer: string -> char -> (unit -> string) * (unit -> string)) = fun line c ->
 120
 121 let index = ref 0 in
 122
 123 let token () = let n = !index in
 124 try
 125   let m = (String.index_from line n c) in
 126   index := m + 1;
 127   while !index < (String.length line) && (String.get line !index = c) do index := !index+1; done;
 128   String.sub (line) n (m - n)
 129 with
 130   Not_found -> if !index < (String.length line)
 131   then begin
 132     index := (String.length line);
 133     String.sub (line) n (!index - n)
 134   end
 135   else raise Not_found
 136
 137 and tail () =
 138   if !index < (String.length line)
 139   then let n = !index in (index := (String.length line); String.sub (line) n (!index - n))
 140   else raise Not_found
 141
 142 in (token, tail);;