/[mldonkey]/mldonkey/src/networks/fasttrack/fasttrackProto.ml
ViewVC logotype

Diff of /mldonkey/src/networks/fasttrack/fasttrackProto.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by mldonkey, Mon Nov 1 11:23:01 2004 UTC revision 1.10 by spiralvoice, Sun Aug 7 12:57:22 2005 UTC
# Line 18  Line 18 
18  *)  *)
19    
20  open BasicSocket  open BasicSocket
21      
22  open BigEndian  open BigEndian
23  open AnyEndian  open AnyEndian
24  open Printf2  open Printf2
# Line 38  open FasttrackOptions Line 38  open FasttrackOptions
38  open FasttrackTypes  open FasttrackTypes
39  open FasttrackProtocol  open FasttrackProtocol
40  open FasttrackGlobals  open FasttrackGlobals
41          
42  (*************************************************************************)  (*************************************************************************)
43  (*                                                                       *)  (*                                                                       *)
44  (*                         Constants                                     *)  (*                         Constants                                     *)
# Line 48  open FasttrackGlobals Line 48  open FasttrackGlobals
48  let int64_3 = Int64.of_int 3  let int64_3 = Int64.of_int 3
49  let int64_ffffffff = Int64.of_string "0xffffffff"  let int64_ffffffff = Int64.of_string "0xffffffff"
50  let default_bandwidth = 0x68  let default_bandwidth = 0x68
51      
52  external fst_hash_checksum : string -> int = "fst_hash_checksum_ml"  external fst_hash_checksum : string -> int = "fst_hash_checksum_ml"
53    
54    (*    (*
55  let known_ips = Hashtbl.create 113  let known_ips = Hashtbl.create 113
56    
57  let ip_to_string ip =  let ip_to_string ip =
58    let s = Ip.to_string ip in    let s = Ip.to_string ip in
59    if not (Hashtbl.mem known_ips s) then Hashtbl.add known_ips s s;    if not (Hashtbl.mem known_ips s) then Hashtbl.add known_ips s s;
60    s    s
61      *)      *)
62    
63  let ip_to_string ip = Ip.to_string ip  let ip_to_string ip = Ip.to_string ip
64      
65  (*************************************************************************)  (*************************************************************************)
66  (*                                                                       *)  (*                                                                       *)
67  (*                         crypt_and_send                                *)  (*                         crypt_and_send                                *)
68  (*                                                                       *)  (*                                                                       *)
69  (*************************************************************************)  (*************************************************************************)
70      
71  let crypt_and_send sock out_cipher str =  let crypt_and_send sock out_cipher str =
72    if !verbose_msg_raw || monitored sock then    if !verbose_msg_raw || monitored sock then
73      lprintf "crypt_and_send: to send [%s]\n" (String.escaped str);      lprintf "crypt_and_send: to send [%s]\n" (String.escaped str);
74    let str = String.copy str in    let str = String.copy str in
75    apply_cipher out_cipher str 0 (String.length str);    apply_cipher out_cipher str 0 (String.length str);
76    if !verbose_msg_raw || monitored sock then    if !verbose_msg_raw || monitored sock then
77      lprintf "crypt_and_send: [%s] sent\n" (String.escaped str);        lprintf "crypt_and_send: [%s] sent\n" (String.escaped str);
78    write_string sock str    write_string sock str
79    
80  (*************************************************************************)  (*************************************************************************)
# Line 82  let crypt_and_send sock out_cipher str = Line 82  let crypt_and_send sock out_cipher str =
82  (*                         server_crypt_and_send                         *)  (*                         server_crypt_and_send                         *)
83  (*                                                                       *)  (*                                                                       *)
84  (*************************************************************************)  (*************************************************************************)
85      
86  let server_crypt_and_send s out_cipher str =  let server_crypt_and_send s out_cipher str =
87    match s.server_sock with    match s.server_sock with
88    | Connection sock ->    | Connection sock ->
# Line 108  let bprint_chars b s = Line 108  let bprint_chars b s =
108    
109  let tag_of_tag tag s =  let tag_of_tag tag s =
110    match tag with    match tag with
111    | Field_UNKNOWN "any"    | Field_UNKNOWN "any"
112    | Field_Filename    | Field_Filename
113    | Field_Uid    | Field_Uid
114    | Field_Title    | Field_Title
# Line 126  let tag_of_tag tag s = Line 126  let tag_of_tag tag s =
126        string_tag tag s        string_tag tag s
127    | Field_UNKNOWN "bitdepth"    | Field_UNKNOWN "bitdepth"
128    | Field_UNKNOWN "year"    | Field_UNKNOWN "year"
129    | Field_UNKNOWN "rating"    | Field_UNKNOWN "rating"
130    | Field_UNKNOWN "quality"    | Field_UNKNOWN "quality"
131    | Field_Size ->    | Field_Size ->
132        let s, _ = get_dynint s 0 in        let s, _ = get_dynint s 0 in
# Line 135  let tag_of_tag tag s = Line 135  let tag_of_tag tag s =
135        let n1, pos = get_dynint s 0 in        let n1, pos = get_dynint s 0 in
136        let n2, pos = get_dynint s pos in        let n2, pos = get_dynint s pos in
137        { tag_name =  tag; tag_value = Pair (n1, n2) }        { tag_name =  tag; tag_value = Pair (n1, n2) }
138      
139    | Field_Completesources    | Field_Completesources
140    | Field_Availability    | Field_Availability
141    | Field_Length    | Field_Length
142    | Field_Bitrate    | Field_Bitrate
# Line 152  let image_realm = 0x23 Line 152  let image_realm = 0x23
152  let text_realm = 0x24  let text_realm = 0x24
153  let application_realm = 0x25  let application_realm = 0x25
154  let any_realm = 0x3f  let any_realm = 0x3f
155      
156  (*************************************************************************)  (*************************************************************************)
157  (*                                                                       *)  (*                                                                       *)
158  (*                         TcpMessages                                   *)  (*                         TcpMessages                                   *)
159  (*                                                                       *)  (*                                                                       *)
160  (*************************************************************************)  (*************************************************************************)
161          
162  module TcpMessages = struct  module TcpMessages = struct
163    
164    
# Line 167  module TcpMessages = struct Line 167  module TcpMessages = struct
167  (*                         TYPES                                         *)  (*                         TYPES                                         *)
168  (*                                                                       *)  (*                                                                       *)
169  (*************************************************************************)  (*************************************************************************)
170        
171      type unicast_address = {      type unicast_address = {
172          unicast_source_ip : Ip.t;          unicast_source_ip : Ip.t;
173          unicast_source_port : int;          unicast_source_port : int;
# Line 175  module TcpMessages = struct Line 175  module TcpMessages = struct
175          unicast_dest_port : int;          unicast_dest_port : int;
176          unicast_hops : int;          unicast_hops : int;
177        }        }
178        
179      type broadcast_address = {      type broadcast_address = {
180          broadcast_source_ip : Ip.t;          broadcast_source_ip : Ip.t;
181          broadcast_source_port : int;          broadcast_source_port : int;
182          broadcast_unknown : int;          broadcast_unknown : int;
183          broadcast_hops : int;          broadcast_hops : int;
184        }        }
185        
186      type packet_path =      type packet_path =
187        DirectPacket        DirectPacket
188      | UnicastPacket of unicast_address      | UnicastPacket of unicast_address
189      | BroadcastPacket of broadcast_address      | BroadcastPacket of broadcast_address
190        
191      type result_user = {      type result_user = {
192          user_ip : Ip.t;          user_ip : Ip.t;
193          user_port : int;          user_port : int;
# Line 195  module TcpMessages = struct Line 195  module TcpMessages = struct
195          user_name : string;          user_name : string;
196          user_netname : string;          user_netname : string;
197        }        }
198        
199      type result_meta = {      type result_meta = {
200          meta_hash : Md5Ext.t;          meta_hash : Md5Ext.t;
201          meta_checksum : int64;          meta_checksum : int64;
202          meta_size : int64;          meta_size : int64;
203          meta_tags : tag list;          meta_tags : tag list;
204        }        }
205        
206      type push = {      type push = {
207          push_id : int64;          push_id : int64;
208            
209          dest_ip : Ip.t;          dest_ip : Ip.t;
210          dest_port : int;          dest_port : int;
211            
212          pushing_ip : Ip.t;          pushing_ip : Ip.t;
213          pushing_port : int;          pushing_port : int;
214            
215          pushing_supernode_ip : Ip.t;          pushing_supernode_ip : Ip.t;
216          pushing_supernode_port : int;          pushing_supernode_port : int;
217            
218          pushing_name : string          pushing_name : string
219        }        }
220        
221      type shared_file = {      type shared_file = {
222          shared_type : int;          shared_type : int;
223          shared_hash : Md5Ext.t;          shared_hash : Md5Ext.t;
# Line 225  module TcpMessages = struct Line 225  module TcpMessages = struct
225          shared_size : int64;          shared_size : int64;
226          shared_tags : tag list;          shared_tags : tag list;
227        }        }
228        
229      type neighbour = {      type neighbour = {
230          neighbour_ip : Ip.t;          neighbour_ip : Ip.t;
231          neighbour_port : int;          neighbour_port : int;
232  (*  (*
233  the fourth byte is the same as the last byte of NodeInfoReq  the fourth byte is the same as the last byte of NodeInfoReq
234  *)  *)
235          neighbour_info : string;          neighbour_info : string;
236          mutable neighbour_hops : int;          mutable neighbour_hops : int;
237        }        }
238        
239      type stats = {      type stats = {
240          nusers : int64;          nusers : int64;
241          nfiles : int64;          nfiles : int64;
# Line 249  the fourth byte is the same as the last Line 249  the fourth byte is the same as the last
249          fd_artist : string;          fd_artist : string;
250          fd_title : string;          fd_title : string;
251        }        }
252          
253      type query =      type query =
254      | QueryFilesReq of string * int * query_term list      | QueryFilesReq of string * int * query_term list
255      | QueryLocationReq of Md5Ext.t      | QueryLocationReq of Md5Ext.t
256    
257  (* TODO: where do we publish the port where clients can connect us ?? *)  (* TODO: where do we publish the port where clients can connect us ?? *)
258      type t =          type t =
259    
260  (* 0x00 *)    | NodeListReq of (Ip.t * int * int * int) list  (* 0x00 *)    | NodeListReq of (Ip.t * int * int * int) list
261  (* 0x01 *)    | DeclareNeighbours of neighbour list  (* 0x01 *)    | DeclareNeighbours of neighbour list
# Line 264  the fourth byte is the same as the last Line 264  the fourth byte is the same as the last
264    
265  (* 0x05 *)    | UnshareFileReq of shared_file  (* 0x05 *)    | UnshareFileReq of shared_file
266  (* 0x06 *)    | SearchReq of int * int * query  (* 0x06 *)    | SearchReq of int * int * query
267  (* 0x07 *)    | QueryReplyReq of  (* 0x07 *)    | QueryReplyReq of
268        (Ip.t * int) *        (Ip.t * int) *
269        int *        int *
270        (result_user * result_meta)  list        (result_user * result_meta)  list
271  (* 0x08 *)    | QueryReplyEndReq of int  (* 0x08 *)    | QueryReplyEndReq of int
272  (* 0x09 *)    | NetworkStatsReq of stats list * string * int64  (* 0x09 *)    | NetworkStatsReq of stats list * string * int64
# Line 279  the fourth byte is the same as the last Line 279  the fourth byte is the same as the last
279  (* 0x0d *)    | PushRequestReq of push  (* 0x0d *)    | PushRequestReq of push
280    
281  (* 0x15 *)    | AskUDPConnectionReq of Ip.t * int  (* 0x15 *)    | AskUDPConnectionReq of Ip.t * int
282          
283  (* 0x16 ?? *)  (* 0x16 ?? *)
284  (* 0x17 ?? *)  (* 0x17 ?? *)
285    
# Line 288  the fourth byte is the same as the last Line 288  the fourth byte is the same as the last
288  (* 0x1e ?? *) | Unknown_1e of int  (* 0x1e ?? *) | Unknown_1e of int
289    
290  (* 0x1f Network update *)  (* 0x1f Network update *)
291          
292  (* 0x20 *)    | RandomFilesReq of int * file_descr list  (* 0x20 *)    | RandomFilesReq of int * file_descr list
293    
294  (* 0x21 Random file *)  (* 0x21 Random file *)
# Line 297  the fourth byte is the same as the last Line 297  the fourth byte is the same as the last
297  (* 0x23 *)    | Unknown_23 of int  (* 0x23 *)    | Unknown_23 of int
298    
299  (* 0x24 *)    | NetworkGlobalStats of string * (string * int64) list  (* 0x24 *)    | NetworkGlobalStats of string * (string * int64) list
300          
301  (* 0x26 *)    | ProtocolVersionReq of int  (* 0x26 *)    | ProtocolVersionReq of int
302    
303  (*        | 0x2b -> Unknown packet [opcode = 0x2b, len=1]  (*        | 0x2b -> Unknown packet [opcode = 0x2b, len=1]
304  MESSAGE 71 from 62.131.207.119:2354 time:97770972: DirectPacket  MESSAGE 71 from 62.131.207.119:2354 time:97770972: DirectPacket
305      Unknown packet [opcode = 0x2b, len=1]      Unknown packet [opcode = 0x2b, len=1]
306  ascii: [ ?]  ascii: [ ?]
# Line 311  dec: [(63)] Line 311  dec: [(63)]
311  (* 0x2c *)    | ExternalIpReq of Ip.t  (* 0x2c *)    | ExternalIpReq of Ip.t
312    
313  (* Direct Messages *)  (* Direct Messages *)
314      | PingReq      | PingReq
315      | PongReq      | PongReq
316    
317  (* Unknown Messages *)  (* Unknown Messages *)
# Line 323  dec: [(63)] Line 323  dec: [(63)]
323  (*                         crypt (internal)                              *)  (*                         crypt (internal)                              *)
324  (*                                                                       *)  (*                                                                       *)
325  (*************************************************************************)  (*************************************************************************)
326        
327      let crypt ciphers msg_type addr m =      let crypt ciphers msg_type addr m =
328        let size = String.length m in        let size = String.length m in
329          
330        let b = Buffer.create 100 in        let b = Buffer.create 100 in
331        buf_int8 b 0x4b; (* 'K' *)        buf_int8 b 0x4b; (* 'K' *)
332          
333        let msg_type =        let msg_type =
334          match addr with          match addr with
335            DirectPacket -> msg_type            DirectPacket -> msg_type
336                
337          | BroadcastPacket addr ->          | BroadcastPacket addr ->
338              LittleEndian.buf_ip b addr.broadcast_source_ip;              LittleEndian.buf_ip b addr.broadcast_source_ip;
339              buf_int16 b addr.broadcast_source_port;              buf_int16 b addr.broadcast_source_port;
# Line 346  dec: [(63)] Line 346  dec: [(63)]
346              LittleEndian.buf_ip b addr.unicast_dest_ip;              LittleEndian.buf_ip b addr.unicast_dest_ip;
347              buf_int16 b addr.unicast_dest_port;              buf_int16 b addr.unicast_dest_port;
348              buf_int8 b addr.unicast_hops;              buf_int8 b addr.unicast_hops;
349                
350              0x80 lor msg_type              0x80 lor msg_type
351        in        in
352          
353        let lo_len = size land 0xff in        let lo_len = size land 0xff in
354        let hi_len = (size lsr 8) land 0xff in        let hi_len = (size lsr 8) land 0xff in
355          
356        let lo_type = msg_type land 0xff in        let lo_type = msg_type land 0xff in
357        let hi_type = (msg_type lsr 8) land 0xff in        let hi_type = (msg_type lsr 8) land 0xff in
358          
359        let xtype = Int64.to_int (Int64.rem ciphers.out_xinu int64_3) in        let xtype = Int64.to_int (Int64.rem ciphers.out_xinu int64_3) in
360          
361        let _ = match xtype with        let _ = match xtype with
362            
363          | 0 ->          | 0 ->
364              buf_int8 b lo_type;              buf_int8 b lo_type;
365              buf_int8 b hi_type;              buf_int8 b hi_type;
# Line 378  dec: [(63)] Line 378  dec: [(63)]
378        in        in
379    
380  (* update xinu state *)  (* update xinu state *)
381        ciphers.out_xinu <- Int64.logxor ciphers.out_xinu          ciphers.out_xinu <- Int64.logxor ciphers.out_xinu
382          (Int64.logand          (Int64.logand
383            (Int64.lognot (Int64.of_int (size + msg_type)))            (Int64.lognot (Int64.of_int (size + msg_type)))
384          int64_ffffffff);          int64_ffffffff);
385          
386        Buffer.add_string b m;        Buffer.add_string b m;
387        Buffer.contents b            Buffer.contents b
388    
389  (*************************************************************************)  (*************************************************************************)
390  (*                                                                       *)  (*                                                                       *)
391  (*                         buf_string                                    *)  (*                         buf_string                                    *)
392  (*                                                                       *)  (*                                                                       *)
393  (*************************************************************************)  (*************************************************************************)
394        
395      let buf_string b s =      let buf_string b s =
396        buf_dynint b (Int64.of_int (String.length s));        buf_dynint b (Int64.of_int (String.length s));
397        Buffer.add_string b s        Buffer.add_string b s
398        
399      let get_string s pos =      let get_string s pos =
400        let len, pos = get_dynint s pos in        let len, pos = get_dynint s pos in
401        let len = Int64.to_int len in        let len = Int64.to_int len in
# Line 405  dec: [(63)] Line 405  dec: [(63)]
405      let get_string0 s pos =      let get_string0 s pos =
406        let n = String.index_from s pos '\000' in        let n = String.index_from s pos '\000' in
407        String.sub s pos (n-pos), n+1        String.sub s pos (n-pos), n+1
408          
409  (*************************************************************************)  (*************************************************************************)
410  (*                                                                       *)  (*                                                                       *)
411  (*                         buf_query                                     *)  (*                         buf_query                                     *)
412  (*                                                                       *)  (*                                                                       *)
413  (*************************************************************************)  (*************************************************************************)
414        
415      let buf_query b s_uid query =      let buf_query b s_uid query =
416    
417  (* search id *)  (* search id *)
# Line 419  dec: [(63)] Line 419  dec: [(63)]
419  (* dunno what this is *)  (* dunno what this is *)
420        buf_int8 b 0x01;        buf_int8 b 0x01;
421        match query with        match query with
422          
423        | QueryFilesReq (words, realm, tags) ->        | QueryFilesReq (words, realm, tags) ->
424              
425  (*          lprintf "UserSearch [%s] for %d\n" words s_uid; *)  (*          lprintf "UserSearch [%s] for %d\n" words s_uid; *)
426    
427  (* realm is video/..., audio/..., and strings like that. Avoid them currently.*)  (* realm is video/..., audio/..., and strings like that. Avoid them currently.*)
428            buf_int8 b realm;            buf_int8 b realm;
429              
430            let tags =            let tags =
431              if words <> "" then              if words <> "" then
432                (Substring, string_tag (Field_UNKNOWN "any") words) :: tags                (Substring, string_tag (Field_UNKNOWN "any") words) :: tags
433              else tags in              else tags in
434            buf_int8 b (List.length tags);            buf_int8 b (List.length tags);
435              
436            List.iter (fun (operator, tag) ->            List.iter (fun (operator, tag) ->
437                let s = match tag.tag_value with                let s = match tag.tag_value with
438                  | Uint64 v | Fint64 v -> dynint v                  | Uint64 v | Fint64 v -> dynint v
439                  | String v -> v                  | String v -> v
440                  | Pair (n1,n2) -> (dynint n1) ^ (dynint n2)                  | Pair (n1,n2) -> (dynint n1) ^ (dynint n2)
441                  | Uint8 _ | Uint16 _ | Addr _                  | Uint8 _ | Uint16 _ | Addr _
442                    -> assert false                    -> assert false
443                in                in
444                let code =                let code =
# Line 458  dec: [(63)] Line 458  dec: [(63)]
458                      | _ -> assert false);                      | _ -> assert false);
459                buf_string b s;                buf_string b s;
460            ) tags;            ) tags;
461          
462        | QueryLocationReq file_hash ->        | QueryLocationReq file_hash ->
463    
464  (* realm is video/..., audio/..., and strings like that. Avoid them currently.*)  (* realm is video/..., audio/..., and strings like that. Avoid them currently.*)
# Line 481  dec: [(63)] Line 481  dec: [(63)]
481  (*                         buf_tags                                      *)  (*                         buf_tags                                      *)
482  (*                                                                       *)  (*                                                                       *)
483  (*************************************************************************)  (*************************************************************************)
484        
485      let buf_tags b tags =      let buf_tags b tags =
486        let ntags = ref 0 in        let ntags = ref 0 in
487        let tags =        let tags =
# Line 502  dec: [(63)] Line 502  dec: [(63)]
502                )                )
503              with _ -> ()              with _ -> ()
504          ) tags;          ) tags;
505            
506          Buffer.contents buf          Buffer.contents buf
507        in        in
508          
509        buf_dynint b (Int64.of_int !ntags);        buf_dynint b (Int64.of_int !ntags);
510        Buffer.add_string b tags        Buffer.add_string b tags
511    
# Line 514  dec: [(63)] Line 514  dec: [(63)]
514  (*                         write                                         *)  (*                         write                                         *)
515  (*                                                                       *)  (*                                                                       *)
516  (*************************************************************************)  (*************************************************************************)
517        
518      let write ciphers addr t =      let write ciphers addr t =
519        match t with        match t with
520          PingReq -> "\080"          PingReq -> "\080"
521        | PongReq -> "\082"        | PongReq -> "\082"
522          
523        | UnknownMessageReq (_,s) -> s        | UnknownMessageReq (_,s) -> s
524          
525        | DeclareNeighbours neighbours ->        | DeclareNeighbours neighbours ->
526            let b = Buffer.create 100 in            let b = Buffer.create 100 in
527            List.iter (fun n ->            List.iter (fun n ->
528                LittleEndian.buf_ip b n.neighbour_ip;                LittleEndian.buf_ip b n.neighbour_ip;
# Line 531  dec: [(63)] Line 531  dec: [(63)]
531                Buffer.add_string b n.neighbour_info;                Buffer.add_string b n.neighbour_info;
532                buf_int8 b n.neighbour_hops                buf_int8 b n.neighbour_hops
533            ) neighbours;            ) neighbours;
534              
535            let m = Buffer.contents b in            let m = Buffer.contents b in
536            crypt ciphers 0x01 addr m            crypt ciphers 0x01 addr m
537          
538        | Unknown_1e v ->        | Unknown_1e v ->
539            let b = Buffer.create 100 in            let b = Buffer.create 100 in
540            buf_int b v;            buf_int b v;
541            let m = Buffer.contents b in            let m = Buffer.contents b in
542            crypt ciphers 0x1e addr m            crypt ciphers 0x1e addr m
543          
544        | Unknown_23 v ->        | Unknown_23 v ->
545            let b = Buffer.create 100 in            let b = Buffer.create 100 in
546            buf_int b v;            buf_int b v;
547            let m = Buffer.contents b in            let m = Buffer.contents b in
548            crypt ciphers 0x23 addr m            crypt ciphers 0x23 addr m
549          
550        | Unknown_2b v ->        | Unknown_2b v ->
551            let b = Buffer.create 100 in            let b = Buffer.create 100 in
552            buf_int8 b v;            buf_int8 b v;
553            let m = Buffer.contents b in            let m = Buffer.contents b in
554            crypt ciphers 0x2b addr m            crypt ciphers 0x2b addr m
555          
556        | AskUDPConnectionReq (ip, port) ->        | AskUDPConnectionReq (ip, port) ->
557            let b = Buffer.create 100 in            let b = Buffer.create 100 in
558            LittleEndian.buf_ip b ip;            LittleEndian.buf_ip b ip;
559            buf_int16 b port;            buf_int16 b port;
560            let m = Buffer.contents b in            let m = Buffer.contents b in
561            crypt ciphers 0x15 addr m            crypt ciphers 0x15 addr m
562          
563        | Unknown_03 -> crypt ciphers 0x03 addr ""        | Unknown_03 -> crypt ciphers 0x03 addr ""
564          
565        | SearchReq (max_results, s_uid, query) ->        | SearchReq (max_results, s_uid, query) ->
566            let b = Buffer.create 100 in            let b = Buffer.create 100 in
567            Buffer.add_string b "\000\001";            Buffer.add_string b "\000\001";
# Line 570  dec: [(63)] Line 570  dec: [(63)]
570            buf_query b s_uid query;            buf_query b s_uid query;
571            let m = Buffer.contents b in            let m = Buffer.contents b in
572            crypt ciphers 0x06 addr m            crypt ciphers 0x06 addr m
573          
574        | NetworkGlobalStats (s, nets) ->        | NetworkGlobalStats (s, nets) ->
575            let b = Buffer.create 100 in            let b = Buffer.create 100 in
576            Buffer.add_string b s;            Buffer.add_string b s;
# Line 581  dec: [(63)] Line 581  dec: [(63)]
581            ) nets;            ) nets;
582            let m = Buffer.contents b in            let m = Buffer.contents b in
583            crypt ciphers 0x24 addr m            crypt ciphers 0x24 addr m
584              
             
585        | SearchForwardReq (s, s_uid, query) ->        | SearchForwardReq (s, s_uid, query) ->
586            let b = Buffer.create 100 in            let b = Buffer.create 100 in
587            Buffer.add_string b s;            Buffer.add_string b s;
588            buf_query b s_uid query;            buf_query b s_uid query;
589            let m = Buffer.contents b in            let m = Buffer.contents b in
590            crypt ciphers 0x0a addr m            crypt ciphers 0x0a addr m
591          
592        | SearchForward2Req (s, s_uid, query) ->        | SearchForward2Req (s, s_uid, query) ->
593            let b = Buffer.create 100 in            let b = Buffer.create 100 in
594            Buffer.add_string b s;            Buffer.add_string b s;
595            buf_query b s_uid query;            buf_query b s_uid query;
596            let m = Buffer.contents b in            let m = Buffer.contents b in
597            crypt ciphers 0x0b addr m            crypt ciphers 0x0b addr m
598          
599        | ShareFileReq sh ->        | ShareFileReq sh ->
             
600            let module U = CommonUploads in            let module U = CommonUploads in
601            let buf = Buffer.create 100 in            let buf = Buffer.create 100 in
602              
603            Buffer.add_string buf "\000";            Buffer.add_string buf "\000";
604              
605            buf_int8 buf sh.shared_type; (* MEDIA_TYPE_UNKNOWN *)            buf_int8 buf sh.shared_type; (* MEDIA_TYPE_UNKNOWN *)
606    
607  (* unknown *)  (* unknown *)
# Line 618  dec: [(63)] Line 616  dec: [(63)]
616    
617  (* file size *)  (* file size *)
618            buf_dynint buf sh.shared_size;            buf_dynint buf sh.shared_size;
619              
620            buf_tags buf sh.shared_tags;            buf_tags buf sh.shared_tags;
621              
622            let m = Buffer.contents buf in            let m = Buffer.contents buf in
623            crypt ciphers 0x22 addr m            crypt ciphers 0x22 addr m
624          
625        | ProtocolVersionReq version ->        | ProtocolVersionReq version ->
626            let b = Buffer.create 4 in            let b = Buffer.create 4 in
627            buf_int b version;            buf_int b version;
628            let m = Buffer.contents b in            let m = Buffer.contents b in
629            crypt ciphers 0x26 addr m            crypt ciphers 0x26 addr m
630          
631        | UnshareFileReq sh ->        | UnshareFileReq sh ->
632            let buf = Buffer.create 100 in            let buf = Buffer.create 100 in
633    
# Line 642  dec: [(63)] Line 640  dec: [(63)]
640  (* file size *)  (* file size *)
641            buf_dynint buf sh.shared_size;            buf_dynint buf sh.shared_size;
642            buf_tags buf sh.shared_tags;            buf_tags buf sh.shared_tags;
643              
644            let m = Buffer.contents buf in            let m = Buffer.contents buf in
645            crypt ciphers 0x05 addr m            crypt ciphers 0x05 addr m
646          
647        | NetworkNameReq network_name ->        | NetworkNameReq network_name ->
648            crypt ciphers 0x1d addr network_name            crypt ciphers 0x1d addr network_name
649          
650        | NodeInfoReq (my_ip, my_port, bandwidth, client_name) ->        | NodeInfoReq (my_ip, my_port, bandwidth, client_name) ->
651            let b = Buffer.create 100 in            let b = Buffer.create 100 in
652    
# Line 663  dec: [(63)] Line 661  dec: [(63)]
661            buf_int8 b bandwidth;            buf_int8 b bandwidth;
662  (* 1 byte: dunno. *)  (* 1 byte: dunno. *)
663            buf_int8 b  0x00;            buf_int8 b  0x00;
664              
665            Buffer.add_string b client_name; (* no ending 0 *)            Buffer.add_string b client_name; (* no ending 0 *)
666            let m = Buffer.contents b in            let m = Buffer.contents b in
667            crypt ciphers 0x02 addr m            crypt ciphers 0x02 addr m
668          
669        | ExternalIpReq ip ->        | ExternalIpReq ip ->
670            let b = Buffer.create 10 in            let b = Buffer.create 10 in
671            LittleEndian.buf_ip b ip;            LittleEndian.buf_ip b ip;
672            let m = Buffer.contents b in            let m = Buffer.contents b in
673            crypt ciphers 0x2c addr m            crypt ciphers 0x2c addr m
674          
675        | UnknownReq (msg_type, m) ->        | UnknownReq (msg_type, m) ->
676            crypt ciphers msg_type addr m            crypt ciphers msg_type addr m
677          
678        | PushRequestReq push ->        | PushRequestReq push ->
679            let b = Buffer.create 100 in                      let b = Buffer.create 100 in
680              
681            buf_int64_32 b push.push_id;            buf_int64_32 b push.push_id;
682              
683            LittleEndian.buf_ip b push.dest_ip;            LittleEndian.buf_ip b push.dest_ip;
684            buf_int16 b push.dest_port;            buf_int16 b push.dest_port;
685              
686            LittleEndian.buf_ip b push.pushing_ip;            LittleEndian.buf_ip b push.pushing_ip;
687            buf_int16 b push.pushing_port;            buf_int16 b push.pushing_port;
688              
689            LittleEndian.buf_ip b push.pushing_supernode_ip;            LittleEndian.buf_ip b push.pushing_supernode_ip;
690            buf_int16 b push.pushing_supernode_port;            buf_int16 b push.pushing_supernode_port;
691              
692            Buffer.add_string b push.pushing_name;            Buffer.add_string b push.pushing_name;
693            let m = Buffer.contents b in            let m = Buffer.contents b in
694            crypt ciphers 0x0d addr m            crypt ciphers 0x0d addr m
695          
696        | NetworkStatsReq (stats, network, nusers) ->        | NetworkStatsReq (stats, network, nusers) ->
697            let b = Buffer.create 100 in                              let b = Buffer.create 100 in
698              
699            assert (List.length stats = 7);            assert (List.length stats = 7);
700              
701            List.iter (fun stats ->            List.iter (fun stats ->
702                buf_int64_32 b stats.nusers;                buf_int64_32 b stats.nusers;
703                buf_int64_32 b stats.nfiles;                buf_int64_32 b stats.nfiles;
704                  
705                let up_nkb = (lnot 0) lsl 16 in                let up_nkb = (lnot 0) lsl 16 in
706                  
707                let nkb = stats.nkb in                let nkb = stats.nkb in
708                if up_nkb land nkb = 0 then begin                if up_nkb land nkb = 0 then begin
709                      
710                    buf_int16 b nkb;                    buf_int16 b nkb;
711                    buf_int16 b 30;                    buf_int16 b 30;
712                    
713                  end else begin                  end else begin
714  (* TODO: compute the exact exponent *)  (* TODO: compute the exact exponent *)
715                    buf_int16 b (nkb lsr 15);                    buf_int16 b (nkb lsr 15);
716                    buf_int16 b 15;                    buf_int16 b 15;
717                    
718                  end;                  end;
719            ) stats;            ) stats;
720            Buffer.add_string b network;            Buffer.add_string b network;
721            buf_int8 b 0;            buf_int8 b 0;
722            buf_int64_32 b nusers;            buf_int64_32 b nusers;
723            let m = Buffer.contents b in            let m = Buffer.contents b in
724            crypt ciphers 0x09 addr m            crypt ciphers 0x09 addr m
725          
726        | NodeListReq list ->        | NodeListReq list ->
727              
728            let b = Buffer.create 100 in            let b = Buffer.create 100 in
729              
730            List.iter (fun (ip, port, last_seen, slots) ->                          List.iter (fun (ip, port, last_seen, slots) ->
731                LittleEndian.buf_ip b ip;                LittleEndian.buf_ip b ip;
732                buf_int16 b port;                buf_int16 b port;
733                buf_int8 b last_seen;                buf_int8 b last_seen;
734                buf_int8 b slots                buf_int8 b slots
735            )  list;            )  list;
736              
737            let m = Buffer.contents b in            let m = Buffer.contents b in
738            crypt ciphers 0x00 addr m            crypt ciphers 0x00 addr m
739          
740        | QueryReplyEndReq sid ->        | QueryReplyEndReq sid ->
741              
742            let b = Buffer.create 100 in            let b = Buffer.create 100 in
743            buf_int16 b sid;            buf_int16 b sid;
744            let m = Buffer.contents b in            let m = Buffer.contents b in
# Line 763  dec: [(63)] Line 761  dec: [(63)]
761            let m = Buffer.contents b in            let m = Buffer.contents b in
762            crypt ciphers 0x20 addr m            crypt ciphers 0x20 addr m
763    
764                    | QueryReplyReq ( (s_ip, s_port), s_uid, results) ->
765        | QueryReplyReq ( (s_ip, s_port), s_uid, results) ->  
             
766            let b = Buffer.create 100 in            let b = Buffer.create 100 in
767              
768            LittleEndian.buf_ip b s_ip;            LittleEndian.buf_ip b s_ip;
769            buf_int16 b s_port;            buf_int16 b s_port;
770            buf_int16 b s_uid;            buf_int16 b s_uid;
771              
772            buf_int16 b (List.length results);            buf_int16 b (List.length results);
773              
774            List.iter (fun (user, meta) ->            List.iter (fun (user, meta) ->
775  (* user *)                (* user *)
776                LittleEndian.buf_ip b user.user_ip;                LittleEndian.buf_ip b user.user_ip;
777                buf_int16 b user.user_port;                buf_int16 b user.user_port;
778                buf_int8 b user.user_bandwidth;                buf_int8 b user.user_bandwidth;
# Line 790  dec: [(63)] Line 787  dec: [(63)]
787                buf_dynint b meta.meta_size;                buf_dynint b meta.meta_size;
788                buf_tags b meta.meta_tags;                buf_tags b meta.meta_tags;
789            ) results;            ) results;
790              
791            let m = Buffer.contents b in            let m = Buffer.contents b in
792            crypt ciphers 0x07 addr m            crypt ciphers 0x07 addr m
793    
# Line 801  dec: [(63)] Line 798  dec: [(63)]
798  (*                         get_filename (internal)                       *)  (*                         get_filename (internal)                       *)
799  (*                                                                       *)  (*                                                                       *)
800  (*************************************************************************)  (*************************************************************************)
801        
802      let get_filename tags =      let get_filename tags =
803        try        try
804          match find_tag Field_Filename tags with          match find_tag Field_Filename tags with
805            String s -> s | _ -> raise Not_found with            String s -> s | _ -> raise Not_found with
806          _ -> "Unknown"          _ -> "Unknown"
807    
808  (*************************************************************************)  (*************************************************************************)
809  (*                                                                       *)  (*                                                                       *)
810  (*                         get_tags (internal)                           *)  (*                         get_tags (internal)                           *)
811  (*                                                                       *)  (*                                                                       *)
812  (*************************************************************************)  (*************************************************************************)
813        
       
814      let get_tags m pos =      let get_tags m pos =
815        let ntags, pos = get_dynint m pos in        let ntags, pos = get_dynint m pos in
816        let ntags = Int64.to_int ntags in        let ntags = Int64.to_int ntags in
817        let len = String.length m in        let len = String.length m in
818          
819        let rec iter_tags pos n tags =        let rec iter_tags pos n tags =
820          if n > 0 && pos < len-2 then          if n > 0 && pos < len-2 then
821            let tag, pos = get_dynint m pos in            let tag, pos = get_dynint m pos in
# Line 831  dec: [(63)] Line 827  dec: [(63)]
827  (*          lprintf "  value [%s]\n"  (*          lprintf "  value [%s]\n"
828              (String.escaped (String.sub m pos tag_len)); *)              (String.escaped (String.sub m pos tag_len)); *)
829            let tagdata =            let tagdata =
830              match tag with              match tag with
831              | 1  (* 0x01 year *)              | 1  (* 0x01 year *)
832              | 5  (* 0x05 duration *)              | 5  (* 0x05 duration *)
833              | 9  (* 0x09 ??? *)              | 9  (* 0x09 ??? *)
834              | 17 (* 0x11 bitdepth *)              | 17 (* 0x11 bitdepth *)
# Line 844  dec: [(63)] Line 840  dec: [(63)]
840                ->                ->
841                  let dynint, npos = get_dynint m pos in                  let dynint, npos = get_dynint m pos in
842                  Uint64 dynint                  Uint64 dynint
843                
844              | 0x0d ->              | 0x0d ->
845                  let n1, npos = get_dynint m pos in                  let n1, npos = get_dynint m pos in
846                  let n2, npos = get_dynint m pos in                  let n2, npos = get_dynint m pos in
# Line 852  dec: [(63)] Line 848  dec: [(63)]
848    
849    
850  (*  (*
851              | 5 -> time_of_sec (Int64.to_int dynint);              | 5 -> time_of_sec (Int64.to_int dynint);
852              | 21 -> Printf.sprintf "%Ld kbs" dynint;              | 21 -> Printf.sprintf "%Ld kbs" dynint;
853              | 13 -> let dynint2, _ = get_dynint m npos in              | 13 -> let dynint2, _ = get_dynint m npos in
854                  Printf.sprintf "%Ldx%Ld" dynint dynint2;                  Printf.sprintf "%Ldx%Ld" dynint dynint2;
855              | 1 | 17 -> Printf.sprintf "%Ld" dynint;              | 1 | 17 -> Printf.sprintf "%Ld" dynint;
856              | 29 -> (match (Int64.to_int dynint) with              | 29 -> (match (Int64.to_int dynint) with
857                    | 0 -> "Very Poor"                    | 0 -> "Very Poor"
858                    | 1 -> "Poor"                    | 1 -> "Poor"
# Line 868  dec: [(63)] Line 864  dec: [(63)]
864            in            in
865            let tag = try            let tag = try
866                List2.assoc_inv tag name_of_tag                List2.assoc_inv tag name_of_tag
867              with _ ->              with _ ->
868                  Field_UNKNOWN (string_of_int tag)                  Field_UNKNOWN (string_of_int tag)
869            in            in
870            iter_tags (pos + tag_len) (n-1)            iter_tags (pos + tag_len) (n-1)
871            ((new_tag tag tagdata) :: tags)            ((new_tag tag tagdata) :: tags)
872          else          else
873            tags, pos            tags, pos
# Line 884  dec: [(63)] Line 880  dec: [(63)]
880  (*                         get_query (internal)                          *)  (*                         get_query (internal)                          *)
881  (*                                                                       *)  (*                                                                       *)
882  (*************************************************************************)  (*************************************************************************)
883        
884      let get_query m pos =      let get_query m pos =
885        let s_uid = get_int16 m pos in        let s_uid = get_int16 m pos in
886          
887        if m.[pos+2] <> '\001' then        if m.[pos+2] <> '\001' then
888          lprintf "WARNING: query : third byte is %d, not 1\n"          lprintf "WARNING: query : third byte is %d, not 1\n"
889            (int_of_char m.[pos+2]);            (int_of_char m.[pos+2]);
890          
891        let realm = get_int8 m (pos+3) in              let realm = get_int8 m (pos+3) in
892        let nterms = get_int8 m (pos+4) in        let nterms = get_int8 m (pos+4) in
893          
894        let first_op = get_int8 m (pos+5)  in        let first_op = get_int8 m (pos+5)  in
895        let first_tag = get_int8 m (pos+6) in        let first_tag = get_int8 m (pos+6) in
896          
897        s_uid,        s_uid,
898        if  first_op = 0 && first_tag = 3 then begin        if  first_op = 0 && first_tag = 3 then begin
899            let hash, pos = get_string m (pos+7) in            let hash, pos = get_string m (pos+7) in
900            let hash = Md5Ext.direct_of_string hash in            let hash = Md5Ext.direct_of_string hash in
901            QueryLocationReq hash            QueryLocationReq hash
902            
903          end else begin          end else begin
904              
905            let rec iter pos nterms =            let rec iter pos nterms =
906              if nterms = 0 then [] else              if nterms = 0 then [] else
907              let code = get_int8 m pos in              let code = get_int8 m pos in
908              if code = 6 then [] else              if code = 6 then [] else
909              let tag = get_int8 m (pos+1) in              let tag = get_int8 m (pos+1) in
910              let tag =              let tag =
911                try                try
912                  List2.assoc_inv tag name_of_tag                  List2.assoc_inv tag name_of_tag
913                with Not_found as e ->                with Not_found as e ->
914                    lprintf "WARNING Unknown tag %d\n" tag;                    lprintf "WARNING Unknown tag %d\n" tag;
915                    Field_UNKNOWN (string_of_int tag)                    Field_UNKNOWN (string_of_int tag)
# Line 936  dec: [(63)] Line 932  dec: [(63)]
932            let terms = iter (pos+5) nterms in            let terms = iter (pos+5) nterms in
933            QueryFilesReq ("", realm, terms)            QueryFilesReq ("", realm, terms)
934          end          end
935        
936      exception MessageNotUnderstood      exception MessageNotUnderstood
937    
938  (*************************************************************************)  (*************************************************************************)
# Line 944  dec: [(63)] Line 940  dec: [(63)]
940  (*                         parse_packet (internal)                       *)  (*                         parse_packet (internal)                       *)
941  (*                                                                       *)  (*                                                                       *)
942  (*************************************************************************)  (*************************************************************************)
943        
944      let parse_packet msg_type m =      let parse_packet msg_type m =
945        try        try
946          match msg_type with          match msg_type with
947            
948          | 0x00 ->          | 0x00 ->
949                
950              let list =              let list =
951                let n = String.length m / 8 in                let n = String.length m / 8 in
952                let rec iter i list =                let rec iter i list =
953                  if i = n then List.rev list else                  if i = n then List.rev list else
# Line 959  dec: [(63)] Line 955  dec: [(63)]
955                  let l_port = get_int16 m (i*8+4) in                  let l_port = get_int16 m (i*8+4) in
956                  let seen = get_int8 m (i*8+6) in                  let seen = get_int8 m (i*8+6) in
957                  let slots = get_int8 m (i*8+7) in                  let slots = get_int8 m (i*8+7) in
958                    
959                  iter (i+1) ( (l_ip, l_port, seen, slots) :: list)                  iter (i+1) ( (l_ip, l_port, seen, slots) :: list)
960                in                in
961                iter 0 []                iter 0 []
962              in              in
963              NodeListReq list              NodeListReq list
964            
965                    | 0x01 ->
         | 0x01 ->  
966              let rec iter pos neighbours =              let rec iter pos neighbours =
967                if pos = String.length m then List.rev neighbours else                if pos = String.length m then List.rev neighbours else
968                let ip = LittleEndian.get_ip m pos in                let ip = LittleEndian.get_ip m pos in
# Line 980  dec: [(63)] Line 975  dec: [(63)]
975                    neighbour_info = info;                    neighbour_info = info;
976                    neighbour_hops = hops;                    neighbour_hops = hops;
977                  } in                  } in
978                iter (pos+26) (n :: neighbours)                  iter (pos+26) (n :: neighbours)
979              in              in
980              let neighbours = iter 0 [] in              let neighbours = iter 0 [] in
981              DeclareNeighbours neighbours              DeclareNeighbours neighbours
982            
983          | 0x02 ->          | 0x02 ->
984                
985              let my_ip = LittleEndian.get_ip m 0 in              let my_ip = LittleEndian.get_ip m 0 in
986              let my_port = get_int16 m 4 in              let my_port = get_int16 m 4 in
987                
988              let bandwidth = get_int8 m 6 in              let bandwidth = get_int8 m 6 in
989              let next_byte = get_int8 m 7 in              let next_byte = get_int8 m 7 in
990                
991              let client_name = String.sub m 8 (String.length m - 8) in              let client_name = String.sub m 8 (String.length m - 8) in
992                
               
993              NodeInfoReq (my_ip, my_port, bandwidth, client_name)              NodeInfoReq (my_ip, my_port, bandwidth, client_name)
994            
995          | 0x03 -> Unknown_03          | 0x03 -> Unknown_03
996            
997          | 0x05 ->          | 0x05 ->
998                
999              let shared_hash = String.sub m 0 20 in              let shared_hash = String.sub m 0 20 in
1000              let shared_checksum, pos = get_dynint m 20 in              let shared_checksum, pos = get_dynint m 20 in
1001              let shared_size, pos = get_dynint m pos in              let shared_size, pos = get_dynint m pos in
1002              let shared_tags, pos = get_tags m pos in              let shared_tags, pos = get_tags m pos in
1003                
1004              let computed_checksum = Int64.of_int              let computed_checksum = Int64.of_int
1005                  (fst_hash_checksum shared_hash) in                  (fst_hash_checksum shared_hash) in
1006              if computed_checksum <> shared_checksum then begin              if computed_checksum <> shared_checksum then begin
1007                  lprintf "Bad COMPUTED checksum for hash\n";                  lprintf "Bad COMPUTED checksum for hash\n";
1008                end;                end;
1009              let shared_hash = Md5Ext.direct_of_string shared_hash in                          let shared_hash = Md5Ext.direct_of_string shared_hash in
1010                
1011              UnshareFileReq {              UnshareFileReq {
1012                shared_type = 0;                shared_type = 0;
1013                shared_checksum = shared_checksum;                shared_checksum = shared_checksum;
# Line 1021  dec: [(63)] Line 1015  dec: [(63)]
1015                shared_size = shared_size;                shared_size = shared_size;
1016                shared_tags = shared_tags;                shared_tags = shared_tags;
1017              }              }
1018            
1019          | 0x06 ->          | 0x06 ->
1020                
1021              assert (m.[0] = '\000');              assert (m.[0] = '\000');
1022                
1023  (* second byte is sometimes 0, often with a SID greater than 25000 *)  (* second byte is sometimes 0, often with a SID greater than 25000 *)
1024              if m.[1] <> '\001' then              if m.[1] <> '\001' then
1025                lprintf "WARNING: opcode 0x06 : second byte is %d, not 1\n"                lprintf "WARNING: opcode 0x06 : second byte is %d, not 1\n"
1026                  (int_of_char m.[1]);                  (int_of_char m.[1]);
1027                
1028              let max_results = get_int16 m 2 in              let max_results = get_int16 m 2 in
1029              let s_uid, query = get_query m 4 in              let s_uid, query = get_query m 4 in
1030              SearchReq (max_results, s_uid, query)              SearchReq (max_results, s_uid, query)
1031            
1032          | 0x07 ->          | 0x07 ->
1033    
1034  (* probably supernode address *)  (* probably supernode address *)
1035              let s_ip = LittleEndian.get_ip m 0 in              let s_ip = LittleEndian.get_ip m 0 in
1036              let s_port = get_int16 m 4 in              let s_port = get_int16 m 4 in
1037                
1038              let id = get_int16 m 6 in              let id = get_int16 m 6 in
1039                
1040              let nresults = get_int16 m 8 in              let nresults = get_int16 m 8 in
1041                
1042              let len = String.length m in              let len = String.length m in
1043              let rec iter pos n results =              let rec iter pos n results =
1044                if n > 0 && pos + 32 < len then                if n > 0 && pos + 32 < len then
1045                  let user_ip = LittleEndian.get_ip m pos in                  let user_ip = LittleEndian.get_ip m pos in
1046                  let user_port = get_int16 m (pos+4) in                  let user_port = get_int16 m (pos+4) in
# Line 1062  dec: [(63)] Line 1056  dec: [(63)]
1056                    String.sub m (end_name+1) (end_netname - end_name -1),                    String.sub m (end_name+1) (end_netname - end_name -1),
1057                    end_netname + 1                    end_netname + 1
1058                  in                  in
1059                    
1060                  let user = {                  let user = {
1061                      user_name = user_name;                      user_name = user_name;
1062                      user_ip = user_ip;                      user_ip = user_ip;
# Line 1070  dec: [(63)] Line 1064  dec: [(63)]
1064                      user_bandwidth = user_bandwidth;                      user_bandwidth = user_bandwidth;
1065                      user_netname = user_netname;                      user_netname = user_netname;
1066                    } in                    } in
1067                    
                   
1068                  let result_hash = String.sub m pos 20 in                  let result_hash = String.sub m pos 20 in
1069                  let result_checksum, pos = get_dynint m (pos+20) in                  let result_checksum, pos = get_dynint m (pos+20) in
1070                  let result_size, pos = get_dynint m pos in                  let result_size, pos = get_dynint m pos in
1071                    
                   
1072                  let computed_checksum = Int64.of_int                  let computed_checksum = Int64.of_int
1073                      (fst_hash_checksum result_hash) in                      (fst_hash_checksum result_hash) in
1074                  if computed_checksum <> result_checksum then begin                  if computed_checksum <> result_checksum then begin
1075                      lprintf "Bad COMPUTED checksum for hash\n";                      lprintf "Bad COMPUTED checksum for hash\n";
1076                    end;                    end;
1077                    
1078                  let result_hash = Md5Ext.direct_of_string result_hash in                  let result_hash = Md5Ext.direct_of_string result_hash in
1079                    
1080                  let result_tags, pos = get_tags m pos in                  let result_tags, pos = get_tags m pos in
1081                    
1082                  let meta = {                  let meta = {
1083                      meta_tags = result_tags;                      meta_tags = result_tags;
1084                      meta_hash = result_hash;                      meta_hash = result_hash;
1085                      meta_checksum = result_checksum;                      meta_checksum = result_checksum;
1086                      meta_size = result_size;                      meta_size = result_size;
1087                    } in                    } in
1088                    
1089                  iter pos (n-1) ((user, meta) :: results)                  iter pos (n-1) ((user, meta) :: results)
1090                else List.rev results                else List.rev results
1091              in              in
1092              let results = iter 10 nresults [] in              let results = iter 10 nresults [] in
1093                
1094              QueryReplyReq ( (s_ip, s_port), id, results)              QueryReplyReq ( (s_ip, s_port), id, results)
1095            
1096          | 0x08 ->          | 0x08 ->
1097                
1098              QueryReplyEndReq (get_int16 m 0)              QueryReplyEndReq (get_int16 m 0)
1099            
1100          | 0x09 ->          | 0x09 ->
1101                
1102              let rec iter i =              let rec iter i =
1103                if i = 7 then [] else                if i = 7 then [] else
1104                let nusers = get_uint64_32 m (i * 12) in                let nusers = get_uint64_32 m (i * 12) in
1105                let nfiles = get_uint64_32 m (i * 12 + 4) in                let nfiles = get_uint64_32 m (i * 12 + 4) in
1106                  
1107                let nkb =                let nkb =
1108                  let mantissa = get_int16 m (i * 12 + 8) in                  let mantissa = get_int16 m (i * 12 + 8) in
1109                  let exponent = get_int16 m (i * 12 + 10) in                  let exponent = get_int16 m (i * 12 + 10) in
1110                    
1111                  if exponent >= 30 then                  if exponent >= 30 then
1112                    (mantissa lsl (exponent-30))                    (mantissa lsl (exponent-30))
1113                  else                  else
1114                    (mantissa lsl (30-exponent));                    (mantissa lsl (30-exponent));
# Line 1125  dec: [(63)] Line 1117  dec: [(63)]
1117                  nusers = nusers;                  nusers = nusers;
1118                  nfiles = nfiles;                  nfiles = nfiles;
1119                  nkb = nkb;                  nkb = nkb;
1120                } :: (iter (i+1))                } :: (iter (i+1))
1121              in              in
1122              let stats = iter 0 in              let stats = iter 0 in
1123              let len = String.length m in              let len = String.length m in
1124              let netname = String.sub m 84 (len - 89) in              let netname = String.sub m 84 (len - 89) in
1125              let nusers = get_uint64_32 m (len - 4) in              let nusers = get_uint64_32 m (len - 4) in
1126              NetworkStatsReq (stats, netname, nusers)              NetworkStatsReq (stats, netname, nusers)
1127            
1128          | 0x0a ->          | 0x0a ->
1129              let s = String.sub m 0 4 in              let s = String.sub m 0 4 in
1130              let s_uid, query = get_query m 4 in              let s_uid, query = get_query m 4 in
1131              SearchForwardReq (s, s_uid, query)                    SearchForwardReq (s, s_uid, query)
1132            
1133          | 0x0b ->          | 0x0b ->
1134              let s = String.sub m 0 4 in              let s = String.sub m 0 4 in
1135              let s_uid, query = get_query m 4 in              let s_uid, query = get_query m 4 in
1136              SearchForward2Req (s, s_uid, query)              SearchForward2Req (s, s_uid, query)
1137                
1138          | 0x0d ->          | 0x0d ->
1139              let push_id = get_uint64_32 m 0 in              let push_id = get_uint64_32 m 0 in
1140                
1141              let dest_ip = LittleEndian.get_ip m 4 in              let dest_ip = LittleEndian.get_ip m 4 in
1142              let dest_port = get_int16 m 8 in              let dest_port = get_int16 m 8 in
1143                
1144              let pushing_ip = LittleEndian.get_ip m 10 in              let pushing_ip = LittleEndian.get_ip m 10 in
1145              let pushing_port = get_int16 m 14 in              let pushing_port = get_int16 m 14 in
1146                
1147              let supernode_ip = LittleEndian.get_ip m 16 in              let supernode_ip = LittleEndian.get_ip m 16 in
1148              let supernode_port = get_int16 m 20 in              let supernode_port = get_int16 m 20 in
1149                
1150              let pushing_name = String.sub m 22 (String.length m - 22) in              let pushing_name = String.sub m 22 (String.length m - 22) in
1151                
1152              let push = {              let push = {
1153                  push_id = push_id;                  push_id = push_id;
1154                    
1155                  dest_ip = dest_ip;                  dest_ip = dest_ip;
1156                  dest_port = dest_port;                  dest_port = dest_port;
1157                    
1158                  pushing_ip = pushing_ip;                  pushing_ip = pushing_ip;
1159                  pushing_port = pushing_port;                  pushing_port = pushing_port;
1160                    
1161                  pushing_supernode_ip = supernode_ip;                  pushing_supernode_ip = supernode_ip;
1162                  pushing_supernode_port = supernode_port;                  pushing_supernode_port = supernode_port;
1163                    
1164                  pushing_name = pushing_name;                  pushing_name = pushing_name;
1165                } in                } in
1166                
1167              PushRequestReq push              PushRequestReq push
1168    
1169          | 0x15 ->          | 0x15 ->
1170              AskUDPConnectionReq (LittleEndian.get_ip m 0, get_int16 m 4)              AskUDPConnectionReq (LittleEndian.get_ip m 0, get_int16 m 4)
1171                
1172          | 0x1d ->          | 0x1d ->
1173              let netname = m in              let netname = m in
1174              NetworkNameReq m              NetworkNameReq m
1175            
1176          | 0x1e -> Unknown_1e (get_int m 0)          | 0x1e -> Unknown_1e (get_int m 0)
1177                
1178          | 0x20 ->          | 0x20 ->
1179              let id = get_int16 m 0 in              let id = get_int16 m 0 in
1180              assert (m.[2] = '\050');              assert (m.[2] = '\050');
1181              assert (m.[3] = '\002');              assert (m.[3] = '\002');
1182              let nfiles = get_int8 m 4 in              let nfiles = get_int8 m 4 in
1183                
1184              let rec iter nfiles pos list =              let rec iter nfiles pos list =
1185                if nfiles = 0 then List.rev list else                if nfiles = 0 then List.rev list else
1186                let fd_realm = get_int8 m pos in                let fd_realm = get_int8 m pos in
# Line 1207  dec: [(63)] Line 1199  dec: [(63)]
1199              in              in
1200              let files = iter nfiles 5 [] in              let files = iter nfiles 5 [] in
1201              RandomFilesReq (id, files)              RandomFilesReq (id, files)
1202                
1203          | 0x23 -> Unknown_23 (get_int m 0)          | 0x23 -> Unknown_23 (get_int m 0)
1204    
1205          | 0x2b -> Unknown_2b (get_int8 m 0) (* always 63 *)          | 0x2b -> Unknown_2b (get_int8 m 0) (* always 63 *)
1206                
1207          | 0x2c ->          | 0x2c ->
1208              let ip = LittleEndian.get_ip m 0 in              let ip = LittleEndian.get_ip m 0 in
1209              ExternalIpReq ip              ExternalIpReq ip
1210    
1211          | 0x26 ->          | 0x26 ->
1212              let v = get_int m 0 in              let v = get_int m 0 in
1213              ProtocolVersionReq  v              ProtocolVersionReq  v
1214            
1215          | 0x24 ->          | 0x24 ->
1216              let v = String.sub m 0 60 in              let v = String.sub m 0 60 in
1217              let rec iter pos =              let rec iter pos =
# Line 1232  dec: [(63)] Line 1224  dec: [(63)]
1224              let nets = iter 60 in              let nets = iter 60 in
1225              NetworkGlobalStats (v, nets)              NetworkGlobalStats (v, nets)
1226    
1227                        | 0x22 ->
         | 0x22 ->  
               
1228              if get_int8 m 0 <> 0 then              if get_int8 m 0 <> 0 then
1229                lprintf "WARNING: opcode 0x22, byte 0 (%d) <> 0\n"                lprintf "WARNING: opcode 0x22, byte 0 (%d) <> 0\n"
1230                (get_int8 m 0);                (get_int8 m 0);
# Line 1250  dec: [(63)] Line 1240  dec: [(63)]
1240    *)    *)
1241              let shared_type = get_int8 m 1 in              let shared_type = get_int8 m 1 in
1242              if get_int8 m 2 <> 0 then              if get_int8 m 2 <> 0 then
1243                lprintf "WARNING: opcode 0x22, byte 3 (%d)<> 0\n"                lprintf "WARNING: opcode 0x22, byte 3 (%d)<> 0\n"
1244                  (get_int8 m 2);                  (get_int8 m 2);
1245                
1246  (* This byte is sometimes different from 0, in [1..10] *)  (* This byte is sometimes different from 0, in [1..10] *)
1247             if get_int8 m 3 <> 0 then             if get_int8 m 3 <> 0 then
1248                lprintf "WARNING: opcode 0x22, byte 4 (%d) <> 0\n"                lprintf "WARNING: opcode 0x22, byte 4 (%d) <> 0\n"
1249                (get_int8 m 3);                (get_int8 m 3);
1250                
               
1251              let shared_hash = String.sub m 4 20 in              let shared_hash = String.sub m 4 20 in
1252              let shared_checksum, pos = get_dynint m 24 in              let shared_checksum, pos = get_dynint m 24 in
1253              let shared_size, pos = get_dynint m pos in              let shared_size, pos = get_dynint m pos in
1254              let shared_tags, pos = get_tags m pos in              let shared_tags, pos = get_tags m pos in
1255                
1256              let computed_checksum = Int64.of_int              let computed_checksum = Int64.of_int
1257                  (fst_hash_checksum shared_hash) in                  (fst_hash_checksum shared_hash) in
1258              if computed_checksum <> shared_checksum then begin              if computed_checksum <> shared_checksum then begin
1259                  lprintf "Bad COMPUTED checksum for hash\n";                  lprintf "Bad COMPUTED checksum for hash\n";
1260                end;                end;
1261              let shared_hash = Md5Ext.direct_of_string shared_hash in                          let shared_hash = Md5Ext.direct_of_string shared_hash in
1262                
1263              ShareFileReq {              ShareFileReq {
1264                shared_type = shared_type;                shared_type = shared_type;
1265                shared_hash = shared_hash;                shared_hash = shared_hash;
# Line 1278  dec: [(63)] Line 1267  dec: [(63)]
1267                shared_tags = shared_tags;                shared_tags = shared_tags;
1268                shared_checksum = shared_checksum;                shared_checksum = shared_checksum;
1269              }              }
1270                
1271  (*        | 0x20 ->  (*        | 0x20 ->
1272      Unknown packet [opcode = 0x20, len=1038]      Unknown packet [opcode = 0x20, len=1038]
1273      Unknown packet [opcode = 0x20, len=1137]      Unknown packet [opcode = 0x20, len=1137]
# Line 1303  dec: [(63)] Line 1292  dec: [(63)]
1292      Unknown packet [opcode = 0x20, len=998]      Unknown packet [opcode = 0x20, len=998]
1293      Unknown packet [opcode = 0x22, len=155]      Unknown packet [opcode = 0x22, len=155]
1294  *)  *)
1295                
1296  (*        | 0x24 ->  (*        | 0x24 ->
1297      Unknown packet [opcode = 0x24, len=60]      Unknown packet [opcode = 0x24, len=60]
1298      Unknown packet [opcode = 0x24, len=97]      Unknown packet [opcode = 0x24, len=97]
1299  *)  *)
1300                
               
1301  (*        | 0x61    Unknown packet [opcode = 0x61, len=23105] *)  (*        | 0x61    Unknown packet [opcode = 0x61, len=23105] *)
1302    
1303  (*              (*
1304          | 0x24 ->          | 0x24 ->
1305              RECEIVED from supernode 213.93.116.47:1222: BroadcastPacket (69.136.60.160:3277, 11 hops)              RECEIVED from supernode 213.93.116.47:1222: BroadcastPacket (69.136.60.160:3277, 11 hops)
1306  Unknown packet [opcode = 0x24, len=97]  Unknown packet [opcode = 0x24, len=97]
1307  ascii: [(0) #(31)(147) H $ <(179)(137) ](0) ((0)(184) f(10)(138)(31)(0)   >(155)(247)(252)(136) E(0) %(5)(255)(31)(184)(236) R(0) '(1)(202) R(140)(145)(4)(0)(26)(0)(21)(174) x(204)(216)(0)(26)(0)(240)(189)(241)(206)(20)(0) ! K a Z a A(0)(0)  (178)(204) f i l e s h a r e(0)(0)(2) \ ) G r o k s t e r(0)(0)(0)(16)(158)]  ascii: [(0) #(31)(147) H $ <(179)(137) ](0) ((0)(184) f(10)(138)(31)(0)   >(155)(247)(252)(136) E(0) %(5)(255)(31)(184)(236) R(0) '(1)(202) R(140)(145)(4)(0)(26)(0)(21)(174) x(204)(216)(0)(26)(0)(240)(189)(241)(206)(20)(0) ! K a Z a A(0)(0)  (178)(204) f i l e s h a r e(0)(0)(2) \ ) G r o k s t e r(0)(0)(0)(16)(158)]
1308  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(137)(93)(0)(40)(0)(184)(102)(10)(138)(31)(0)(32)(62)(155)(247)(252)(136)(69)(0)(37)(5)(255)(31)(184)(236)(82)(0)(39)(1)(202)(82)(140)(145)(4)(0)(26)(0)(21)(174)(120)(204)(216)(0)(26)(0)(240)(189)(241)(206)(20)(0)(33)(75)(97)(90)(97)(65)(0)(0)(32)(178)(204)(102)(105)(108)(101)(115)(104)(97)(114)(101)(0)(0)(2)(92)(41)(71)(114)(111)(107)(115)(116)(101)(114)(0)(0)(0)(16)(158)]  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(137)(93)(0)(40)(0)(184)(102)(10)(138)(31)(0)(32)(62)(155)(247)(252)(136)(69)(0)(37)(5)(255)(31)(184)(236)(82)(0)(39)(1)(202)(82)(140)(145)(4)(0)(26)(0)(21)(174)(120)(204)(216)(0)(26)(0)(240)(189)(241)(206)(20)(0)(33)(75)(97)(90)(97)(65)(0)(0)(32)(178)(204)(102)(105)(108)(101)(115)(104)(97)(114)(101)(0)(0)(2)(92)(41)(71)(114)(111)(107)(115)(116)(101)(114)(0)(0)(0)(16)(158)]
1309  *)  *)
1310            
           
1311          | _ -> raise MessageNotUnderstood          | _ -> raise MessageNotUnderstood
1312        with        with
1313          MessageNotUnderstood ->          MessageNotUnderstood ->
1314            UnknownReq (msg_type, m)            UnknownReq (msg_type, m)
1315        | e ->        | e ->
# Line 1336  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1323  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1323  (*                         get_xinu                                      *)  (*                         get_xinu                                      *)
1324  (*                                                                       *)  (*                                                                       *)
1325  (*************************************************************************)  (*************************************************************************)
1326        
1327      let get_xinu s pos xtype =      let get_xinu s pos xtype =
1328        match xtype with        match xtype with
1329          0 ->          0 ->
# Line 1356  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1343  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1343            let len_lo = get_uint8 s (pos+2) in            let len_lo = get_uint8 s (pos+2) in
1344            let len_hi = get_uint8 s (pos+3) in            let len_hi = get_uint8 s (pos+3) in
1345            let msg_lo = get_uint8 s (pos+4) in            let msg_lo = get_uint8 s (pos+4) in
1346            (msg_hi lsl 8) lor msg_lo, (len_hi lsl 8) lor len_lo                  (msg_hi lsl 8) lor msg_lo, (len_hi lsl 8) lor len_lo
1347    
1348  (*************************************************************************)  (*************************************************************************)
1349  (*                                                                       *)  (*                                                                       *)
1350  (*                         parse_head                                    *)  (*                         parse_head                                    *)
1351  (*                                                                       *)  (*                                                                       *)
1352  (*************************************************************************)  (*************************************************************************)
1353        
1354      let parse_head ciphers s pos =      let parse_head ciphers s pos =
1355        let xtype = Int64.to_int (Int64.rem ciphers.in_xinu int64_3) in        let xtype = Int64.to_int (Int64.rem ciphers.in_xinu int64_3) in
1356        get_xinu s pos xtype        get_xinu s pos xtype
# Line 1373  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1360  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1360  (*                         packet_size                                   *)  (*                         packet_size                                   *)
1361  (*                                                                       *)  (*                                                                       *)
1362  (*************************************************************************)  (*************************************************************************)
1363        
1364      let packet_size ciphers s pos len =      let packet_size ciphers s pos len =
1365        if len > 0 then        if len > 0 then
1366          match int_of_char s.[pos] with          match int_of_char s.[pos] with
1367            0x50 -> Some 1            0x50 -> Some 1
# Line 1383  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1370  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1370  (*          lprintf "We have got a real packet\n"; *)  (*          lprintf "We have got a real packet\n"; *)
1371              if len > 4 then              if len > 4 then
1372  (*                dump_sub s b.pos b.len; *)  (*                dump_sub s b.pos b.len; *)
1373                let msg_type, size = parse_head ciphers s pos in                              let msg_type, size = parse_head ciphers s pos in
1374                Some (size + 5)                Some (size + 5)
1375              else None              else None
1376            
1377          | n ->          | n ->
1378              lprintf "WARNING packet_size: packet not understood: %x (remaining %d bytes)\n" n (len-1);              lprintf "WARNING packet_size: packet not understood: %x (remaining %d bytes)\n" n (len-1);
1379              if len > 4 then begin              if len > 4 then begin
1380  (*                dump_sub s b.pos b.len; *)  (*                dump_sub s b.pos b.len; *)
1381                  lprintf "Trying to continue...\n";                  lprintf "Trying to continue...\n";
1382                  let msg_type, size = parse_head ciphers s pos in                                let msg_type, size = parse_head ciphers s pos in
1383                  Some (size + 5)                  Some (size + 5)
1384                end                end
1385              else None              else None
1386    
1387        else None                    else None
1388    
1389  (*************************************************************************)  (*************************************************************************)
1390  (*                                                                       *)  (*                                                                       *)
1391  (*                         string_of_path                                *)  (*                         string_of_path                                *)
1392  (*                                                                       *)  (*                                                                       *)
1393  (*************************************************************************)  (*************************************************************************)
1394        
1395      let string_of_path addr =      let string_of_path addr =
1396        match addr with        match addr with
1397          DirectPacket -> "DirectPacket"          DirectPacket -> "DirectPacket"
1398        | BroadcastPacket addr ->        | BroadcastPacket addr ->
1399            Printf.sprintf "BroadcastPacket (%s:%d, %d hops)"            Printf.sprintf "BroadcastPacket (%s:%d, %d hops)"
1400              (ip_to_string addr.broadcast_source_ip)              (ip_to_string addr.broadcast_source_ip)
1401            addr.broadcast_source_port            addr.broadcast_source_port
# Line 1427  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1414  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1414  (*                         parse                                         *)  (*                         parse                                         *)
1415  (*                                                                       *)  (*                                                                       *)
1416  (*************************************************************************)  (*************************************************************************)
1417        
1418      let parse ciphers s =      let parse ciphers s =
1419        match int_of_char s.[0] with        match int_of_char s.[0] with
1420          0x50 -> DirectPacket, PingReq          0x50 -> DirectPacket, PingReq
1421        | 0x52 -> DirectPacket, PongReq        | 0x52 -> DirectPacket, PongReq
1422        | 0x4b ->        | 0x4b ->
1423  (*          lprintf "We have got a real packet\n"; *)  (*          lprintf "We have got a real packet\n"; *)
1424            let msg_type, size = parse_head ciphers s 0 in                          let msg_type, size = parse_head ciphers s 0 in
1425  (*                lprintf "Message to read: xtype %d type %d len %d\n"  (*                lprintf "Message to read: xtype %d type %d len %d\n"
1426                    xtype msg_type size; *)                    xtype msg_type size; *)
1427              
1428            ciphers.in_xinu <- Int64.logxor ciphers.in_xinu              ciphers.in_xinu <- Int64.logxor ciphers.in_xinu
1429              (Int64.logand              (Int64.logand
1430                (Int64.lognot (Int64.of_int (size + msg_type)))                (Int64.lognot (Int64.of_int (size + msg_type)))
1431              int64_ffffffff);              int64_ffffffff);
1432              
             
1433            let msg_flags = (msg_type land 0xff00) lsr 8 in            let msg_flags = (msg_type land 0xff00) lsr 8 in
1434            let msg_type = msg_type land 0xff in            let msg_type = msg_type land 0xff in
1435              
1436            let pos, size, addr = match msg_flags with            let pos, size, addr = match msg_flags with
1437              | 0x80 ->              | 0x80 ->
1438                  let source_ip = LittleEndian.get_ip s 5 in                  let source_ip = LittleEndian.get_ip s 5 in
1439                  let source_port = get_int16  s 9 in                  let source_port = get_int16  s 9 in
1440                  let dest_ip = LittleEndian.get_ip s 11 in                  let dest_ip = LittleEndian.get_ip s 11 in
1441                  let dest_port = get_int16 s 15 in                  let dest_port = get_int16 s 15 in
1442                  let hops = get_int8 s 17 in                  let hops = get_int8 s 17 in
1443                    
1444                  let addr = {                  let addr = {
1445                      unicast_source_ip = source_ip;                      unicast_source_ip = source_ip;
1446                      unicast_source_port = source_port;                      unicast_source_port = source_port;
# Line 1462  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1448  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1448                      unicast_dest_port = dest_port;                      unicast_dest_port = dest_port;
1449                      unicast_hops = hops;                      unicast_hops = hops;
1450                    } in                    } in
1451                    
1452                  5 + 13, size - 13, UnicastPacket addr                  5 + 13, size - 13, UnicastPacket addr
1453              | 0xc0 ->              | 0xc0 ->
1454                  let source_ip = LittleEndian.get_ip s 5 in                  let source_ip = LittleEndian.get_ip s 5 in
1455                  let source_port = get_int16  s 9 in                  let source_port = get_int16  s 9 in
1456                  let unknown = get_int16 s 11 in                  let unknown = get_int16 s 11 in
1457                  let hops = get_int8 s 13 in                  let hops = get_int8 s 13 in
1458                    
1459                  let addr = {                  let addr = {
1460                      broadcast_source_ip = source_ip;                      broadcast_source_ip = source_ip;
1461                      broadcast_source_port = source_port;                      broadcast_source_port = source_port;
1462                      broadcast_unknown = unknown;                      broadcast_unknown = unknown;
1463                      broadcast_hops = hops;                      broadcast_hops = hops;
1464                    } in                    } in
1465                    
1466                  5 + 9, size - 9, BroadcastPacket addr                  5 + 9, size - 9, BroadcastPacket addr
1467              | 0 ->              | 0 ->
1468                  5, size, DirectPacket                  5, size, DirectPacket
1469                    
                   
1470              | 0x61 (* This has been observed... *)              | 0x61 (* This has been observed... *)
1471              | _ ->              | _ ->
1472                                    lprintf "WARNING:   MESSAGE HAS UNKNOWN FLAG %x\n" msg_flags;
                   
                 lprintf "WARNING:   MESSAGE HAS UNKNOWN FLAG %x\n" msg_flags;  
1473                  5, size, DirectPacket                  5, size, DirectPacket
1474            in            in
1475            let m = String.sub s pos size in            let m = String.sub s pos size in
# Line 1501  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1484  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1484  (*                         bprint_tags                                   *)  (*                         bprint_tags                                   *)
1485  (*                                                                       *)  (*                                                                       *)
1486  (*************************************************************************)  (*************************************************************************)
1487        
1488      let bprint_tags b tags =      let bprint_tags b tags =
1489        List.iter (fun tag ->        List.iter (fun tag ->
1490            Printf.bprintf b "      Field: %s --> %s\n"            Printf.bprintf b "      Field: %s --> %s\n"
1491              (escaped_string_of_field tag)              (escaped_string_of_field tag)
1492            (string_of_tag_value tag.tag_value);            (string_of_tag_value tag.tag_value);
1493        ) tags        ) tags
# Line 1514  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1497  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1497  (*                         bprint_query                                  *)  (*                         bprint_query                                  *)
1498  (*                                                                       *)  (*                                                                       *)
1499  (*************************************************************************)  (*************************************************************************)
1500        
1501      let bprint_query b s_uid query =      let bprint_query b s_uid query =
1502        match query with        match query with
1503        | QueryFilesReq (words, realm, terms) ->        | QueryFilesReq (words, realm, terms) ->
1504              
1505            let realm = match realm with                            let realm = match realm with
1506                0x21 -> "audio"                0x21 -> "audio"
1507              | 0x22 -> "video"              | 0x22 -> "video"
1508              | 0x23 -> "image"              | 0x23 -> "image"
1509              | 0x24 -> "text"              | 0x24 -> "text"
1510              | 0x25 -> "application"              | 0x25 -> "application"
1511              | 0x3f -> "any"              | 0x3f -> "any"
1512              | _ -> Printf.sprintf "realm=%d" realm              | _ -> Printf.sprintf "realm=%d" realm
1513            in            in
1514    
             
1515            Printf.bprintf  b "QueryFiles (%d,%s,%s)\n"            Printf.bprintf  b "QueryFiles (%d,%s,%s)\n"
1516              s_uid words realm;              s_uid words realm;
1517            List.iter (fun (operator, tag) ->            List.iter (fun (operator, tag) ->
# Line 1542  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1524  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1524                  | Approx -> "Approx"                  | Approx -> "Approx"
1525                ) (CommonGlobals.string_of_tag tag)                ) (CommonGlobals.string_of_tag tag)
1526            ) terms;            ) terms;
1527          
1528        | QueryLocationReq hash ->        | QueryLocationReq hash ->
1529            Printf.bprintf b "QueryLocation (%d, %s)"            Printf.bprintf b "QueryLocation (%d, %s)"
1530              s_uid (Md5Ext.to_string_case false hash)              s_uid (Md5Ext.to_string_case false hash)
1531              
1532  (*************************************************************************)  (*************************************************************************)
1533  (*                                                                       *)  (*                                                                       *)
1534  (*                         to_string                                     *)  (*                         to_string                                     *)
1535  (*                                                                       *)  (*                                                                       *)
1536  (*************************************************************************)  (*************************************************************************)
1537              
1538      let to_string t =      let to_string t =
1539        match t with        match t with
1540        | NetworkNameReq m ->        | NetworkNameReq m ->
# Line 1567  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1549  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1549                Printf.bprintf b "     %s: %Ld\n" netname nusers                Printf.bprintf b "     %s: %Ld\n" netname nusers
1550            ) nets;            ) nets;
1551            Buffer.contents b            Buffer.contents b
1552              
1553        | AskUDPConnectionReq (ip, port) ->        | AskUDPConnectionReq (ip, port) ->
1554            Printf.sprintf "AskUDPConnection to %s:%d" (Ip.to_string ip) port            Printf.sprintf "AskUDPConnection to %s:%d" (Ip.to_string ip) port
1555          
1556        | RandomFilesReq (sid, files) ->        | RandomFilesReq (sid, files) ->
1557                        
1558            let b = Buffer.create 1000 in                      let b = Buffer.create 1000 in
1559            Printf.bprintf b "RandomFileReq (%d)\n" sid;            Printf.bprintf b "RandomFileReq (%d)\n" sid;
1560            List.iter (fun fd ->            List.iter (fun fd ->
1561                Printf.bprintf b "   title: %s\n" fd.fd_title;                Printf.bprintf b "   title: %s\n" fd.fd_title;
# Line 1584  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1566  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1566            ) files;            ) files;
1567            Buffer.contents b            Buffer.contents b
1568    
1569                    | UnshareFileReq sh ->
1570        | UnshareFileReq sh ->  
1571                                  let b = Buffer.create 1000 in
           let b = Buffer.create 1000 in            
1572            Printf.bprintf b "UnshareFileReq (%d, %s, %Ld)\n"            Printf.bprintf b "UnshareFileReq (%d, %s, %Ld)\n"
1573              sh.shared_type              sh.shared_type
1574              (Md5Ext.to_string_case false sh.shared_hash)              (Md5Ext.to_string_case false sh.shared_hash)
# Line 1596  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1577  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1577    
1578            Buffer.contents b            Buffer.contents b
1579    
1580        | ShareFileReq sh ->        | ShareFileReq sh ->
1581              
1582            let b = Buffer.create 1000 in                      let b = Buffer.create 1000 in
1583            Printf.bprintf b "ShareFileReq (%d, %s, %Ld)\n"            Printf.bprintf b "ShareFileReq (%d, %s, %Ld)\n"
1584              sh.shared_type              sh.shared_type
1585              (Md5Ext.to_string_case false sh.shared_hash)              (Md5Ext.to_string_case false sh.shared_hash)
# Line 1607  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1588  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1588            bprint_tags b sh.shared_tags;            bprint_tags b sh.shared_tags;
1589    
1590            Buffer.contents b            Buffer.contents b
1591              
1592        | DeclareNeighbours neighbours ->        | DeclareNeighbours neighbours ->
1593            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1594            Printf.bprintf b "DeclareNeighbours %d\n" (List.length neighbours);            Printf.bprintf b "DeclareNeighbours %d\n" (List.length neighbours);
# Line 1620  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1601  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1601            ) neighbours;            ) neighbours;
1602            Printf.bprintf b "\n";            Printf.bprintf b "\n";
1603            Buffer.contents b            Buffer.contents b
1604              
1605        | Unknown_1e v ->  Printf.sprintf "Unknown_1e (%d)" v        | Unknown_1e v ->  Printf.sprintf "Unknown_1e (%d)" v
1606        | Unknown_23 v ->  Printf.sprintf "Unknown_23 (%d)" v        | Unknown_23 v ->  Printf.sprintf "Unknown_23 (%d)" v
1607        | Unknown_2b v ->  Printf.sprintf "Unknown_2b (%d)" v        | Unknown_2b v ->  Printf.sprintf "Unknown_2b (%d)" v
1608        | Unknown_03 ->  Printf.sprintf "Unknown_03"        | Unknown_03 ->  Printf.sprintf "Unknown_03"
1609              
1610        | UnknownReq (opcode, m) ->        | UnknownReq (opcode, m) ->
1611            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1612            let len = String.length m in            let len = String.length m in
# Line 1634  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1615  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1615  (*          let m = if len > 200 then String.sub m 0 200 else m in*)  (*          let m = if len > 200 then String.sub m 0 200 else m in*)
1616            bdump b m;            bdump b m;
1617            Buffer.contents b            Buffer.contents b
1618          
1619        | UnknownMessageReq (opcode, m) ->        | UnknownMessageReq (opcode, m) ->
1620            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1621            let len = String.length m in            let len = String.length m in
# Line 1643  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1624  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1624            let m = if len > 200 then String.sub m 0 200 else m in            let m = if len > 200 then String.sub m 0 200 else m in
1625            bdump b m;            bdump b m;
1626            Buffer.contents b            Buffer.contents b
1627          
1628        | NodeListReq list ->        | NodeListReq list ->
1629            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1630            Buffer.add_string b "NodeList\n";            Buffer.add_string b "NodeList\n";
1631              
1632            List.iter (fun (ip,port, seen, slots) ->            List.iter (fun (ip,port, seen, slots) ->
1633                try                try
1634                  Printf.bprintf b  "      x %s:%d  seen:%d slots:%d\n"                  Printf.bprintf b  "      x %s:%d  seen:%d slots:%d\n"
1635                    (ip_to_string ip) port seen slots;                    (ip_to_string ip) port seen slots;
1636                with Not_found -> ()                with Not_found -> ()
1637            ) list;            ) list;
1638            Buffer.contents b            Buffer.contents b
1639          
1640        | QueryReplyReq ( (s_ip, s_port), id, results) ->        | QueryReplyReq ( (s_ip, s_port), id, results) ->
1641            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1642            Buffer.add_string b "QueryReply\n";            Buffer.add_string b "QueryReply\n";
1643            Printf.bprintf b "  Supernode: %s:%d\n  Search: %d\n"            Printf.bprintf b "  Supernode: %s:%d\n  Search: %d\n"
1644              (ip_to_string s_ip) s_port id;              (ip_to_string s_ip) s_port id;
1645              
1646            List.iter (fun (user, meta) ->            List.iter (fun (user, meta) ->
1647                Printf.bprintf b "   User %s@%s %s:%d\n"                Printf.bprintf b "   User %s@%s %s:%d\n"
1648                  user.user_name                  user.user_name
1649                  user.user_netname                  user.user_netname
1650                  (ip_to_string user.user_ip) user.user_port;                  (ip_to_string user.user_ip) user.user_port;
1651                  
1652                Printf.bprintf b  "   Result %s size: %Ld tags: %d\n"                Printf.bprintf b  "   Result %s size: %Ld tags: %d\n"
1653                  (Md5Ext.to_string_case false meta.meta_hash)                  (Md5Ext.to_string_case false meta.meta_hash)
1654                meta.meta_size (List.length meta.meta_tags);                meta.meta_size (List.length meta.meta_tags);
1655                bprint_tags b meta.meta_tags                bprint_tags b meta.meta_tags
1656              
1657            ) results;            ) results;
1658              
1659            Buffer.contents b            Buffer.contents b
1660    
1661        | QueryReplyEndReq s_id -> Printf.sprintf "QueryReplyEnd %d" s_id        | QueryReplyEndReq s_id -> Printf.sprintf "QueryReplyEnd %d" s_id
# Line 1690  dec: [(0)(35)(31)(147)(72)(36)(60)(179)( Line 1671  dec: [(0)(35)(31)(147)(72)(36)(60)(179)(
1671        | ExternalIpReq ip -> Printf.sprintf "ExternalIp %s" (ip_to_string ip)        | ExternalIpReq ip -> Printf.sprintf "ExternalIp %s" (ip_to_string ip)
1672        | PingReq -> "Ping"        | PingReq -> "Ping"
1673        | PongReq -> "Pong"        | PongReq -> "Pong"
1674              
1675        | SearchReq (max_results, s_uid, query) ->        | SearchReq (max_results, s_uid, query) ->
1676            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1677            Printf.bprintf b "SearchReq (max_results = %d)" max_results;            Printf.bprintf b "SearchReq (max_results = %d)" max_results;
1678            bprint_query b s_uid query;                      bprint_query b s_uid query;
1679            Buffer.contents b            Buffer.contents b
1680              
1681        | SearchForwardReq (s, s_uid, query) ->        | SearchForwardReq (s, s_uid, query) ->
1682            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1683            Printf.bprintf  b "SearchForwardReq[%d,%d,%d,%d] "            Printf.bprintf  b "SearchForwardReq[%d,%d,%d,%d] "
1684              (int_of_char s.[0])              (int_of_char s.[0])
1685              (int_of_char s.[1])              (int_of_char s.[1])
1686              (int_of_char s.[2])              (int_of_char s.[2])
1687              (int_of_char s.[3]);              (int_of_char s.[3]);
1688            bprint_query b s_uid query;                      bprint_query b s_uid query;
1689            Buffer.contents b            Buffer.contents b
1690    
1691        | SearchForward2Req (s, s_uid, query) ->        | SearchForward2Req (s, s_uid, query) ->
1692            let b = Buffer.create 1000 in            let b = Buffer.create 1000 in
1693            Printf.bprintf  b "SearchForward2Req[%d,%d,%d,%d] "            Printf.bprintf  b "SearchForward2Req[%d,%d,%d,%d] "
1694              (int_of_char s.[0])              (int_of_char s.[0])
1695              (int_of_char s.[1])              (int_of_char s.[1])
1696              (int_of_char s.[2])              (int_of_char s.[2])
1697              (int_of_char s.[3]);              (int_of_char s.[3]);
1698            bprint_query b s_uid query;                      bprint_query b s_uid query;
1699            Buffer.contents b            Buffer.contents b
1700              
1701        | NodeInfoReq (ip, port, bandwidth, name) ->        | NodeInfoReq (ip, port, bandwidth, name) ->
1702            Printf.sprintf "NodeInfo (%s:%d,%d,%s)" (ip_to_string ip) port bandwidth name            Printf.sprintf "NodeInfo (%s:%d,%d,%s)" (ip_to_string ip) port bandwidth name
1703        | ProtocolVersionReq version ->        | ProtocolVersionReq version ->
1704            Printf.sprintf "ProtocolVersion %d" version            Printf.sprintf "ProtocolVersion %d" version
1705    end (* module *)    end (* module *)
1706      
1707    
1708  (*************************************************************************)  (*************************************************************************)
1709  (*                                                                       *)  (*                                                                       *)
1710  (*                         UdpMessages                                   *)  (*                         UdpMessages                                   *)
1711  (*                                                                       *)  (*                                                                       *)
1712  (*************************************************************************)  (*************************************************************************)
1713      
1714  module UdpMessages = struct  module UdpMessages = struct
1715        
1716      type t =      type t =
1717        PingReq of int * string * string        PingReq of int * string * string
1718      | SupernodePongReq of int * string * string      | SupernodePongReq of int * string * string
1719      | NodePongReq of int * string      | NodePongReq of int * string
# Line 1740  module UdpMessages = struct Line 1721  module UdpMessages = struct
1721      let extract_string s pos =      let extract_string s pos =
1722        let end_pos = String.index_from s pos '\000' in        let end_pos = String.index_from s pos '\000' in
1723        String.sub s pos (end_pos - pos), pos + 1        String.sub s pos (end_pos - pos), pos + 1
1724        
1725      let parse p =      let parse p =
1726        match int_of_char p.[0] with        match int_of_char p.[0] with
1727        | 0x27 ->        | 0x27 ->
1728            let min_enc_type = get_int p 1 in            let min_enc_type = get_int p 1 in
1729            let unknown = String.sub p 5 1 in            let unknown = String.sub p 5 1 in
1730            let netname, pos = extract_string p 6 in            let netname, pos = extract_string p 6 in
1731              
1732            PingReq (min_enc_type, unknown, netname)            PingReq (min_enc_type, unknown, netname)
1733        | 0x28 ->        | 0x28 ->
1734              
1735            let min_enc_type = get_int p 1 in            let min_enc_type = get_int p 1 in
1736            let unknown = String.sub p 5 6 in            let unknown = String.sub p 5 6 in
1737            let netname, pos = extract_string p 11 in            let netname, pos = extract_string p 11 in
1738            SupernodePongReq (min_enc_type, unknown, netname)            SupernodePongReq (min_enc_type, unknown, netname)
1739          
1740        | 0x29 ->        | 0x29 ->
1741            let min_enc_type = get_int p 1 in            let min_enc_type = get_int p 1 in
1742            let unknown = String.sub p 5 (String.length p - 5) in            let unknown = String.sub p 5 (String.length p - 5) in
1743            NodePongReq (min_enc_type, unknown)            NodePongReq (min_enc_type, unknown)
1744        | n -> UnknownReq (n, p)        | n -> UnknownReq (n, p)
1745        
1746      let write p =      let write p =
1747        let b = Buffer.create 100 in        let b = Buffer.create 100 in
1748        begin        begin
# Line 1786  module UdpMessages = struct Line 1767  module UdpMessages = struct
1767              Buffer.add_string b unknown;              Buffer.add_string b unknown;
1768        end;        end;
1769        Buffer.contents b        Buffer.contents b
1770        
1771      let to_string p =      let to_string p =
1772        let b = Buffer.create 100 in        let b = Buffer.create 100 in
1773        begin        begin
# Line 1808  module UdpMessages = struct Line 1789  module UdpMessages = struct
1789              bprint_ints b unknown;              bprint_ints b unknown;
1790              Printf.bprintf b  "\n    ";              Printf.bprintf b  "\n    ";
1791              bprint_chars b unknown;              bprint_chars b unknown;
1792              Printf.bprintf b "\n"              Printf.bprintf b "\n"
1793        end;        end;
1794        Buffer.contents b        Buffer.contents b
1795        
       
       
1796      let udp_send t ip port ping msg =      let udp_send t ip port ping msg =
1797          
1798        if !verbose_udp then begin        if !verbose_udp then begin
1799            lprintf "Message UDP to %s:%d\n%s\n" (Ip.to_string ip) port            lprintf "Message UDP to %s:%d\n%s\n" (Ip.to_string ip) port
1800              (to_string msg);              (to_string msg);
1801          end;          end;
1802          
1803        try        try
1804          let s = write msg in          let s = write msg in
1805          UdpSocket.write t ping s ip port          UdpSocket.write t ping s ip port
1806        with e ->        with e ->
1807            lprintf "FT: Exception %s in udp_send\n" (Printexc2.to_string e)            lprintf "FT: Exception %s in udp_send\n" (Printexc2.to_string e)
1808              
1809    end    end
1810      
1811      
1812  (*************************************************************************)  (*************************************************************************)
1813  (*                                                                       *)  (*                                                                       *)
1814  (*                         server_send                                   *)  (*                         server_send                                   *)
1815  (*                                                                       *)  (*                                                                       *)
1816  (*************************************************************************)  (*************************************************************************)
1817    
1818  let server_send s addr t =  let server_send s addr t =
1819    match s.server_ciphers with    match s.server_ciphers with
1820      None -> assert false      None -> assert false
1821    | Some ciphers ->    | Some ciphers ->
# Line 1847  let server_send s addr t = Line 1826  let server_send s addr t =
1826            (TcpMessages.string_of_path addr)            (TcpMessages.string_of_path addr)
1827            (TcpMessages.to_string t);            (TcpMessages.to_string t);
1828          end;          end;
1829          
1830        let m = TcpMessages.write ciphers addr t in        let m = TcpMessages.write ciphers addr t in
1831        server_crypt_and_send s ciphers.out_cipher m        server_crypt_and_send s ciphers.out_cipher m
1832    
1833          
     
1834  (*************************************************************************)  (*************************************************************************)
1835  (*                                                                       *)  (*                                                                       *)
1836  (*                         direct_server_send                            *)  (*                         direct_server_send                            *)
# Line 1860  let server_send s addr t = Line 1838  let server_send s addr t =
1838  (*************************************************************************)  (*************************************************************************)
1839    
1840  let direct_server_send s t = server_send s TcpMessages.DirectPacket t  let direct_server_send s t = server_send s TcpMessages.DirectPacket t
1841          
1842  (*************************************************************************)  (*************************************************************************)
1843  (*                                                                       *)  (*                                                                       *)
1844  (*                         server_send_ping                              *)  (*                         server_send_ping                              *)
# Line 1869  let direct_server_send s t = server_send Line 1847  let direct_server_send s t = server_send
1847    
1848  let server_send_ping s =  let server_send_ping s =
1849    direct_server_send s TcpMessages.PingReq    direct_server_send s TcpMessages.PingReq
1850          
1851  (*************************************************************************)  (*************************************************************************)
1852  (*                                                                       *)  (*                                                                       *)
1853  (*                         server_send_pong                              *)  (*                         server_send_pong                              *)
1854  (*                                                                       *)  (*                                                                       *)
1855  (*************************************************************************)  (*************************************************************************)
1856    
1857  let server_send_pong s =  let server_send_pong s =
1858    server_send s TcpMessages.DirectPacket TcpMessages.PongReq    server_send s TcpMessages.DirectPacket TcpMessages.PongReq
1859        
1860  (*************************************************************************)  (*************************************************************************)
1861  (*                                                                       *)  (*                                                                       *)
1862  (*                         server_send_register_file                     *)  (*                         server_send_register_file                     *)
1863  (*                                                                       *)  (*                                                                       *)
1864  (*************************************************************************)  (*************************************************************************)
1865          
1866  let server_send_register_file s sh =  let server_send_register_file s sh =
1867    server_send s TcpMessages.DirectPacket (TcpMessages.ShareFileReq sh)          server_send s TcpMessages.DirectPacket (TcpMessages.ShareFileReq sh)
1868        
1869  (*************************************************************************)  (*************************************************************************)
1870  (*                                                                       *)  (*                                                                       *)
1871  (*                         server_send_unregister_file                   *)  (*                         server_send_unregister_file                   *)
# Line 1896  let server_send_register_file s sh = Line 1874  let server_send_register_file s sh =
1874    
1875  let server_send_unregister_file s sh =  let server_send_unregister_file s sh =
1876    server_send s TcpMessages.DirectPacket (TcpMessages.UnshareFileReq sh)    server_send s TcpMessages.DirectPacket (TcpMessages.UnshareFileReq sh)
                 
1877    
   
         
1878  (*************************************************************************)  (*************************************************************************)
1879  (*                                                                       *)  (*                                                                       *)
1880  (*                         OTHER PRIMITIVES                              *)  (*                         OTHER PRIMITIVES                              *)
# Line 1908  let server_send_unregister_file s sh = Line 1883  let server_send_unregister_file s sh =
1883    
1884  (* This function is used in Gnutella2 to resend non-acknowledged UDP packets *)  (* This function is used in Gnutella2 to resend non-acknowledged UDP packets *)
1885  let resend_udp_packets _ = ()  let resend_udp_packets _ = ()
1886      
1887  (* TODO: this doesn't work properly on my computer !!! *)  (* TODO: this doesn't work properly on my computer !!! *)
1888  let check_primitives () =  let check_primitives () =
1889    (try    (try
# Line 1929  let check_primitives () = Line 1904  let check_primitives () =
1904          lprintf "the encryption algorithm does not work correctly.\n";          lprintf "the encryption algorithm does not work correctly.\n";
1905          lprintf "You can try to solve this problem by hacking the C files in\n";          lprintf "You can try to solve this problem by hacking the C files in\n";
1906          lprintf "   mldonkey/src/networks/fasttrack/*.c \n")          lprintf "   mldonkey/src/networks/fasttrack/*.c \n")
1907      
1908  let recover_files_delay = 600.  let recover_files_delay = 600.
1909    
       
1910  let translate_query q =  let translate_query q =
1911    let realm = ref "" in    let realm = ref "" in
1912    let keywords = ref [] in    let keywords = ref [] in
# Line 1940  let translate_query q = Line 1914  let translate_query q =
1914      keywords := (String2.split_simplify w ' ') @ !keywords      keywords := (String2.split_simplify w ' ') @ !keywords
1915    in    in
1916    let audio = ref false in    let audio = ref false in
1917    let tags = ref [] in      let tags = ref [] in
1918    let rec iter q =    let rec iter q =
1919      match q with      match q with
1920      | QOr (q1,q2)      | QOr (q1,q2)
1921      | QAnd (q1, q2) -> iter q1; iter q2      | QAnd (q1, q2) -> iter q1; iter q2
1922      | QAndNot (q1,q2) -> iter q1      | QAndNot (q1,q2) -> iter q1
1923      | QHasWord w ->  add_words w      | QHasWord w ->  add_words w
1924      | QHasField(field, w) ->      | QHasField(field, w) ->
1925          begin          begin
1926            match field with            match field with
1927            | Field_Type -> realm := String.lowercase w            | Field_Type -> realm := String.lowercase w
1928            | Field_Format ->            | Field_Format ->
1929                begin                begin
1930                  match String.lowercase w with                  match String.lowercase w with
1931                  | "mp3" | "wav" ->                  | "mp3" | "wav" ->
1932                      add_words w;                      add_words w;
1933                      realm := "audio"                      realm := "audio"
1934                  | _ -> add_words w                  | _ -> add_words w
# Line 1973  let translate_query q = Line 1947  let translate_query q =
1947            | Field_Availability            | Field_Availability
1948            | Field_Size -> ()            | Field_Size -> ()
1949          end          end
1950      | QHasMinVal (field, value) ->      | QHasMinVal (field, value) ->
1951          begin          begin
1952            match field with            match field with
1953            | Field_Size            | Field_Size
1954            | Field_UNKNOWN _            | Field_UNKNOWN _
1955              -> tags := (AtLeast, int64_tag field value) :: !tags              -> tags := (AtLeast, int64_tag field value) :: !tags
1956            | _ -> ()            | _ -> ()
1957          end          end
1958      | QHasMaxVal (field, value) ->      | QHasMaxVal (field, value) ->
1959          begin          begin
1960            match field with            match field with
1961            | Field_UNKNOWN _            | Field_UNKNOWN _
1962            | Field_Size ->            | Field_Size ->
1963                tags := (AtMost, int64_tag field value) :: !tags                tags := (AtMost, int64_tag field value) :: !tags
1964            | _ -> ()            | _ -> ()
1965          end          end
# Line 1993  let translate_query q = Line 1967  let translate_query q =
1967    in    in
1968    iter q;    iter q;
1969    !keywords, (!realm, !tags)    !keywords, (!realm, !tags)
1970      
1971  let new_search_uid () =  let new_search_uid () =
1972    let s = !search_num in    let s = !search_num in
1973    incr search_num;    incr search_num;
1974    s    s
1975      
     
1976  let cancel_recover_files file =  let cancel_recover_files file =
1977    List.iter (fun s ->    List.iter (fun s ->
1978        Hashtbl.remove searches_by_uid s.search_uid              Hashtbl.remove searches_by_uid s.search_uid
1979    ) file.file_searches    ) file.file_searches
1980      
1981  let parse_url url =  let parse_url url =
1982      
1983    match String2.split (String.escaped url) '|' with    match String2.split (String.escaped url) '|' with
1984    | "sig2dat://" :: file :: length :: uuhash :: _    | "sig2dat://" :: file :: length :: uuhash :: _
1985    | "sig2dat:///" :: file :: length :: uuhash :: _ ->    | "sig2dat:///" :: file :: length :: uuhash :: _ ->
1986          
1987        let filename =        let filename =
1988          let len = String.length file in          let len = String.length file in
1989          let rec iter1 pos =          let rec iter1 pos =
# Line 2024  let parse_url url = Line 1997  let parse_url url =
1997          in          in
1998          iter1 0          iter1 0
1999        in        in
2000          
2001        let size =        let size =
2002            
2003          let len = String.length length in          let len = String.length length in
2004          let rec iter1 pos =          let rec iter1 pos =
2005            if pos = len then raise Exit;            if pos = len then raise Exit;
# Line 2043  let parse_url url = Line 2016  let parse_url url =
2016            else iter3 begin_pos (pos+1)            else iter3 begin_pos (pos+1)
2017          in          in
2018          iter1 0          iter1 0
2019          
2020        in        in
2021          
2022        let hash =        let hash =
2023            
2024          let len = String.length uuhash in          let len = String.length uuhash in
2025          let rec iter1 pos =          let rec iter1 pos =
2026            if pos = len then raise Exit;            if pos = len then raise Exit;
# Line 2060  let parse_url url = Line 2033  let parse_url url =
2033            else iter2 begin_pos (pos+1)            else iter2 begin_pos (pos+1)
2034          in          in
2035          iter1 0          iter1 0
2036          
2037        in        in
2038          
2039        lprintf "sig2dat: [%s] [%s] [%s]\n" filename size hash;        lprintf "sig2dat: [%s] [%s] [%s]\n" filename size hash;
2040        let size = Int64.of_string size in        let size = Int64.of_string size in
2041        let hash = Md5Ext.of_string hash in        let hash = Md5Ext.of_string hash in
# Line 2078  let udp_send ip port m = Line 2051  let udp_send ip port m =
2051    | Some sock ->    | Some sock ->
2052        M.udp_send sock ip port m        M.udp_send sock ip port m
2053    
 let ask_for_push _ = ()  
2054    let ask_for_push _ = ()

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26