src/networks/donkey/donkeyNodesDat.mlp

   1
   2 open Printf2
   3 open CommonOptions
   4 open Bitstring
   5
   6 let lprintf_nl fmt = lprintf_nl2 "[NODES]" fmt
   7
   8 (* see http://wiki.amule.org/index.php/Nodes.dat_file *)
   9
  10 let parse filename f =
  11   bitmatch bitstring_of_file filename with
  12   | { 0l : 32; 02l : 32 : littleendian; count : 32 : littleendian, bind(Int32.to_int count);
  13       nodes : 34 * 8 * count : bitstring ; rest : -1 : bitstring
  14     } when bitstring_length rest = 0
  15     ->
  16       let () = for i = 0 to pred count do
  17         (bitmatch subbitstring nodes (34 * 8 * i) (34 * 8) with
  18         | { id : 16 * 8 : string;
  19             ip1 : 8; ip2 : 8; ip3 : 8; ip4 : 8; (* littleendian *)
  20             udp : 16 : littleendian;
  21             tcp : 16 : littleendian;
  22             version : 8;
  23             key : 8 * 8 : string;
  24             verified : 8
  25           } ->
  26             let ip = Ip.of_ints (ip4,ip3,ip2,ip1) in
  27             if !verbose_overnet then
  28               lprintf_nl "v2: id %S ip %s udp %d tcp %d ver %d key %S chk %d"
  29                          id (Ip.to_string ip) udp tcp version key verified;
  30             f ip udp
  31         | { } -> failwith "v2: bad contact"
  32         )
  33       done in ()
  34   | { count : 32 : littleendian, bind(Int32.to_int count);
  35       nodes : 25 * 8 * count : bitstring;
  36       rest : -1 : bitstring
  37     } when bitstring_length rest = 0
  38     ->
  39       let () = for i = 0 to pred count do
  40         (bitmatch subbitstring nodes (25 * 8 * i) (25 * 8) with
  41         | { id : 16 * 8 : string;
  42             ip1 : 8; ip2 : 8; ip3 : 8; ip4 : 8; (* littleendian *)
  43             udp : 16 : littleendian;
  44             tcp : 16 : littleendian;
  45             typ : 8
  46           } ->
  47             let ip = Ip.of_ints (ip4,ip3,ip2,ip1) in
  48             if !verbose_overnet then
  49               lprintf_nl "v0: id %S ip %s udp %d tcp %d typ %d" id (Ip.to_string ip) udp tcp typ;
  50             f ip udp
  51         | { } -> failwith "v0: bad contact"
  52         )
  53       done in ()
  54   | { } -> failwith "nodes.dat bad header"
  55