src/networks/donkey/donkeyProtoKademlia.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open Printf2
  21 open Md4
  22 open Options
  23
  24 open AnyEndian
  25 open BasicSocket
  26 open LittleEndian
  27
  28 open CommonOptions
  29 open CommonTypes
  30 open CommonGlobals
  31
  32 open DonkeyMftp
  33 open DonkeyOvernet
  34 open DonkeyOptions
  35
  36 module P = struct
  37
  38     let log_prefix = "[KAD]"
  39
  40     let lprintf_nl fmt =
  41       lprintf_nl2 log_prefix fmt
  42
  43     let lprintf_n fmt =
  44       lprintf2 log_prefix fmt
  45
  46     let lprintf fmt =
  47       lprintf2 log_prefix fmt
  48
  49     let names_of_tag =
  50       [
  51         "\243", Field_KNOWN "encryption"; (* 0xF3 *)
  52         "\248", Field_KNOWN "buddyhash"; (* 0xF8 *)
  53         "\249", Field_KNOWN "clientlowid"; (* 0xF9 *)
  54         "\250", Field_KNOWN "serverport"; (* 0xFA *)
  55         "\251", Field_KNOWN "serverip";   (* 0xFB *)
  56         "\252", Field_KNOWN "sourceuport"; (* 0xFC *)
  57         "\253", Field_KNOWN "sourceport"; (* 0xFD *)
  58         "\254", Field_KNOWN "sourceip"; (* 0xFE *)
  59         "\255", Field_KNOWN "sourcetype";  (* 0xFF *)
  60       ] @ file_common_tags
  61
  62 (* This fucking Emule implementation uses 4 32-bits integers instead of
  63   16 8-bits integers... welcome back to the non-portability problems... *)
  64     let get_md4 s pos =
  65       let ss = String.create 16 in
  66
  67       ss.[0] <- s.[pos+3];
  68       ss.[1] <- s.[pos+2];
  69       ss.[2] <- s.[pos+1];
  70       ss.[3] <- s.[pos+0];
  71
  72       ss.[4] <- s.[pos+7];
  73       ss.[5] <- s.[pos+6];
  74       ss.[6] <- s.[pos+5];
  75       ss.[7] <- s.[pos+4];
  76
  77       ss.[8] <- s.[pos+11];
  78       ss.[9] <- s.[pos+10];
  79       ss.[10] <- s.[pos+9];
  80       ss.[11] <- s.[pos+8];
  81
  82       ss.[12] <- s.[pos+15];
  83       ss.[13] <- s.[pos+14];
  84       ss.[14] <- s.[pos+13];
  85       ss.[15] <- s.[pos+12];
  86
  87       Md4.direct_of_string @@ Bytes.unsafe_to_string ss
  88
  89     let buf_md4 buf s =
  90       let s = Md4.direct_to_string s in
  91
  92       let ss = String.create 16 in
  93       let pos = 0 in
  94
  95       ss.[0] <- s.[pos+3];
  96       ss.[1] <- s.[pos+2];
  97       ss.[2] <- s.[pos+1];
  98       ss.[3] <- s.[pos+0];
  99
 100       ss.[4] <- s.[pos+7];
 101       ss.[5] <- s.[pos+6];
 102       ss.[6] <- s.[pos+5];
 103       ss.[7] <- s.[pos+4];
 104
 105       ss.[8] <- s.[pos+11];
 106       ss.[9] <- s.[pos+10];
 107       ss.[10] <- s.[pos+9];
 108       ss.[11] <- s.[pos+8];
 109
 110       ss.[12] <- s.[pos+15];
 111       ss.[13] <- s.[pos+14];
 112       ss.[14] <- s.[pos+13];
 113       ss.[15] <- s.[pos+12];
 114
 115       Buffer.add_bytes buf ss
 116
 117
 118 (* Strange: why was the IP format changed for Kademlia ? *)
 119     let get_ip s pos =
 120       let c1 = int_of_char s.[pos] in
 121       let c2 = int_of_char s.[pos+1] in
 122       let c3 = int_of_char s.[pos+2] in
 123       let c4 = int_of_char s.[pos+3] in
 124       Ip.of_ints (c4, c3, c2, c1)
 125
 126     let buf_ip buf ip =
 127       let (ip3,ip2,ip1,ip0) = Ip.to_ints ip in
 128       buf_int8 buf ip0;
 129       buf_int8 buf ip1;
 130       buf_int8 buf ip2;
 131       buf_int8 buf ip3
 132
 133     let buf_peer buf p =
 134       buf_md4 buf p.peer_md4;
 135       buf_ip buf p.peer_ip;
 136       buf_int16 buf p.peer_port;
 137       buf_int16 buf p.peer_tcpport;
 138       buf_int8 buf p.peer_kind
 139
 140     let write buf t =
 141       match t with
 142       | OvernetConnect p ->
 143           buf_int8 buf 0x00;
 144           buf_peer buf p
 145
 146       | OvernetConnectReply peers ->
 147           buf_int8 buf 0x08;
 148           buf_int16 buf (List.length peers);
 149           List.iter (buf_peer buf) peers
 150
 151       | OvernetPublicize p ->
 152           buf_int8 buf 0x10;
 153           buf_peer buf p
 154
 155       | OvernetPublicized (Some p) ->
 156           buf_int8 buf 0x18;
 157           buf_peer buf p
 158
 159       | OvernetSearch (nresults, target, Some uid) ->
 160           buf_int8 buf 0x20;
 161           buf_int8 buf (nresults land 0x1f);
 162           buf_md4 buf target;
 163           buf_md4 buf uid
 164
 165       | OvernetSearchReply (md4, peers) ->
 166           buf_int8 buf 0x28;
 167           buf_md4 buf md4;
 168           buf_int8 buf (List.length peers);
 169           List.iter (buf_peer buf) peers
 170
 171       | OvernetGetSearchResults (target, kind, min, max) ->
 172           buf_int8 buf 0x30;
 173           buf_md4 buf target;
 174           begin
 175             match kind with
 176             | Search_for_kind _
 177             | Search_for_file ->
 178                 buf_int8 buf 1
 179             | Search_for_keyword None ->
 180                 buf_int8 buf 0
 181             | Search_for_keyword (Some e) ->
 182                 buf_int8 buf 1
 183           end
 184
 185       | OvernetSearchFilesResults (target, results) ->
 186           buf_int8 buf 0x38;
 187           buf_md4 buf target;
 188           buf_int16 buf (List.length results);
 189           List.iter (fun (md4, tags) ->
 190               buf_md4 buf md4;
 191               buf_int8 buf (List.length tags);
 192               List.iter (fun tag ->
 193                   buf_tag buf tag names_of_tag
 194               ) tags
 195           ) results
 196
 197       | OvernetPublishFiles (target, results) ->
 198           buf_int8 buf 0x40;
 199           buf_md4 buf target;
 200           buf_int16 buf (List.length results);
 201           List.iter (fun (md4, tags) ->
 202               buf_md4 buf md4;
 203               buf_int8 buf (List.length tags);
 204               List.iter (fun tag ->
 205                   buf_tag buf tag names_of_tag
 206               ) tags
 207           ) results
 208
 209       | OvernetPublishSources _
 210       | OvernetSearchSourcesResults _
 211       | OvernetUnknown21 _
 212       | OvernetPeerNotFound _
 213       | OvernetFirewallConnectionNACK _
 214       | OvernetFirewallConnectionACK _
 215       | OvernetFirewallConnection (_, _)
 216       | OvernetGetMyIPResult _
 217       | OvernetGetMyIP _
 218       | OvernetNoResult _
 219       | OvernetPublished _
 220       | OvernetSearch (_,_, None)
 221       | OvernetPublicized None
 222       | OvernetGetMyIPDone -> raise MessageNotImplemented
 223
 224       | OvernetUnknown (opcode, s) ->
 225           buf_int8 buf opcode;
 226           Buffer.add_string buf s
 227
 228     let get_peer s pos =
 229
 230       let md4 = get_md4 s pos in
 231       let ip = get_ip s (pos+16) in
 232       let udp_port = get_int16 s (pos + 20) in
 233       let tcp_port = get_int16 s (pos + 22) in
 234 (*       let kind = get_uint8 s (pos + 24) in *)
 235       {
 236         peer_md4 = md4;
 237         peer_ip = ip;
 238         peer_port = udp_port;
 239         peer_tcpport = tcp_port;
 240         peer_country_code = Geoip.get_country_code_option ip;
 241         peer_kind = 3;
 242         peer_last_send = 0;
 243         peer_expire = 0;
 244         peer_created = last_time ();
 245       }, pos + 25
 246
 247     let get_peers_from_results ip port answers =
 248       List.map (fun (r_md4, r_tags) ->
 249           let peer_ip = ref ip  in
 250           let peer_udpport = ref port in
 251           let peer_tcpport = ref 0 in
 252           let peer_kind = ref 0 in
 253           List.iter (fun tag ->
 254               match tag.tag_name with
 255                 Field_KNOWN "sourceport" ->
 256                   for_int_tag tag (fun port ->
 257                       peer_tcpport := port)
 258               | Field_KNOWN "sourceuport" ->
 259                   for_int_tag tag (fun port ->
 260                       peer_udpport := port)
 261               | Field_KNOWN "sourceip" ->
 262                   for_int64_tag tag (fun ip ->
 263                       peer_ip := Ip.of_int64 ip
 264                   )
 265               | Field_KNOWN "sourcetype" ->
 266                   for_int_tag tag (fun kind ->
 267                       peer_kind := 3)
 268               | _ ->
 269                 if !verbose_unknown_messages then
 270                   lprintf_nl "Unused source tag [%s]"
 271                     (escaped_string_of_field tag)
 272           ) r_tags;
 273           {
 274             peer_ip = !peer_ip;
 275             peer_port = !peer_udpport;
 276             peer_tcpport = !peer_tcpport;
 277             peer_country_code = Geoip.get_country_code_option !peer_ip;
 278             peer_md4 = r_md4;
 279             peer_last_send = 0;
 280             peer_expire = 0;
 281             peer_kind = 3;
 282             peer_created = last_time ();
 283           }
 284       ) answers
 285
 286     let parse ip port opcode s =
 287       match opcode with
 288         0x00 ->
 289           let p, pos = get_peer s 0 in
 290           OvernetConnect p
 291
 292       | 0x08 ->
 293 (*        let n = get_int16 s 0 in *)
 294           let peers, pos = get_list16 get_peer s 0 in
 295           OvernetConnectReply peers
 296
 297       | 0x10 ->
 298           let p, pos = get_peer s 0 in
 299           OvernetPublicize p
 300
 301       | 0x18 ->
 302           let p, pos = get_peer s 0 in
 303           OvernetPublicized (Some p)
 304
 305       | 0x20 ->
 306           let nresults = (get_uint8 s 0) land 0x1f in
 307           let target = get_md4 s 1 in
 308           let uid = get_md4 s 17 in
 309           OvernetSearch (nresults, target, Some uid)
 310
 311       | 0x28 ->
 312           let target = get_md4 s 0 in
 313           let peers, pos = get_list8 get_peer s 16 in
 314           OvernetSearchReply (target, peers)
 315
 316       | 0x30 ->
 317           let target = get_md4 s 0 in
 318           let kind = get_uint8 s 16 in
 319           let kind =
 320             if String.length s = 17 then
 321               if kind = 1 then Search_for_file else
 322                 Search_for_keyword None
 323             else
 324               Search_for_kind kind
 325           in
 326           OvernetGetSearchResults (target, kind, 0, 100)
 327
 328       | 0x38 ->
 329           let target = get_md4 s 0 in
 330           let answers, pos = get_list16 (fun s pos ->
 331                 let uid = get_md4 s pos in
 332                 let tags, pos = get_list8 (get_tag names_of_tag)
 333                   s (pos + 16) in
 334                 (uid, tags), pos
 335             ) s 16 in
 336           begin
 337             match answers with
 338               (_, first_tags) :: _ ->
 339                 let sources = ref false in
 340                 List.iter (fun tag ->
 341                     if tag.tag_name = Field_KNOWN "sourceport" then sources := true;
 342                 ) first_tags;
 343                 if !sources then
 344                   let peers = get_peers_from_results Ip.null 0 answers in
 345                   OvernetSearchSourcesResults (target, peers)
 346
 347                 else
 348                   OvernetSearchFilesResults (target, answers)
 349             | [] ->
 350                 OvernetSearchFilesResults (target, answers)
 351           end
 352
 353       | 0x40 ->
 354           let target = get_md4 s 0 in
 355           let answers, pos = get_list16 (fun s pos ->
 356                 let uid = get_md4 s pos in
 357                 let tags, pos = get_list8 (get_tag names_of_tag)
 358                   s (pos + 16) in
 359                 (uid, tags), pos
 360             ) s 16 in
 361
 362           begin
 363             match answers with
 364               (_, first_tags) :: _ ->
 365                 let sources = ref false in
 366                 List.iter (fun tag ->
 367                     if tag.tag_name = Field_KNOWN "sourceport" then sources := true;
 368                 ) first_tags;
 369                 if !sources then
 370                   let peers = get_peers_from_results ip port answers in
 371                   OvernetPublishSources (target, peers)
 372
 373                 else
 374                   OvernetPublishFiles (target, answers)
 375             | [] ->
 376                 OvernetPublishFiles (target, answers)
 377           end
 378
 379       | 0x48 ->
 380           let target = get_md4 s 0 in
 381           OvernetPublished target
 382
 383 (*
 384 #define KADEMLIA_SRC_NOTES_RES  0x3A    // <HASH (key) [16]> <CNT1 [2]> (<HASH (answer) [16]> <CNT2 [2]> <META>*(CNT2))*(CNT1)
 385 #define KADEMLIA_PUB_NOTES_REQ  0x42    // <HASH (key) [16]> <HASH (target) [16]> <CNT2 [2]> <META>*(CNT2))*(CNT1)
 386 #define KADEMLIA_PUB_NOTES_RES  0x4A    // <HASH (key) [16]>
 387 #define KADEMLIA_FIREWALLED_REQ 0x50    // <TCPPORT (sender) [2]>
 388 #define KADEMLIA_FINDBUDDY_REQ  0x51    // <TCPPORT (sender) [2]>
 389 #define KADEMLIA_CALLBACK_REQ   0x52    // <TCPPORT (sender) [2]>
 390 #define KADEMLIA_FIREWALLED_RES 0x58    // <IP (sender) [4]>
 391 #define KADEMLIA_FIREWALLED_ACK 0x59    // (null)
 392 #define KADEMLIA_FINDBUDDY_RES  0x5A    // <TCPPORT (sender) [2]>
 393 *)
 394
 395       | _ ->
 396           OvernetUnknown (opcode, String.sub s 1 (String.length s - 1))
 397
 398     let udp_buf = Buffer.create 2000
 399
 400     let kademlia_header_code = char_of_int 0xE4
 401     let kademlia_packed_header_code = char_of_int 0xE5
 402     let kademlia_header = String.make 1 kademlia_header_code
 403     let kademlia_packed_header = String.make 1 kademlia_packed_header_code
 404
 405     let parse_message ip port pbuf =
 406       let len = String.length pbuf in
 407       if len < 2 ||
 408         (let magic = pbuf.[0] in
 409           magic <> kademlia_header_code &&
 410           magic <> kademlia_packed_header_code) then
 411         begin
 412           if !CommonOptions.verbose_unknown_messages then begin
 413               lprintf_nl "Received unknown UDP packet";
 414               dump pbuf;
 415             end;
 416           raise Not_found
 417
 418         end
 419       else
 420       let magic = pbuf.[0] in
 421       let opcode = int_of_char pbuf.[1] in
 422       let msg = String.sub pbuf 2 (len-2) in
 423       let msg = if magic = kademlia_packed_header_code then
 424           let s = Zlib2.uncompress_string2 msg in
 425 (*          lprintf "Uncompressed:\n";
 426           dump s; *)
 427           s
 428         else msg
 429       in
 430       let t = parse ip port opcode msg in
 431       t
 432
 433     let udp_send sock ip port ping msg =
 434       try
 435         Buffer.reset udp_buf;
 436         write udp_buf msg;
 437         let s = Buffer.contents udp_buf in
 438
 439         let s =
 440           if String.length s > 200 then
 441             let opcode = String.sub s 0 1 in
 442             let args = String.sub s 1 (String.length s - 1) in
 443             kademlia_packed_header ^ opcode ^ (Zlib2.compress_string args)
 444           else
 445             kademlia_header ^ s
 446         in
 447
 448         if !verbose_overnet then
 449           begin
 450             lprintf_nl "UDP to %s:%d op 0x%02X len %d type %s"
 451               (Ip.to_string ip) port (get_uint8 s 1) (String.length s) (message_to_string msg);
 452           end;
 453         (*
 454         let len = String.length s in
 455         let t = parse_message ip port s in
 456         if t <> msg then begin
 457             lprintf "********** SENT MESSAGE DIFFERS FROM EXPECTED ******\n";
 458           end;
 459 *)
 460
 461         UdpSocket.write sock ping (Bytes.unsafe_of_string s) ip port
 462       with
 463       | MessageNotImplemented -> ()
 464       | e -> lprintf_nl "Exception %s in udp_send" (Printexc2.to_string e)
 465
 466     let udp_handler f sock event =
 467       match event with
 468         UdpSocket.READ_DONE ->
 469           UdpSocket.read_packets sock (fun p ->
 470               try
 471                 let pbuf = p.UdpSocket.udp_content in
 472
 473                 let (ip, port) =
 474                   match p.UdpSocket.udp_addr with
 475                     Unix.ADDR_INET (inet, port) ->
 476                       Ip.of_inet_addr inet, port
 477                   | _ -> assert false
 478                 in
 479                 let t = parse_message ip port (Bytes.unsafe_to_string pbuf) in
 480                 let is_not_banned ip =
 481                   match !Ip.banned (ip, None) with
 482                     None -> true
 483                    | Some reason ->
 484                   if !verbose_overnet then
 485                     lprintf_nl "%s blocked: %s" (Ip.to_string ip) reason;
 486                   false
 487                 in
 488                 if is_not_banned ip then f t p
 489               with e ->
 490                 if !verbose_unknown_messages then
 491                 begin
 492                   lprintf_nl "Error %s in udp_handler, dump of packet:"
 493                     (Printexc2.to_string e);
 494                   dump (Bytes.unsafe_to_string p.UdpSocket.udp_content);
 495                   lprint_newline ()
 496                 end
 497           );
 498       | _ -> ()
 499
 500     let checking_kind_timeout = 120
 501
 502     let redirector_section = "DKKA"
 503     let options_section_name = "Kademlia"
 504
 505     let enable_overnet = enable_kademlia
 506     let source_brand = false
 507
 508     let overnet_section = file_section donkey_ini
 509         [ options_section_name ]
 510         "Kademlia options"
 511
 512     let overnet_port =
 513       define_option overnet_section [options_section_name; "port"]
 514       "port for Kademlia"
 515         int_option (2000 + Random.int 20000)
 516
 517     let overnet_tcpport = donkey_port
 518     let command_prefix = "kad_"
 519
 520     let web_info = "kad"
 521     let web_info_descr = "Kad network boot peers"
 522   end
 523
 524 module Kademlia = Make(P)
 525