src/networks/fasttrack/fasttrackPandora.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
  21
  22 (*
  23 SENDING REQUEST: GET FastTrack://62.175.4.76:2798/.hash=9c1e0c03f1a38ba838feaf4b8ac0d560b43bc148 HTTP/1.1\013\nHost: 62.175.4.76:2798\013\nUser-Agent: MLDonkey 2.4-1\013\nRange: bytes=0-262143\013\n\013\n
  24 Asking 00000000000000000000000000000000 For Range 0-262143
  25 Disconnected from source
  26 CLIENT PARSE HEADER
  27 HEADER FROM CLIENT:
  28 ascii: [
  29 HTTP/1.0 501 Not Implemented
  30 X-Kazaa-Username: rcb(13)
  31 X-Kazaa-Network: KaZaA(13)
  32 X-Kazaa-IP: 168.226.112.135:1959(13)
  33 X-Kazaa-SupernodeIP: 200.75.229.212:1214(13)
  34 ]
  35
  36
  37 ascii:[
  38 HTTP/1.0 503 Service Unavailable
  39 Retry-After: 284(13)
  40 X-Kazaa-Username: johnl(13)
  41 X-Kazaa-Network: KaZaA(13)
  42 X-Kazaa-IP: 62.251.115.29:1457(13)
  43 X-Kazaa-SupernodeIP: 195.169.211.25:3534(13)
  44 ]
  45
  46 ascii:[
  47 HTTP/1.1 206 Partial Content(13)
  48 Content-Range: bytes 3145728-3407871/6128453(13)
  49 Content-Length: 262144(13)
  50 Accept-Ranges: bytes(13)
  51 Date: Thu, 15 May 2003 22:28:38 GMT(13)
  52 Server: KazaaClient Nov  3 2002 20:29:03(13)
  53 Connection: close(13)
  54 Last-Modified: Sat, 22 Feb 2003 19:58:52 GMT(13)
  55 X-Kazaa-Username: defaultuser(13)
  56 X-Kazaa-Network: KaZaA(13)
  57 X-Kazaa-IP: 212.8.74.24:1214(13)
  58 X-Kazaa-SupernodeIP: 193.204.34.214:2093(13)
  59 X-KazaaTag: 4=A solas con mi corazon(13)
  60 X-KazaaTag: 6=Rosa(13)
  61 X-KazaaTag: 8=Rosa(13)
  62 X-KazaaTag: 14=Pop(13)
  63 X-KazaaTag: 1=2002(13)
  64 X-KazaaTag: 26=http://www.elitemp3.net(13)
  65 X-KazaaTag: 10=es(13)
  66 X-KazaaTag: 12=1(186) album - 29-04-2002(13)
  67 X-KazaaTag: 5=386(13)
  68 X-KazaaTag: 21=128(13)
  69 X-KazaaTag: 3==qyWzRb1Qvnk4mtaBytIM1iHQuK8=(13)
  70 Content-Type: audio/mpeg(13)
  71 (13)]
  72
  73 HTTP/1.1206 Partial Content(13)
  74 Content-Range: bytes 0-262143/3937679(13)
  75 Content-Length: 262144(13)
  76 Accept-Ranges: bytes(13)
  77 Date: Thu, 15 May 2003 22:18:12 GMT(13)
  78 Server: KazaaClient Nov  3 2002 20:29:03(13)
  79 Connection: close(13)
  80 Last-Modified: Mon, 05 May 2003 04:14:57 GMT(13)
  81 X-Kazaa-Username: shaz2003(13)
  82 X-Kazaa-Network: KaZaA(13)
  83 X-Kazaa-IP: 81.103.29.119:3641(13)
  84 X-Kazaa-SupernodeIP: 131.111.202.241:2674(13)
  85 X-KazaaTag: 5=246(13)
  86 X-KazaaTag: 21=128(13)
  87 X-KazaaTag: 4=Fighter(13)
  88 X-KazaaTag: 6=Christina Aguliera(13)
  89 X-KazaaTag: 8=Stripped(13)
  90 X-KazaaTag: 14=Other(13)
  91 X-KazaaTag: 1=2002(13)
  92 X-KazaaTag: 26=© christinas_eyedol 2002(13)
  93 X-KazaaTag: 12=album version, stripped, fighter, real, christina, aguilera(13)
  94 X-KazaaTag: 10=en(13)
  95 X-KazaaTag: 18=Video Clip(13)
  96 X-KazaaTag: 28=div3(13)
  97 X-KazaaTag: 17=24(13)
  98 X-KazaaTag: 9=241229701(13)
  99 X-KazaaTag: 24=http://www.MusicInter.com(13)
 100 X-KazaaTag: 3==kd8c6QgrXm0wvCYl5Uo0Aa9C7qg=(13)
 101 Content-Type: audio/mpeg(13)
 102 \n
 103
 104
 105 *)
 106
 107 open Options
 108 open Queues
 109 open Printf2
 110 open Md4
 111 open BasicSocket
 112 open TcpBufferedSocket
 113
 114 open AnyEndian
 115
 116 open CommonOptions
 117 open CommonSearch
 118 open CommonServer
 119 open CommonComplexOptions
 120 open CommonFile
 121 open CommonDownloads
 122 open CommonTypes
 123 open CommonGlobals
 124
 125 open FasttrackNetwork
 126 open FasttrackTypes
 127 open FasttrackGlobals
 128 open FasttrackOptions
 129 open FasttrackProtocol
 130 open FasttrackComplexOptions
 131 open FasttrackProto
 132
 133 (*************************************************************************)
 134 (*                                                                       *)
 135 (*                                                                       *)
 136 (*                                                                       *)
 137 (*                         READING FROM TCPDUMP                          *)
 138 (*                                                                       *)
 139 (*                                                                       *)
 140 (*                                                                       *)
 141 (*************************************************************************)
 142
 143 type t = UDP | TCP
 144
 145 type cnx = {
 146     time : int;
 147     ip1 : string;
 148     port1 : int;
 149     ip2 : string;
 150     port2 : int;
 151     packets_in : Buffer.t;
 152     packets_out : Buffer.t;
 153   }
 154 let connections = Hashtbl.create 13
 155
 156 let rec parse_packets pos s ciphers =
 157   let len = String.length s - pos in
 158   if len > 0 then
 159     let size = TcpMessages.packet_size ciphers s pos len in
 160     match size with
 161       None -> ()
 162     | Some size ->
 163         if len >= size then
 164           let msg = String.sub s pos size in
 165           let addr, t = TcpMessages.parse ciphers msg in
 166           lprintf "MESSAGE: %s\n    %s\n"
 167             (TcpMessages.string_of_path addr)
 168           (TcpMessages.to_string t);
 169           parse_packets (pos+size) s ciphers
 170         else
 171           lprintf "Packet too short\n"
 172
 173 let parse_netname start_pos s ciphers =
 174   let len = String.length s in
 175   let rec iter pos =
 176     if pos < len then
 177       if s.[pos] = '\000' then begin
 178           let netname = String.sub s start_pos (pos-start_pos) in
 179           lprintf "netname: [%s]\n" (String.escaped netname);
 180
 181 (*          test_xinu s (pos+1) len 0x51L; *)
 182           parse_packets (pos+1) s ciphers
 183         end else
 184         iter (pos+1)
 185     else failwith "End of name not found"
 186   in
 187   iter (start_pos)
 188
 189 let get_xinu s pos xtype =
 190   match xtype with
 191     0 ->
 192       let msg_lo = get_uint8 s (pos+1) in
 193       let msg_hi = get_uint8 s (pos+2) in
 194       let len_hi = get_uint8 s (pos+3) in
 195       let len_lo = get_uint8 s (pos+4) in
 196       (msg_hi lsl 8) lor msg_lo, (len_hi lsl 8) lor len_lo
 197   | 1 ->
 198       let msg_hi = get_uint8 s (pos+1) in
 199       let len_hi = get_uint8 s (pos+2) in
 200       let msg_lo = get_uint8 s (pos+3) in
 201       let len_lo = get_uint8 s (pos+4) in
 202       (msg_hi lsl 8) lor msg_lo, (len_hi lsl 8) lor len_lo
 203   | _ ->
 204       let msg_hi = get_uint8 s (pos+1) in
 205       let len_lo = get_uint8 s (pos+2) in
 206       let len_hi = get_uint8 s (pos+3) in
 207       let msg_lo = get_uint8 s (pos+4) in
 208       (msg_hi lsl 8) lor msg_lo, (len_hi lsl 8) lor len_lo
 209
 210 let rec check_xinu s pos len depth =
 211   if depth > 5 then depth else
 212   if pos >= len then depth else
 213   match int_of_char s.[pos] with
 214     0x50 | 0x52 -> check_xinu  s (pos+1) len (depth + 1)
 215   | 0x4b ->
 216       if pos + 5 < len then
 217
 218         let msg_type0, len0 = get_xinu s pos 0 in
 219         let msg_type1, len1 = get_xinu s pos 1 in
 220         let msg_type2, len2 = get_xinu s pos 2 in
 221
 222         let check0 = check_xinu s (pos + 5 + len0) len (depth+1) in
 223         let check1 = check_xinu s (pos + 5 + len1) len (depth+1) in
 224         let check2 = check_xinu s (pos + 5 + len2) len (depth+1) in
 225
 226         max check0 (max check1 check2)
 227       else depth
 228   | _ -> -10
 229
 230 let parse (s_out : string) (s_in : string) =
 231   let parsed = ref false in
 232   if String.length s_in > 12 && String.length s_out > 12 then begin
 233       let ciphers = {
 234           in_cipher = create_cipher ();
 235           out_cipher = create_cipher ();
 236           in_xinu = 0x51L;
 237           out_xinu = 0x51L;
 238         } in
 239       begin
 240         try
 241
 242           get_cipher_from_packet s_out 4 ciphers.out_cipher;
 243           init_cipher ciphers.out_cipher;
 244
 245           get_cipher_from_packet s_in 0 ciphers.in_cipher;
 246           init_cipher ciphers.in_cipher;
 247
 248           xor_ciphers ciphers.out_cipher ciphers.in_cipher;
 249           init_cipher ciphers.out_cipher;
 250
 251           lprintf "HEADER OF CONNECTION: %02x.%02x.%02x.%02x - %02x.%02x.%02x.%02x\n"
 252             (int_of_char s_out.[0])
 253           (int_of_char s_out.[1])
 254           (int_of_char s_out.[2])
 255           (int_of_char s_out.[3])
 256
 257           (int_of_char s_out.[4])
 258           (int_of_char s_out.[5])
 259           (int_of_char s_out.[6])
 260           (int_of_char s_out.[7])
 261           ;
 262
 263           begin
 264             let s = String.create 8 in
 265             cipher_packet_set ciphers.out_cipher s 0;
 266             lprintf "OUT CIPHER: [%s]\n" (String.escaped s);
 267           end;
 268
 269           begin
 270             let s = String.create 8 in
 271             cipher_packet_set ciphers.in_cipher s 0;
 272             lprintf "IN CIPHER: [%s]\n" (String.escaped s);
 273           end;
 274
 275           (
 276             let len = String.length s_out in
 277             let start_pos = 12 in
 278             apply_cipher ciphers.out_cipher s_out start_pos (len-start_pos);
 279 (*
 280             lprintf "Ciphered: [%s]\n" (String.escaped
 281 (String.sub s_out start_pos (min (len - start_pos) 1000)));
 282   *)
 283           );
 284           (
 285             let len = String.length s_in in
 286             let start_pos = 8 in
 287             apply_cipher ciphers.in_cipher s_in start_pos (len-start_pos);
 288 (*
 289             lprintf "Ciphered: [%s]\n" (String.escaped
 290 (String.sub s_in start_pos (min (len - start_pos) 1000)));
 291    *)
 292           );
 293
 294           lprintf "---------------------------------------------->\n";
 295           lprintf "  HEADER[%s]\n" (String.escaped (String.sub s_out 0 4));
 296           parse_netname 12 s_out { ciphers with
 297             in_xinu = ciphers.out_xinu; in_cipher = ciphers.out_cipher };
 298           lprintf "<----------------------------------------------\n";
 299           parse_netname 8 s_in ciphers;
 300           parsed := true;
 301 (*
 302  (*
 303 dump_sub s (start_pos) (len - start_pos);
 304   *)
 305
 306    end
 307   *)
 308     with e ->
 309         lprintf "exception %s while parsing stream\n"
 310           (Printexc2.to_string e) ;
 311         lprintf "  [%s]\n" (String.escaped
 312             (String.sub s_in 0 (min 50 (String.length s_in))))
 313   end;
 314   cipher_free ciphers.in_cipher;
 315     cipher_free ciphers.out_cipher;
 316     end;
 317   !parsed
 318
 319 let find_header s pos =
 320   let rec iter s pos =
 321     if s.[pos] = '\n' then
 322       if s.[pos+1] = '\n' then pos+2
 323       else
 324       if s.[pos+1] = '\r' then
 325         if s.[pos+2] = '\n' then pos+3
 326         else iter s (pos+1)
 327       else iter s (pos+1)
 328     else
 329     if s.[pos] = '\r' then
 330       if s.[pos] = '\n' then
 331         if s.[pos+1] = '\n' then pos+2
 332         else
 333         if s.[pos+1] = '\r' then
 334           if s.[pos+2] = '\n' then pos+3
 335           else iter s (pos+1)
 336         else iter s (pos+1)
 337       else
 338         iter s (pos+1)
 339     else iter s (pos+1)
 340   in
 341   let pos2 = iter s pos in
 342   String.sub s pos (pos2 - pos)
 343
 344 let hescaped s =
 345   String2.replace_char s '\r' ' ';s
 346
 347 let is_http_stream s =
 348   String2.starts_with s "GET" ||
 349   String2.starts_with s "POST" ||
 350   String2.starts_with s "HTTP"
 351
 352 type packet =
 353   UdpPacket of string * int * string * int * string
 354 | TcpConnection of cnx
 355
 356 let packets = ref []
 357
 358 let print_packets () =
 359   let packets = List.sort (fun (t1,_) (t2,_) -> compare t1 t2) !packets in
 360   List.iter (fun (time, p) ->
 361       match p with
 362         UdpPacket (ip1, port1, ip2, port2, data) ->
 363           lprintf "Time %d\n" time;
 364           lprintf "UDP packet(%d) %s:%d -> %s:%d\n"
 365             (String.length data) ip1 port1 ip2 port2;
 366           let p = UdpMessages.parse data in
 367           lprintf "     %s\n" (UdpMessages.to_string p)
 368
 369       | TcpConnection cnx ->
 370           try
 371
 372             let s1 = Buffer.contents cnx.packets_out in
 373             let s2 = Buffer.contents cnx.packets_in in
 374
 375             if s1 <> "" || s2 <> "" then begin
 376
 377                 if is_http_stream s1 || is_http_stream s2 then begin
 378 (*
 379                     lprintf "Time %d\n" time;
 380                     lprintf "\nCONNECTION %s:%d --> %s:%d\n"
 381                     cnx.ip1 cnx.port1 cnx.ip2 cnx.port2;
 382
 383                     (if is_http_stream s1 then
 384                         let header = find_header s1 0 in
 385                         lprintf "HTTP connection: [%s]\n" (hescaped header));
 386                     (if is_http_stream s2 then
 387                         let header2 = find_header s2 0 in
 388                         lprintf "HTTP reply connection: [%s]\n" (hescaped header2));
 389 *)
 390                     ()
 391                   end else begin
 392                     lprintf "Time %d\n" time;
 393                     lprintf "CONNECTION %s:%d --> %s:%d\n"
 394                       cnx.ip1 cnx.port1 cnx.ip2 cnx.port2;
 395
 396                     lprintf "First direction....\n";
 397                     let parsed = parse
 398                         (Buffer.contents cnx.packets_out)
 399                       (Buffer.contents cnx.packets_in) in
 400                     if not parsed then begin
 401                         lprintf "Second direction....\n";
 402                         let _ = parse
 403                             (Buffer.contents cnx.packets_in)
 404                           (Buffer.contents cnx.packets_out) in
 405                         ()
 406                       end
 407                   end
 408               end
 409           with
 410             | e ->
 411               lprintf "Exception %s\n" (Printexc2.to_string e)
 412   ) packets
 413
 414 let commit () =
 415   Hashtbl.iter (fun _ cnx ->
 416       packets := (cnx.time, TcpConnection cnx) :: !packets
 417   ) connections;
 418   print_packets ()
 419
 420 let local_net = "129.104"
 421 let time = ref 0
 422
 423 let new_packet (kind:t) (number:int) ip1 port1 ip2 port2 data =
 424   if not (String2.starts_with ip1 local_net &&
 425       String2.starts_with ip2 local_net) then
 426     begin
 427       incr time;
 428       let time = !time in
 429       match kind with
 430         UDP ->
 431           begin
 432             try
 433               packets := (time, UdpPacket (ip1,port1,ip2,port2,data)) :: !packets
 434 (*              lprintf "New packet:\n%s\n" (String.escaped data);           *)
 435             with e ->
 436 (*                lprintf "Could not parse UDP packet:\n"; *)
 437                 ()
 438           end
 439       | TCP ->
 440
 441 (*      if port1 = 1214 || port2 = 1214 then *)
 442           let out_packet = (ip1, port1, ip2, port2) in
 443           let in_packet = (ip2, port2, ip1, port1) in
 444
 445           try
 446             let cnx =  Hashtbl.find connections out_packet in
 447             Buffer.add_string cnx.packets_out data;
 448             ()
 449           with _ ->
 450               try
 451                 let cnx =  Hashtbl.find connections in_packet in
 452                 Buffer.add_string cnx.packets_in data
 453               with _ ->
 454                   let cnx = {
 455                       time = time;
 456                       ip1 = ip1;
 457                       port1 = port1;
 458                       ip2 = ip2;
 459                       port2 = port2;
 460                       packets_out = Buffer.create 100;
 461                       packets_in = Buffer.create 100;
 462                     } in
 463                   Hashtbl.add connections out_packet cnx;
 464                   Buffer.add_string cnx.packets_out data
 465     end
 466
 467 (*************************************************************************)
 468 (*                                                                       *)
 469 (*                                                                       *)
 470 (*                                                                       *)
 471 (*                         READING FROM LOG                              *)
 472 (*                                                                       *)
 473 (*                                                                       *)
 474 (*                                                                       *)
 475 (*************************************************************************)
 476
 477
 478 open Int64ops
 479 open LittleEndian (* This is bad, since it is the contrary of the default
 480 FT format, so we will forget it once, and our logs won't be readable
 481   anymore... *)
 482
 483 type connection = {
 484     c_ip : Ip.t;
 485     c_port : int;
 486     mutable c_time : int;
 487     mutable c_ciphers : ciphers;
 488     mutable c_pos : int;
 489     mutable c_buf : string;
 490     mutable c_parser : (connection -> unit);
 491     mutable c_npackets : int;
 492   }
 493
 494 let connections = Hashtbl.create 1000
 495
 496 let print c addr t =
 497   let module M = TcpMessages in
 498   match t with
 499         (*
 500   | M.SearchReq _
 501 *)
 502   | M.SearchForwardReq _
 503     (*
 504   | M.SearchForward2Req _
 505
 506   | M.ShareFileReq _
 507   | M.UnshareFileReq _
 508 *)
 509     ->  lprintf "MESSAGE %d from %s:%d time:%d: %s\n    %s\n\n"
 510         c.c_npackets (Ip.to_string c.c_ip) c.c_port c.c_time
 511         (TcpMessages.string_of_path addr)
 512       (TcpMessages.to_string t)
 513
 514   | _
 515
 516     -> ()
 517 (*    ->  lprintf "MESSAGE %d from %s:%d time:%d: %s\n    %s\n\n"
 518         c.c_npackets (Ip.to_string c.c_ip) c.c_port c.c_time
 519         (TcpMessages.string_of_path addr)
 520       (TcpMessages.to_string t) *)
 521
 522       (*
 523 let parse_head c s pos =
 524   let xtype = Int64.to_int (Int64.rem c.c_ciphers.in_xinu int64_3) in
 525
 526   begin
 527     let msg_type0, len0 = get_xinu s pos 0 in
 528     let msg_type1, len1 = get_xinu s pos 1 in
 529     let msg_type2, len2 = get_xinu s pos 2 in
 530
 531     let len = String.length s in
 532     let check0 = check_xinu s (pos + 5 + len0) len 0 in
 533     let check1 = check_xinu s (pos + 5 + len1) len 0 in
 534     let check2 = check_xinu s (pos + 5 + len2) len 0 in
 535
 536     lprintf "    xinu: %d\n" xtype;
 537     lprintf "      0 : opcode = %x len = %d [%d]\n" msg_type0 len0
 538       check0;
 539     lprintf "      1 : opcode = %x len = %d [%d]\n" msg_type1 len1
 540       check1;
 541     lprintf "      2 : opcode = %x len = %d [%d]\n" msg_type2 len2
 542       check2;
 543   end;
 544
 545 (*  if c.c_npackets = 388 then 100, 1000 else  *)
 546     TcpMessages.get_xinu s pos xtype
 547
 548 let parse c s =
 549   let module T = TcpMessages in
 550   match int_of_char s.[0] with
 551     0x50 -> T.DirectPacket, T.PingReq
 552   | 0x52 -> T.DirectPacket, T.PongReq
 553   | 0x4b ->
 554 (*          lprintf "We have got a real packet\n"; *)
 555       let msg_type, size = parse_head c s 0 in
 556
 557       c.c_ciphers.in_xinu <- Int64.logxor c.c_ciphers.in_xinu
 558         (Int64.logand
 559           (Int64.lognot (Int64.of_int (size + msg_type)))
 560         int64_ffffffff);
 561
 562       let msg_flags = (msg_type land 0xff00) lsr 8 in
 563       let msg_type = msg_type land 0xff in
 564
 565       let pos, size, addr = match msg_flags with
 566         | 0x80 ->
 567             let source_ip = LittleEndian.get_ip s 5 in
 568             let source_port = BigEndian.get_int16  s 9 in
 569             let dest_ip = LittleEndian.get_ip s 11 in
 570             let dest_port = BigEndian.get_int16 s 15 in
 571             let hops = BigEndian.get_int8 s 17 in
 572
 573             let addr = {
 574                 T.unicast_source_ip = source_ip;
 575                 T.unicast_source_port = source_port;
 576                 T.unicast_dest_ip = dest_ip;
 577                 T.unicast_dest_port = dest_port;
 578                 T.unicast_hops = hops;
 579               } in
 580
 581             5 + 13, size - 13, T.UnicastPacket addr
 582         | 0xC0 ->
 583             let source_ip = LittleEndian.get_ip s 5 in
 584             let source_port = BigEndian.get_int16  s 9 in
 585             let unknown = BigEndian.get_int16 s 11 in
 586             let hops = BigEndian.get_int8 s 13 in
 587
 588             let addr = {
 589                 T.broadcast_source_ip = source_ip;
 590                 T.broadcast_source_port = source_port;
 591                 T.broadcast_unknown = unknown;
 592                 T.broadcast_hops = hops;
 593               } in
 594
 595             5 + 9, size - 9, T.BroadcastPacket addr
 596         | 0 ->
 597             5, size, T.DirectPacket
 598         | _ ->
 599             lprintf "   MESSAGE HAS UNKNOWN FLAG %x\n" msg_flags;
 600             5, size, T.DirectPacket
 601       in
 602       let m = String.sub s pos size in
 603       addr,
 604       (try T.parse_packet msg_type m with e ->
 605             lprintf "Exception in parse_packet\n"; raise e)
 606   | n ->
 607       lprintf "Packet not understood: %d\n" n;
 608       dump s;
 609       T.DirectPacket, T.UnknownMessageReq (n, s)
 610
 611 let packet_size c s pos len =
 612   if len > 0 then begin
 613
 614       match int_of_char s.[pos] with
 615         0x50 -> Some 1
 616       | 0x52 -> Some 1
 617       | 0x4b ->
 618 (*          lprintf "We have got a real packet\n"; *)
 619           if len > 4 then
 620 (*                dump_sub s b.pos b.len; *)
 621             let msg_type, size = parse_head c s pos in
 622
 623             Some (size + 5)
 624           else None
 625
 626       | n ->
 627           lprintf "Packet not understood: %d\n" n;
 628           raise Exit
 629     end else None
 630       *)
 631
 632 let rec parse_packets c =
 633   let pos = c.c_pos in
 634   let s = c.c_buf in
 635   let len = String.length s - pos in
 636   if len > 0 then
 637     try
 638       let size = TcpMessages.packet_size c.c_ciphers s pos len in
 639       match size with
 640         None -> ()
 641       | Some size ->
 642           if len >= size then begin
 643 (*            lprintf "size %d+%d/%d\n" pos size (String.length s); *)
 644               let msg = String.sub s pos size in
 645               let addr, t = TcpMessages.parse c.c_ciphers msg in
 646               print c addr t;
 647
 648 (*
 649           if c.c_npackets >= 388 && c.c_time >= 97771248 then begin
 650               lprintf "size %d\n" size;
 651               if c.c_npackets = 390 then exit 0;
 652             end;          *)
 653               c.c_npackets <- c.c_npackets + 1;
 654               c.c_pos <- pos + size;
 655               parse_packets c
 656             end else ()
 657     with _ -> ()
 658   else begin
 659       c.c_pos <- 0;
 660       c.c_buf <- ""
 661     end
 662
 663 let parse_netname c =
 664   let start_pos = c.c_pos in
 665   let s = c.c_buf in
 666   let len = String.length s in
 667   let rec iter pos =
 668     if pos < len then
 669       if s.[pos] = '\000' then begin
 670           c.c_pos <- pos + 1;
 671           c.c_parser <- parse_packets;
 672           parse_packets c
 673         end else
 674         iter (pos+1)
 675   in
 676   iter start_pos
 677
 678 let received ip port time s =
 679 (*  lprintf "Received %s:%d at %d size %d\n"
 680     (Ip.to_string ip) port time (String.length s); *)
 681   let key = (ip, port) in
 682   let c = try
 683       Hashtbl.find connections key
 684     with _ ->
 685         let ciphers = {
 686             in_cipher = create_cipher ();
 687             out_cipher = create_cipher ();
 688             in_xinu = 0x51L;
 689             out_xinu = 0x51L;
 690           } in
 691         let c = {
 692             c_ip = ip;
 693             c_time = time;
 694             c_port = port;
 695             c_pos = 0;
 696             c_buf = "";
 697             c_parser = parse_netname;
 698             c_ciphers = ciphers;
 699             c_npackets = 0;
 700           } in
 701         Hashtbl.add connections key c;
 702         c
 703   in
 704   c.c_buf <- c.c_buf ^ s;
 705   c.c_time <- time;
 706   c.c_parser c
 707
 708 let read_trace () =
 709   let ic = open_in "ft_supernode.dump" in
 710   let buffer_size = 52000 in
 711   let s = String.create buffer_size in
 712   let total = ref zero in
 713   let rec iter pos =
 714     let nread = input ic s pos (buffer_size - pos) in
 715     if nread = 0 then begin
 716         lprintf "closing...\n";
 717         close_in ic
 718       end
 719     else
 720     let len = pos + nread in
 721     total := !total ++ Int64.of_int nread;
 722     iter_log 0 len
 723
 724   and iter_log pos len =
 725     if len > 13 then
 726       let size = get_int s (pos + 10) in
 727       let ip = LittleEndian.get_ip s pos in
 728       let port = get_int16 s (pos+4) in
 729       let time = get_int s (pos+6) in
 730       let item_len = size + 14 in
 731       if item_len <= len then
 732         let p = String.sub s (pos+14) size in
 733         received ip port time p;
 734         iter_log (pos + item_len) (len - item_len)
 735       else iter_read pos len
 736     else iter_read pos len
 737
 738   and iter_read pos len =
 739     if pos = 0 then iter len
 740     else
 741       begin
 742         String.blit s pos s 0 len;
 743         iter len
 744       end
 745   in
 746   iter 0;
 747   lprintf "Total %Ld\n" !total