src/networks/bittorrent/kademlia.ml

   1 (** Generic implementation of Kademlia *)
   2
   3 let k = 8
   4
   5 module H = Md4.Sha1
   6
   7 let pr fmt = Printf.ksprintf print_endline fmt
   8
   9 let () =
  10   let hash = H.random () in
  11   pr "len: %d up: %x %x %x" H.length (H.up hash) (H.up2 hash) (H.up3 hash);
  12   pr "string: %s" (H.to_string hash);
  13   pr "direct: %S" (H.direct_to_string hash);
  14   pr "hexa: %s" (H.to_hexa hash);
  15   pr "bits: %s" (H.to_bits hash);
  16   pr "base32: %s" (H.to_base32 hash);
  17
  18 (** node ID type *)
  19 type id = H.t
  20 let show_id = H.to_hexa
  21 type addr = Ip.t * int
  22
  23 type time = float
  24 type status = | Good | Bad | Unknown | Pinged
  25 type node = { id : id; addr : addr; mutable last : time; mutable status : status; }
  26 type bucket = { lo : id; hi : id; mutable last_change : time; nodes : node array; }
  27 type table = L of bucket | N of table * table
  28
  29 let show_addr (ip,port) = Printf.sprintf "%s:%u" (Ip.to_string ip) port
  30
  31 let show_status = function
  32   | Good -> "good"
  33   | Bad -> "bad"
  34   | Unknown -> "unk"
  35   | Pinged -> "ping"
  36
  37 let show_node n =
  38   pr " id : %s inet %s last : %f status : %s"
  39     (H.to_hexa n.id) (show_addr n.addr) n.last (show_status n.status)
  40
  41 let show_bucket b =
  42   pr "lo : %s hi : %s changed : %f" (H.to_hexa b.lo) (H.to_hexa b.hi) b.last_change;
  43   Array.iter show_node b.nodes
  44
  45 let rec show_table = function
  46   | N (l,r) -> show_table l; show_table r
  47   | L b -> show_bucket b
  48
  49 let h2s h =
  50   let s = H.direct_to_string h in
  51   assert (String.length s = H.length);
  52   s
  53
  54 type cmp = LT | EQ | GT
  55
  56 let cmp id1 id2 =
  57   match String.compare (h2s id1) (h2s id2) with
  58   | -1 -> LT
  59   | 0 -> EQ
  60   | 1 -> GT
  61   | _ -> assert false
  62
  63 (* boundaries inclusive *)
  64 let between x lo hi = not (cmp x lo = LT || cmp x hi = GT)
  65
  66 let bracket res destroy k =
  67   let x = try k res with exn -> destroy res; raise exn in
  68   destroy res;
  69   x
  70
  71 let with_open_in_bin file = bracket (open_in_bin file) close_in_noerr
  72 let with_open_out_bin file = bracket (open_out_bin file) close_out_noerr
  73
  74 let load file : table = with_open_in_bin file Marshal.from_channel
  75 let store file (t:table) = with_open_out_bin file (fun ch -> Marshal.to_channel ch t [])
  76
  77 let middle =
  78   let s = String.make 20 (Char.chr 0xFF) in
  79   s.[0] <- Char.chr 0x7F;
  80   H.direct_of_string s
  81
  82 let middle' =
  83   let s = String.make 20 (Char.chr 0x00) in
  84   s.[0] <- Char.chr 0x80;
  85   H.direct_of_string s
  86
  87 let last =
  88   H.direct_of_string (String.make 20 (Char.chr 0xFF))
  89
  90 open Big_int
  91
  92 let big_int_of_hash h =
  93   let s = h2s h in
  94   let n = ref zero_big_int in
  95   for i = 0 to String.length s - 1 do
  96     n := add_int_big_int (Char.code s.[i]) (mult_int_big_int 256 !n)
  97   done;
  98   !n
  99
 100 let hash_of_big_int n =
 101   let s = String.create H.length in
 102   let n = ref n in
 103   let div = big_int_of_int 256 in
 104   for i = String.length s - 1 downto 0 do
 105     let (d,m) = quomod_big_int !n div in
 106     s.[i] <- Char.chr (int_of_big_int m);
 107     n := d
 108   done;
 109   assert (eq_big_int zero_big_int !n);
 110   H.direct_of_string s
 111
 112 (* hash <-> number *)
 113 let h2n = big_int_of_hash
 114 let n2h = hash_of_big_int
 115
 116 let split lo hi =
 117   assert (cmp lo hi = LT);
 118   let mid = div_big_int (add_big_int (h2n lo) (h2n hi)) (big_int_of_int 2) in
 119   n2h mid
 120
 121 let distance h1 h2 =
 122   let s1 = h2s h1 and s2 = h2s h2 in
 123   let d = ref zero_big_int in
 124   for i = 0 to H.length - 1 do
 125     let x = Char.code s1.[i] lxor Char.code s2.[i] in
 126     d := add_int_big_int x (mult_int_big_int 256 !d)
 127   done;
 128   !d
 129
 130 let () =
 131   print_endline (show_id H.null);
 132   print_endline (show_id middle);
 133   print_endline (show_id middle');
 134   print_endline (show_id last);
 135   assert (LT = cmp H.null middle);
 136   assert (LT = cmp H.null middle');
 137   assert (LT = cmp H.null last);
 138   assert (GT = cmp middle' middle);
 139   assert (GT = cmp last middle');
 140   assert (GT = cmp last middle);
 141   assert (EQ = cmp H.null H.null);
 142   assert (EQ = cmp middle middle);
 143   assert (EQ = cmp last last);
 144   assert (n2h (h2n middle) = middle);
 145   assert (n2h (h2n middle') = middle');
 146   assert (n2h (h2n last) = last);
 147   assert (n2h (h2n H.null) = H.null);
 148   assert (compare_big_int (h2n H.null) zero_big_int = 0);
 149   assert (cmp (split H.null last) middle = EQ);
 150   assert (eq_big_int (distance H.null last) (pred_big_int (power_int_positive_int 2 160)));
 151   assert (eq_big_int (distance middle' middle) (pred_big_int (power_int_positive_int 2 160)));
 152   ()
 153
 154 let now = Unix.gettimeofday
 155
 156 let empty () = L { lo = H.null; hi = middle; last_change = now (); nodes = [||]; }
 157
 158 let table = ref (empty ())
 159
 160 let () =
 161   show_table !table
 162