/[mldonkey]/mldonkey/src/networks/donkey/donkeyProtoServer.ml
ViewVC logotype

Diff of /mldonkey/src/networks/donkey/donkeyProtoServer.ml

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

revision 1.17 by spiralvoice, Fri Jul 22 10:58:55 2005 UTC revision 1.18 by spiralvoice, Mon Aug 8 16:47:31 2005 UTC
# Line 24  open Autoconf Line 24  open Autoconf
24  open LittleEndian  open LittleEndian
25  open CommonTypes  open CommonTypes
26  open CommonGlobals  open CommonGlobals
27      
28  open DonkeyTypes  open DonkeyTypes
29  open DonkeyMftp  open DonkeyMftp
30    
31  (*    (*
32  let field_of_tagname s =  let field_of_tagname s =
33    match s with    match s with
34    | "size" -> Field_Size    | "size" -> Field_Size
# Line 39  let field_of_tagname s = Line 39  let field_of_tagname s =
39    | "format" -> Field_Format    | "format" -> Field_Format
40    | "type" -> Field_Type    | "type" -> Field_Type
41    | s -> Field_UNKNOWN s    | s -> Field_UNKNOWN s
42          
     
43  let tagname_of_field field =  let tagname_of_field field =
44    match field with    match field with
45      Field_Size -> "size"      Field_Size -> "size"
# Line 53  let tagname_of_field field = Line 52  let tagname_of_field field =
52    | Field_Uid -> "uid"    | Field_Uid -> "uid"
53    | Field_unknown s -> s    | Field_unknown s -> s
54  *)  *)
55      
56  module Connect = struct  module Connect = struct
57      type t = {      type t = {
58          md4 : Md4.t;          md4 : Md4.t;
59          ip: Ip.t;          ip: Ip.t;
60          port: int;          port: int;
61          tags :  tag list;          tags :  tag list;
62        }        }
63        
64      let names_of_tag =      let names_of_tag =
65        [        [
66         "\001", Field_UNKNOWN "name";         "\001", Field_UNKNOWN "name";
# Line 70  module Connect = struct Line 69  module Connect = struct
69         "\032", Field_UNKNOWN "extended";         "\032", Field_UNKNOWN "extended";
70         "\251", Field_UNKNOWN "emule_version";         "\251", Field_UNKNOWN "emule_version";
71        ]        ]
72        
73      let parse len s =      let parse len s =
74        let md4 = get_md4 s 1 in        let md4 = get_md4 s 1 in
75        let ip = get_ip s 17 in        let ip = get_ip s 17 in
# Line 84  module Connect = struct Line 83  module Connect = struct
83          tags = tags;          tags = tags;
84        }        }
85    
86      let print t =      let print t =
87        lprintf_nl "CONNECT:";        lprintf_nl "CONNECT:";
88        lprintf_nl "MD4: %s" (Md4.to_string t.md4);        lprintf_nl "MD4: %s" (Md4.to_string t.md4);
89        lprintf_nl "ip: %s" (Ip.to_string t.ip);        lprintf_nl "ip: %s" (Ip.to_string t.ip);
90        lprintf_nl "port: %d" t.port;        lprintf_nl "port: %d" t.port;
91        lprintf "tags: ";        lprintf "tags: ";
92        print_tags t.tags;        print_tags t.tags;
93        lprint_newline ()        lprint_newline ()
94    
95      let bprint oc t =      let bprint oc t =
96        Printf.bprintf oc "CONNECT:\n";        Printf.bprintf oc "CONNECT:\n";
97        Printf.bprintf oc "%s\n" (Md4.to_string t.md4);        Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
98        Printf.bprintf oc "%s\n" (Ip.to_string t.ip);        Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
99        Printf.bprintf oc "%d\n" t.port;        Printf.bprintf oc "%d\n" t.port;
100        Printf.bprintf oc "TAGS:\n";        Printf.bprintf oc "TAGS:\n";
# Line 106  module Connect = struct Line 105  module Connect = struct
105        buf_md4 buf t.md4;        buf_md4 buf t.md4;
106        buf_ip buf t.ip;        buf_ip buf t.ip;
107        buf_port buf t.port;        buf_port buf t.port;
108        buf_tags buf t.tags names_of_tag          buf_tags buf t.tags names_of_tag
109    end    end
110    
111  module ChatRooms = struct (* request: 57 *)  module ChatRooms = struct (* request: 57 *)
112        
113      (* example:      (* example:
114  ascii [ 9(3)(4)(0) M a i n(0)(0)(2)(0)(5)(0) M u s i c(0)(0)(3)(0)(3)(0) A r t(0)(0)(4)(0)]  ascii [ 9(3)(4)(0) M a i n(0)(0)(2)(0)(5)(0) M u s i c(0)(0)(3)(0)(3)(0) A r t(0)(0)(4)(0)]
115  *)  *)
116        
       
117      type channel = {      type channel = {
118          name : string;          name : string;
119          number : int;          number : int;
120        }        }
121        
122      type t = channel list      type t = channel list
123          
124      let parse len s =      let parse len s =
125        let nchans = get_uint8 s 1 in        let nchans = get_uint8 s 1 in
126        let rec iter s pos nchans =        let rec iter s pos nchans =
# Line 150  ascii [ 9(3)(4)(0) M a i n(0)(0)(2)(0)(5 Line 148  ascii [ 9(3)(4)(0) M a i n(0)(0)(2)(0)(5
148        List.iter (fun c ->        List.iter (fun c ->
149            buf_string buf c.name;            buf_string buf c.name;
150            buf_int buf c.number) t            buf_int buf c.number) t
151          
152    end    end
153    
154  module SetID = struct  module SetID = struct
155      type t = {      type t = {
156        ip : Ip.t;        ip : Ip.t;
157        zlib : bool;        zlib : bool;
158        port : int option        port : int option
159      }      }
160        
161      let parse len s =      let parse len s =
162        let ip = get_ip s 1 in        let ip = get_ip s 1 in
163         let zlib = (0x01 land get_int s 5) = 0x01 in         let zlib = (0x01 land get_int s 5) = 0x01 in
164         let port =         let port =
# Line 186  module SetID = struct Line 184  module SetID = struct
184      let bprint oc t =      let bprint oc t =
185        Printf.bprintf oc "SET_ID: %s\n"  (if t.zlib then "Zlib" else "");        Printf.bprintf oc "SET_ID: %s\n"  (if t.zlib then "Zlib" else "");
186        Printf.bprintf oc "id: %s\n" (Ip.to_string t.ip)        Printf.bprintf oc "id: %s\n" (Ip.to_string t.ip)
187        
188      let write buf t =      let write buf t =
189        if t.zlib then buf_int buf 1;        if t.zlib then buf_int buf 1;
190        buf_ip buf t.ip        buf_ip buf t.ip
# Line 195  module SetID = struct Line 193  module SetID = struct
193    
194  let unit = ()  let unit = ()
195    
196  module AckID = struct  module AckID = struct
197      type t = unit      type t = unit
198        
199      let parse len s = ()      let parse len s = ()
200        
201      let print t =      let print t =
202        lprintf_nl "ACK_ID:"        lprintf_nl "ACK_ID:"
203    
204      let bprint oc t =      let bprint oc t =
205        Printf.bprintf oc "ACK_ID\n"        Printf.bprintf oc "ACK_ID\n"
206        
207      let write (buf: Buffer.t) (t: t) = unit      let write (buf: Buffer.t) (t: t) = unit
208    
209      let t = (() : t)      let t = (() : t)
210    end    end
211    
212  module Message = struct  module Message = struct
213      type t = string      type t = string
214        
215      let parse len s =      let parse len s =
216        let v, pos = get_string s 1 in        let v, pos = get_string s 1 in
217        v        v
218        
219      let print t =      let print t =
220        lprintf_nl "MESSAGE:";        lprintf_nl "MESSAGE:";
221        lprintf_nl "message = \"%s\"" (String.escaped t)        lprintf_nl "message = \"%s\"" (String.escaped t)
222        
223      let bprint oc t =      let bprint oc t =
224        Printf.bprintf oc "MESSAGE:\n";        Printf.bprintf oc "MESSAGE:\n";
225        Printf.bprintf oc "%s\n" (String.escaped t)        Printf.bprintf oc "%s\n" (String.escaped t)
226    
227      let write buf t =      let write buf t =
228        buf_string buf t        buf_string buf t
229    end    end
230      
231  module Share = struct  module Share = struct
232        
233      type t = tagged_file list      type t = tagged_file list
234        
235      let names_of_tag = file_common_tags      let names_of_tag = file_common_tags
236        
237      let rec get_files  s pos n =      let rec get_files  s pos n =
238        if n = 0 then [], pos else        if n = 0 then [], pos else
239        let md4 = get_md4 s pos in        let md4 = get_md4 s pos in
# Line 250  module Share = struct Line 248  module Share = struct
248          } in          } in
249        let files, pos =  get_files s pos (n-1) in        let files, pos =  get_files s pos (n-1) in
250        file :: files, pos        file :: files, pos
251        
       
252      let parse len s =      let parse len s =
253        let n = get_int s 1 in        let n = get_int s 1 in
254        let files, pos = get_files s 5 n in        let files, pos = get_files s 5 n in
255        files        files
256        
257      let print t =      let print t =
258        lprintf_nl "SHARED:";        lprintf_nl "SHARED:";
259        List.iter (fun t ->        List.iter (fun t ->
260            lprintf_nl "FILE:";            lprintf_nl "FILE:";
# Line 267  module Share = struct Line 264  module Share = struct
264            lprintf "  tags: ";            lprintf "  tags: ";
265            print_tags t.f_tags;            print_tags t.f_tags;
266            lprint_newline ();) t            lprint_newline ();) t
267        
268      let bprint oc t =      let bprint oc t =
269        Printf.bprintf oc "SHARED:\n";        Printf.bprintf oc "SHARED:\n";
270        List.iter (fun t ->        List.iter (fun t ->
271            Printf.bprintf oc "FILE:\n";            Printf.bprintf oc "FILE:\n";
# Line 279  module Share = struct Line 276  module Share = struct
276            bprint_tags oc t.f_tags;            bprint_tags oc t.f_tags;
277            Printf.bprintf oc "\n"            Printf.bprintf oc "\n"
278        ) t        ) t
279        
280      let rec write_files buf files =      let rec write_files buf files =
281        match files with        match files with
282          [] -> ()          [] -> ()
# Line 289  module Share = struct Line 286  module Share = struct
286            buf_port buf file.f_port;            buf_port buf file.f_port;
287            buf_tags buf file.f_tags names_of_tag;            buf_tags buf file.f_tags names_of_tag;
288            write_files buf files            write_files buf files
289        
290      let write buf t =      let write buf t =
291        buf_int buf (List.length t);        buf_int buf (List.length t);
292        write_files buf t        write_files buf t
293        
294      let rec write_files_max buf files nfiles max_len =      let rec write_files_max buf files nfiles max_len =
295        let prev_len = Buffer.length buf in        let prev_len = Buffer.length buf in
296        match files with        match files with
# Line 307  module Share = struct Line 304  module Share = struct
304              write_files_max buf files (nfiles+1) max_len              write_files_max buf files (nfiles+1) max_len
305            else            else
306              nfiles, prev_len              nfiles, prev_len
307          
308    end    end
309    
310  module Info = struct  module Info = struct
311      type t = int * int      type t = int * int
312        
313      let parse len s =      let parse len s =
314          
315        let users = get_int s 1 in        let users = get_int s 1 in
316        let files = get_int s 5 in        let files = get_int s 5 in
317        users, files        users, files
318        
319      let print (users, files) =      let print (users, files) =
320        lprintf_nl "INFO:";        lprintf_nl "INFO:";
321        lprintf_nl "users: %d files: %d"  users files        lprintf_nl "users: %d files: %d" users files
322    
323     let bprint oc (users, files) =     let bprint oc (users, files) =
324        Printf.bprintf oc "INFO:\n";        Printf.bprintf oc "INFO:\n";
325        Printf.bprintf oc "%d\n %d\n"  users files        Printf.bprintf oc "%d\n %d\n" users files
326        
327      let write buf (users, files) =      let write buf (users, files) =
328        buf_int buf users;        buf_int buf users;
329        buf_int buf files        buf_int buf files
330    end    end
331    
332  module ServerList = struct  module ServerList = struct
333      type server = {      type server = {
334          ip : Ip.t;          ip : Ip.t;
335          port : int;          port : int;
336        }        }
337        
338      type t = server list      type t = server list
339          
340      let parse len s =      let parse len s =
341        let n = get_uint8 s 1 in        let n = get_uint8 s 1 in
342        let rec iter i  =        let rec iter i  =
343          if i = n then [] else          if i = n then [] else
# Line 349  module ServerList = struct Line 346  module ServerList = struct
346          { ip = ip; port = port; } :: (iter (i+1))          { ip = ip; port = port; } :: (iter (i+1))
347        in        in
348        iter 0        iter 0
349              
350      let print t =      let print t =
351        lprintf_nl "SERVER LIST";        lprintf_nl "SERVER LIST";
352        List.iter (fun l ->        List.iter (fun l ->
353            lprintf_nl "   %s : %d" (Ip.to_string l.ip) l.port;            lprintf_nl "   %s : %d" (Ip.to_string l.ip) l.port;
354        ) t        ) t
355    
356      let bprint oc t =      let bprint oc t =
357        Printf.bprintf oc "SERVER LIST\n";        Printf.bprintf oc "SERVER LIST\n";
358        List.iter (fun l ->        List.iter (fun l ->
359            Printf.bprintf oc "%s:%d\n" (Ip.to_string l.ip) l.port;            Printf.bprintf oc "%s:%d\n" (Ip.to_string l.ip) l.port;
360        ) t        ) t
361          
362      let write buf t =      let write buf t =
363        buf_int8 buf (List.length t);        buf_int8 buf (List.length t);
364        List.iter (fun l ->        List.iter (fun l ->
365            buf_ip buf l.ip;            buf_ip buf l.ip;
# Line 370  module ServerList = struct Line 367  module ServerList = struct
367        ) t        ) t
368    end    end
369    
370      module ServerInfo = struct
   
 module ServerInfo = struct  
371      type t = {      type t = {
372          md4 : Md4.t;          md4 : Md4.t;
373          ip: Ip.t;          ip: Ip.t;
374          port: int;          port: int;
375          tags :  tag list;          tags :  tag list;
376        }        }
377        
378      let names_of_tag =      let names_of_tag =
379        [        [
380          "\001", Field_UNKNOWN "name";          "\001", Field_UNKNOWN "name";
381          "\011", Field_UNKNOWN "description";          "\011", Field_UNKNOWN "description";
382        ]        ]
383        
384      let parse len s =      let parse len s =
385        let md4 = get_md4 s 1 in        let md4 = get_md4 s 1 in
386        let ip = get_ip s 17 in        let ip = get_ip s 17 in
# Line 398  module ServerInfo = struct Line 393  module ServerInfo = struct
393          port = port;          port = port;
394          tags = tags;          tags = tags;
395        }        }
396        
397      let print t =      let print t =
398        lprintf_nl "SERVER INFO:";        lprintf_nl "SERVER INFO:";
399        lprintf_nl "MD4: %s" (Md4.to_string t.md4);        lprintf_nl "MD4: %s" (Md4.to_string t.md4);
400        lprintf_nl "ip: %s" (Ip.to_string t.ip);        lprintf_nl "ip: %s" (Ip.to_string t.ip);
# Line 407  module ServerInfo = struct Line 402  module ServerInfo = struct
402        lprintf "tags: ";        lprintf "tags: ";
403        print_tags t.tags        print_tags t.tags
404    
405      let bprint oc t =      let bprint oc t =
406        Printf.bprintf oc "SERVER INFO:\n";        Printf.bprintf oc "SERVER INFO:\n";
407        Printf.bprintf oc "%s\n" (Md4.to_string t.md4);        Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
408        Printf.bprintf oc "%s\n" (Ip.to_string t.ip);        Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
# Line 415  module ServerInfo = struct Line 410  module ServerInfo = struct
410        Printf.bprintf oc "TAGS:\n";        Printf.bprintf oc "TAGS:\n";
411        bprint_tags oc t.tags;        bprint_tags oc t.tags;
412        Printf.bprintf oc "\n"        Printf.bprintf oc "\n"
413        
414      let write buf t =      let write buf t =
415        buf_md4 buf t.md4;        buf_md4 buf t.md4;
416        buf_ip buf t.ip;        buf_ip buf t.ip;
417        buf_port buf t.port;        buf_port buf t.port;
418        buf_tags buf t.tags names_of_tag        buf_tags buf t.tags names_of_tag
419      
420    end    end
421    
422  module QueryReply  = struct  module QueryReply  = struct
423          
424      type t = tagged_file list      type t = tagged_file list
425    
426      let names_of_tag = file_common_tags      let names_of_tag = file_common_tags
427          
             
428      let rec get_files  s pos n =      let rec get_files  s pos n =
429        if n = 0 then [], pos else        if n = 0 then [], pos else
430          try          try
# Line 446  module QueryReply  = struct Line 440  module QueryReply  = struct
440          } in          } in
441        let files, pos =  get_files s pos (n-1) in        let files, pos =  get_files s pos (n-1) in
442        file :: files, pos        file :: files, pos
443          with _ ->          with _ ->
444            raise Not_found            raise Not_found
445    
446      let get_replies s pos =      let get_replies s pos =
447        let n = get_int s pos in        let n = get_int s pos in
448        let files, pos = get_files s (pos+4) n in        let files, pos = get_files s (pos+4) n in
449        files        files
450        
451      let parse len s = get_replies s 1      let parse len s = get_replies s 1
452        
453      let print t =      let print t =
454        lprintf_nl "FOUND:";        lprintf_nl "FOUND:";
455        List.iter (fun t ->        List.iter (fun t ->
456            lprintf_nl "FILE:";            lprintf_nl "FILE:";
# Line 467  module QueryReply  = struct Line 461  module QueryReply  = struct
461            print_tags t.f_tags;            print_tags t.f_tags;
462            lprint_newline ()) t            lprint_newline ()) t
463    
464      let bprint oc t =      let bprint oc t =
465        Printf.bprintf oc "FOUND:\n";        Printf.bprintf oc "FOUND:\n";
466        List.iter (fun t ->        List.iter (fun t ->
467            Printf.bprintf oc "FILE:\n";            Printf.bprintf oc "FILE:\n";
# Line 478  module QueryReply  = struct Line 472  module QueryReply  = struct
472            bprint_tags oc t.f_tags;            bprint_tags oc t.f_tags;
473               Printf.bprintf oc "\n"               Printf.bprintf oc "\n"
474            ) t            ) t
475        
476      let rec write_files buf files =      let rec write_files buf files =
477        match files with        match files with
478          [] -> ()          [] -> ()
# Line 489  module QueryReply  = struct Line 483  module QueryReply  = struct
483            buf_tags buf file.f_tags names_of_tag;            buf_tags buf file.f_tags names_of_tag;
484            write_files buf files            write_files buf files
485    
486      let write_replies buf t =                let write_replies buf t =
487        buf_int buf (List.length t);        buf_int buf (List.length t);
488        write_files buf t        write_files buf t
489          
490        let write buf t =        let write buf t =
491          write_replies buf t;          write_replies buf t;
492        buf_int8 buf 0        buf_int8 buf 0
493    
494    end    end
495    
496  let unit = ()  let unit = ()
497  module NoArg = functor(M: sig val m : string end) -> (struct  module NoArg = functor(M: sig val m : string end) -> (struct
498          type t = unit          type t = unit
499            
500          let parse len s = ()          let parse len s = ()
501            
502          let print t =          let print t =
503            lprintf_nl "%s:" M.m            lprintf_nl "%s:" M.m
504            
505          let write (buf: Buffer.t) (t: t) = unit          let write (buf: Buffer.t) (t: t) = unit
506              
507          let t = (() : t)          let t = (() : t)
508        end : sig        end : sig
509          type t          type t
510            val parse : int -> string  -> t            val parse : int -> string  -> t
511            val print : t -> unit            val print : t -> unit
512            val write : Buffer.t -> t  -> unit            val write : Buffer.t -> t  -> unit
513            val t :t            val t :t
514            end            end
515        )        )
516    
517  module QueryNext = NoArg(struct let m = "QUERY NEXT" end)  module QueryNext = NoArg(struct let m = "QUERY NEXT" end)
518    
     
     
519  module Query  = struct (* request 22 *)  module Query  = struct (* request 22 *)
520    
521  (* TODO : build a complete list of tags used in these queries and their correct  (* TODO : build a complete list of tags used in these queries and their correct
522  translation, i.e. Field_Artist = "Artist" instead of "artist" *)  translation, i.e. Field_Artist = "Artist" instead of "artist" *)
523        
524      let names_of_tag =      let names_of_tag =
525        [        [
526          "\002", Field_Size;          "\002", Field_Size;
# Line 537  translation, i.e. Field_Artist = "Artist Line 529  translation, i.e. Field_Artist = "Artist
529          "\021", Field_Availability;          "\021", Field_Availability;
530          "\048", Field_Completesources;          "\048", Field_Completesources;
531        ]        ]
532        
533      let rec parse_query s pos =      let rec parse_query s pos =
534        let t = get_uint8 s pos in        let t = get_uint8 s pos in
535        match t with        match t with
536          0 ->          0 ->
537            let t = get_uint8 s (pos+1) in            let t = get_uint8 s (pos+1) in
538            begin            begin
539              match t with              match t with
540                0 ->                0 ->
541                  let q1, pos  = parse_query s (pos + 2) in                  let q1, pos  = parse_query s (pos + 2) in
542                  let q2, pos  = parse_query s pos in                  let q2, pos  = parse_query s pos in
543                  QAnd (q1,q2), pos                  QAnd (q1,q2), pos
544              | 1 ->              | 1 ->
545                  let q1, pos  = parse_query s (pos + 2) in                  let q1, pos  = parse_query s (pos + 2) in
546                  let q2, pos  = parse_query s pos in                  let q2, pos  = parse_query s pos in
547                  QOr (q1,q2), pos                  QOr (q1,q2), pos
548              | 2 ->              | 2 ->
549                  let q1, pos  = parse_query s (pos + 2) in                  let q1, pos  = parse_query s (pos + 2) in
550                  let q2, pos  = parse_query s pos in                  let q2, pos  = parse_query s pos in
551                  QAndNot (q1,q2), pos                  QAndNot (q1,q2), pos
552              |_ -> failwith "Unknown QUERY operator"              |_ -> failwith "Unknown QUERY operator"
553            end            end
554        | 1 -> let s, pos = get_string s (pos + 1) in QHasWord s, pos        | 1 -> let s, pos = get_string s (pos + 1) in QHasWord s, pos
555        | 2 ->        | 2 ->
556            let field, pos = get_string s (pos + 1) in            let field, pos = get_string s (pos + 1) in
557            let name, pos = get_string s pos in                      let name, pos = get_string s pos in
558            let name = try            let name = try
559                List.assoc name names_of_tag                List.assoc name names_of_tag
560              with _ -> field_of_string name              with _ -> field_of_string name
561            in            in
562              
563            QHasField (name, field), pos            QHasField (name, field), pos
564          
565        | 3 ->        | 3 ->
566            let field = get_uint64_32 s (pos + 1) in            let field = get_uint64_32 s (pos + 1) in
567            let minmax = get_uint8 s (pos + 5) in            let minmax = get_uint8 s (pos + 5) in
568            let name, pos = get_string s (pos + 6) in            let name, pos = get_string s (pos + 6) in
# Line 586  translation, i.e. Field_Artist = "Artist Line 578  translation, i.e. Field_Artist = "Artist
578            end, pos            end, pos
579        | 4 -> QHasWord "", pos + 1        | 4 -> QHasWord "", pos + 1
580        | _ -> failwith "Unknown QUERY format"        | _ -> failwith "Unknown QUERY format"
581        
582      let parse len s =      let parse len s =
583        let t, pos = parse_query s 1 in t        let t, pos = parse_query s 1 in t
584    
585  (*  (*
586    type = "Col" pour voir les collections    type = "Col" pour voir les collections
587      Fields:      Fields:
588    "Album" | "Artist" | "Title"    "Album" | "Artist" | "Title"
       
589      *)      *)
590        
591      let rec print_query t =      let rec print_query t =
592        match t with        match t with
593          QOr (q1, q2) ->          QOr (q1, q2) ->
594            print_query q1;            print_query q1;
595            lprint_string " OR ";            lprint_string " OR ";
596            print_query q2            print_query q2
597        | QAnd (q1, q2) ->        | QAnd (q1, q2) ->
598            print_query q1;            print_query q1;
599            lprint_string " AND ";            lprint_string " AND ";
600            print_query q2            print_query q2
601        | QAndNot (q1, q2) ->        | QAndNot (q1, q2) ->
602            print_query q1;            print_query q1;
603            lprint_string " NOT ";            lprint_string " NOT ";
604            print_query q2            print_query q2
         
605        | QHasWord s ->        | QHasWord s ->
606            lprintf "Contains[%s]" s            lprintf "Contains[%s]" s
607        | QHasField (name, field) ->        | QHasField (name, field) ->
# Line 623  translation, i.e. Field_Artist = "Artist Line 613  translation, i.e. Field_Artist = "Artist
613        | QNone ->        | QNone ->
614            lprintf "print_query: QNone in query\n";            lprintf "print_query: QNone in query\n";
615            ()            ()
616        
617      let print t =      let print t =
618        lprintf "QUERY";        lprintf "QUERY";
619        print_query t        print_query t
620        
       
621      let rec bprint_query oc t =      let rec bprint_query oc t =
622        match t with        match t with
623          QOr (q1, q2) ->          QOr (q1, q2) ->
624            print_query q1;            print_query q1;
625            Printf.bprintf oc " OR ";            Printf.bprintf oc " OR ";
626            print_query q2            print_query q2
627        | QAnd (q1, q2) ->        | QAnd (q1, q2) ->
628            print_query q1;            print_query q1;
629            Printf.bprintf oc " AND ";            Printf.bprintf oc " AND ";
630            print_query q2            print_query q2
631        | QAndNot (q1, q2) ->        | QAndNot (q1, q2) ->
632            print_query q1;            print_query q1;
633            Printf.bprintf oc " NOT ";            Printf.bprintf oc " NOT ";
634            print_query q2            print_query q2
         
635        | QHasWord s ->        | QHasWord s ->
636            Printf.bprintf oc "Contains[%s]" s            Printf.bprintf oc "Contains[%s]" s
637        | QHasField (name, field) ->        | QHasField (name, field) ->
# Line 655  translation, i.e. Field_Artist = "Artist Line 643  translation, i.e. Field_Artist = "Artist
643        | QNone ->        | QNone ->
644            lprintf_nl "print_query: QNone in query";            lprintf_nl "print_query: QNone in query";
645            ()            ()
646        
647            let bprint oc t =
     let bprint oc t =  
648        Printf.bprintf oc "QUERY:\n";        Printf.bprintf oc "QUERY:\n";
649        bprint_query oc t;        bprint_query oc t;
650        Printf.bprintf oc "\n"        Printf.bprintf oc "\n"
651        
652      let rec write buf t =      let rec write buf t =
653        match t with        match t with
654          QOr (q1, q2) ->          QOr (q1, q2) ->
655            buf_int8 buf 0;            buf_int8 buf 0;
656            buf_int8 buf 1;            buf_int8 buf 1;
657            write buf  q1;            write buf  q1;
658            write buf  q2;            write buf  q2;
659        | QAnd (q1, q2) ->        | QAnd (q1, q2) ->
660            buf_int8 buf 0;            buf_int8 buf 0;
661            buf_int8 buf 0;            buf_int8 buf 0;
662            write buf  q1;            write buf  q1;
663            write buf  q2;            write buf  q2;
664        | QAndNot (q1, q2) ->        | QAndNot (q1, q2) ->
665            buf_int8 buf 0;            buf_int8 buf 0;
666            buf_int8 buf 2;            buf_int8 buf 2;
667            write buf  q1;            write buf  q1;
668            write buf  q2;            write buf  q2;
669        | QHasWord s ->        | QHasWord s ->
670            buf_int8 buf 1;            buf_int8 buf 1;
671            buf_string buf s            buf_string buf s
672        | QHasField (name, field) ->        | QHasField (name, field) ->
             
673            let name = try            let name = try
674                  rev_assoc name names_of_tag                  rev_assoc name names_of_tag
675              with _ -> string_of_field name in              with _ -> string_of_field name in
676              
677            buf_int8 buf 2;            buf_int8 buf 2;
678            buf_string buf field;            buf_string buf field;
679            buf_string buf name            buf_string buf name
680          
681        | QHasMinVal (name, field) ->        | QHasMinVal (name, field) ->
682              
683            let name = try            let name = try
684                rev_assoc name names_of_tag                rev_assoc name names_of_tag
685              with _ -> string_of_field name              with _ -> string_of_field name
686            in            in
687              
688            buf_int8 buf 3;            buf_int8 buf 3;
689            buf_int64_32 buf field;            buf_int64_32 buf field;
690            buf_int8 buf 1;            buf_int8 buf 1;
691            buf_string buf name            buf_string buf name
692    
693        | QHasMaxVal (name, field) ->        | QHasMaxVal (name, field) ->
694              
695            let name = try            let name = try
696                rev_assoc name names_of_tag                rev_assoc name names_of_tag
697                with _ -> string_of_field name in                with _ -> string_of_field name in
# Line 718  translation, i.e. Field_Artist = "Artist Line 704  translation, i.e. Field_Artist = "Artist
704        | QNone ->        | QNone ->
705            lprintf_nl "print_query: QNone in query";            lprintf_nl "print_query: QNone in query";
706            ()            ()
707                
708    end    end
709    
     
710  module QueryUsers = struct (* request 26 *)  module QueryUsers = struct (* request 26 *)
711        
712      type t = string      type t = string
713          
714      let parse len s =      let parse len s =
715        let targ = get_uint8 s 1 in        let targ = get_uint8 s 1 in
716        match targ with        match targ with
717          4 -> ""          4 -> ""
718        | 1 ->        | 1 ->
719            let name, pos = get_string s 2 in            let name, pos = get_string s 2 in
720            name            name
721        | _ ->        | _ ->
722            lprintf_nl "QueryUsers: unknown tag %d" targ;            lprintf_nl "QueryUsers: unknown tag %d" targ;
723            raise Not_found            raise Not_found
724              
725      let print t =      let print t =
726        lprintf_nl "QUERY USERS [%s]" t        lprintf_nl "QUERY USERS [%s]" t
727    
728       let bprint oc t =       let bprint oc t =
729        Printf.bprintf oc "QUERY USERS [%s]\n" t        Printf.bprintf oc "QUERY USERS [%s]\n" t
730          
731      let write buf t =      let write buf t =
732        if t = "" then        if t = "" then
733          buf_int8 buf 4          buf_int8 buf 4
# Line 751  module QueryUsers = struct (* request 26 Line 736  module QueryUsers = struct (* request 26
736            buf_string buf t            buf_string buf t
737          end          end
738    end    end
739      
740  module QueryUsersReply = struct (* request 67 *)  module QueryUsersReply = struct (* request 67 *)
741      type client = {      type client = {
742          md4 : Md4.t;          md4 : Md4.t;
# Line 759  module QueryUsersReply = struct (* reque Line 744  module QueryUsersReply = struct (* reque
744          port: int;          port: int;
745          tags : tag list;          tags : tag list;
746        }        }
747        
748      type t = client list      type t = client list
749        
750      let names_of_tag =      let names_of_tag =
751        [        [
752          "\001", Field_UNKNOWN "name";          "\001", Field_UNKNOWN "name";
753          "\017", Field_UNKNOWN "version";          "\017", Field_UNKNOWN "version";
754          "\015", Field_UNKNOWN "port";          "\015", Field_UNKNOWN "port";
755        ]        ]
756        
757      let rec parse_clients s pos nclients left =      let rec parse_clients s pos nclients left =
758        if nclients = 0 then List.rev left else        if nclients = 0 then List.rev left else
759        let md4 = get_md4 s pos in        let md4 = get_md4 s pos in
# Line 782  module QueryUsersReply = struct (* reque Line 767  module QueryUsersReply = struct (* reque
767            port = port;            port = port;
768            tags = tags;            tags = tags;
769          } :: left)          } :: left)
770        
771      let parse len s =      let parse len s =
772        let nclients = get_int s 1 in        let nclients = get_int s 1 in
773        parse_clients s 5 nclients []        parse_clients s 5 nclients []
774        
775      let print t =      let print t =
776        lprintf_nl "QUERY USERS REPLY:";        lprintf_nl "QUERY USERS REPLY:";
777        List.iter (fun t ->        List.iter (fun t ->
778            lprintf_nl "MD4: %s" (Md4.to_string t.md4);            lprintf_nl "MD4: %s" (Md4.to_string t.md4);
779            lprintf_nl "ip: %s" (Ip.to_string t.ip);            lprintf_nl "ip: %s" (Ip.to_string t.ip);
780            lprintf_nl "port: %d" t.port;            lprintf_nl "port: %d" t.port;
781            lprintf "tags: ";            lprintf "tags: ";
782            print_tags t.tags;            print_tags t.tags;
783            lprint_newline ();) t            lprint_newline ();) t
784    
785      let bprint oc t =      let bprint oc t =
786        Printf.bprintf oc "QUERY USERS REPLY:\n";        Printf.bprintf oc "QUERY USERS REPLY:\n";
787        List.iter (fun t ->        List.iter (fun t ->
788            Printf.bprintf oc "%s\n" (Md4.to_string t.md4);            Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
789            Printf.bprintf oc "%s\n" (Ip.to_string t.ip);            Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
790            Printf.bprintf oc "%d\n" t.port;            Printf.bprintf oc "%d\n" t.port;
791            Printf.bprintf oc "TAGS:\n";            Printf.bprintf oc "TAGS:\n";
792            bprint_tags oc  t.tags;            bprint_tags oc  t.tags;
793            Printf.bprintf oc "\n"            Printf.bprintf oc "\n"
794            ) t            ) t
795        
796      let write buf t =      let write buf t =
797        buf_int buf (List.length t);        buf_int buf (List.length t);
798        List.iter (fun t ->        List.iter (fun t ->
# Line 816  module QueryUsersReply = struct (* reque Line 801  module QueryUsersReply = struct (* reque
801            buf_port buf t.port;            buf_port buf t.port;
802            buf_tags buf t.tags names_of_tag) t            buf_tags buf t.tags names_of_tag) t
803    end    end
804      
805  module QueryLocation  = struct  module QueryLocation  = struct
806      type t = Md4.t      type t = Md4.t
807          
808      let parse len s =      let parse len s =
809        get_md4 s 1        get_md4 s 1
810          
811      let print t =      let print t =
812        lprintf_nl "QUERY LOCATION OF %s" (Md4.to_string t)        lprintf_nl "QUERY LOCATION OF %s" (Md4.to_string t)
813    
814      let bprint oc t =      let bprint oc t =
815        Printf.bprintf oc "QUERY LOCATION OF %s\n" (Md4.to_string t)        Printf.bprintf oc "QUERY LOCATION OF %s\n" (Md4.to_string t)
816          
817      let write buf t =      let write buf t =
818        buf_md4 buf t        buf_md4 buf t
819    end    end
820    
821  module QueryLocationReply  = struct  module QueryLocationReply  = struct
822      type location = {      type location = {
823          ip : Ip.t;          ip : Ip.t;
824          port : int;          port : int;
825        }        }
826        
827      type t = {      type t = {
828          md4: Md4.t;          md4: Md4.t;
829          locs :location list;          locs :location list;
830        }        }
831        
832      let parse len s =      let parse len s =
833        let md4 = get_md4 s 1 in        let md4 = get_md4 s 1 in
834        let n = get_uint8 s 17 in        let n = get_uint8 s 17 in
835        let rec iter i  =        let rec iter i  =
# Line 855  module QueryLocationReply  = struct Line 840  module QueryLocationReply  = struct
840        in        in
841        let locs = iter 0 in        let locs = iter 0 in
842        { locs =locs; md4 = md4 }        { locs =locs; md4 = md4 }
843        
844      let print t =      let print t =
845        lprintf_nl "LOCATION OF %s" (Md4.to_string t.md4);        lprintf_nl "LOCATION OF %s" (Md4.to_string t.md4);
846        List.iter (fun l ->        List.iter (fun l ->
847            lprintf_nl "   %s : %d %s" (Ip.to_string l.ip) l.port            lprintf_nl "   %s : %d %s" (Ip.to_string l.ip) l.port
848              (if not (Ip.valid l.ip) then              (if not (Ip.valid l.ip) then
849                Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)                Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)
850              else "");              else "");
         
851        ) t.locs        ) t.locs
852        
853      let bprint oc t =      let bprint oc t =
854        Printf.bprintf oc "LOCATION OF %s\n" (Md4.to_string t.md4);        Printf.bprintf oc "LOCATION OF %s\n" (Md4.to_string t.md4);
855        List.iter (fun l ->        List.iter (fun l ->
856            Printf.bprintf oc "%s:%d %s\n" (Ip.to_string l.ip) l.port            Printf.bprintf oc "%s:%d %s\n" (Ip.to_string l.ip) l.port
857              (if not (Ip.valid l.ip) then              (if not (Ip.valid l.ip) then
858                Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)                Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)
859              else "");              else "");
860            ;            ;
861        ) t.locs        ) t.locs
862          
863      let write buf t =      let write buf t =
864        buf_md4 buf t.md4;        buf_md4 buf t.md4;
865        buf_int8 buf (List.length t.locs);        buf_int8 buf (List.length t.locs);
866        List.iter (fun l ->        List.iter (fun l ->
867            buf_ip buf l.ip;            buf_ip buf l.ip;
868            buf_port buf l.port            buf_port buf l.port
869        ) t.locs        ) t.locs
870          
871    end    end
872      
873  module QueryID  = struct  module QueryID = struct
874      type t = int64      type t = int64
875          
876      let parse len s =      let parse len s =
877        id_of_ip (get_ip s 1)        id_of_ip (get_ip s 1)
878          
879      let print t =      let print t =
880        lprintf "QUERY IP OF %Ld" t        lprintf "QUERY IP OF %Ld" t
881    
882      let bprint oc t =      let bprint oc t =
883        Printf.bprintf oc "QUERY IP OF %Ld\n" t        Printf.bprintf oc "QUERY IP OF %Ld\n" t
884          
885      let write buf t =      let write buf t =
886        buf_ip buf (ip_of_id t)        buf_ip buf (ip_of_id t)
887    end    end
888      
889  module QueryIDFailed  = struct  module QueryIDFailed = struct
890      type t = int64      type t = int64
891          
892      let parse len s =      let parse len s =
893        id_of_ip (get_ip s 1)        id_of_ip (get_ip s 1)
894          
895      let print t =      let print t =
896        lprintf "QUERY IP OF %Ld FAILED" t        lprintf "QUERY IP OF %Ld FAILED" t
897    
898      let bprint oc t =      let bprint oc t =
899        Printf.bprintf oc "QUERY IP OF %Ld FAILED\n" t        Printf.bprintf oc "QUERY IP OF %Ld FAILED\n" t
900          
901      let write buf t =      let write buf t =
902        buf_ip buf (ip_of_id t)        buf_ip buf (ip_of_id t)
903    end    end
904    
905  module QueryIDReply  = struct  module QueryIDReply = struct
906      type t = {      type t = {
907          ip : Ip.t;          ip : Ip.t;
908          port : int;          port : int;
909        }        }
910              
911      let parse len s =      let parse len s =
912        let ip = get_ip s 1 in        let ip = get_ip s 1 in
913        let port = get_port s 5 in        let port = get_port s 5 in
914        { ip = ip; port = port; }        { ip = ip; port = port; }
915          
916      let print t =      let print t =
917        lprintf_nl "IDENTIFICATION %s : %d" (Ip.to_string t.ip) t.port        lprintf_nl "IDENTIFICATION %s : %d" (Ip.to_string t.ip) t.port
918    
919      let bprint oc t =      let bprint oc t =
920        Printf.bprintf oc "IDENTIFICATION %s : %d\n" (Ip.to_string t.ip) t.port        Printf.bprintf oc "IDENTIFICATION %s : %d\n" (Ip.to_string t.ip) t.port
921        
922              let write buf t =
     let write buf t =  
923        buf_ip buf t.ip;        buf_ip buf t.ip;
924        buf_port buf t.port        buf_port buf t.port
925          
926    end    end
927    
928  module QueryServers  = struct  module QueryServers = struct
929      type t = {      type t = {
930          ip : Ip.t;          ip : Ip.t;
931          port : int;          port : int;
932        }        }
933          
934      let parse len s =      let parse len s =
935        let ip = get_ip s 1 in        let ip = get_ip s 1 in
936        let port = get_port s 5 in        let port = get_port s 5 in
937        { ip = ip; port = port; }        { ip = ip; port = port; }
938          
939      let print t =      let print t =
940        lprintf_nl "QUERY SERVERS %s : %d" (Ip.to_string t.ip) t.port        lprintf_nl "QUERY SERVERS %s : %d" (Ip.to_string t.ip) t.port
941    
942      let bprint oc t =      let bprint oc t =
943        Printf.bprintf oc "QUERY SERVERS %s : %d\n" (Ip.to_string t.ip) t.port        Printf.bprintf oc "QUERY SERVERS %s : %d\n" (Ip.to_string t.ip) t.port
944        
945              let write buf t =
     let write buf t =  
946        buf_ip buf t.ip;        buf_ip buf t.ip;
947        buf_port buf t.port        buf_port buf t.port
948          
949    end    end
950    
951  module QueryServersReply  = struct  module QueryServersReply = struct
952      type server = {      type server = {
953          ip : Ip.t;          ip : Ip.t;
954          port : int;          port : int;
# Line 977  module QueryServersReply  = struct Line 959  module QueryServersReply  = struct
959          server_port : int;          server_port : int;
960          servers: server list;          servers: server list;
961        }        }
962          
963      let rec parse_servers nservers s pos =      let rec parse_servers nservers s pos =
964        if nservers = 0 then [] else        if nservers = 0 then [] else
965        let ip = get_ip s pos in        let ip = get_ip s pos in
966        let port = get_port s (pos+4) in        let port = get_port s (pos+4) in
967        { ip = ip; port = port; } ::        { ip = ip; port = port; } ::
968        (parse_servers (nservers-1) s (pos+6))        (parse_servers (nservers-1) s (pos+6))
969          
970      let parse len s =      let parse len s =
971        try        try
972          let ip = get_ip s 1 in          let ip = get_ip s 1 in
# Line 995  module QueryServersReply  = struct Line 977  module QueryServersReply  = struct
977        with _ ->        with _ ->
978          let nservers = get_uint8 s 1 in          let nservers = get_uint8 s 1 in
979          let servers = parse_servers nservers s 2 in          let servers = parse_servers nservers s 2 in
980            { server_ip = Ip.null; server_port = 0; servers = servers }              { server_ip = Ip.null; server_port = 0; servers = servers }
981          
982      let print t =      let print t =
983        lprintf_nl "SERVERS QUERY REPLY %s : %d" (        lprintf_nl "SERVERS QUERY REPLY %s : %d" (
984          Ip.to_string t.server_ip) t.server_port;          Ip.to_string t.server_ip) t.server_port;
985        List.iter (fun s ->        List.iter (fun s ->
986            lprintf_nl "   %s:%d" (Ip.to_string s.ip) s.port;            lprintf_nl "   %s:%d" (Ip.to_string s.ip) s.port;
987        ) t.servers        ) t.servers
988    
989       let bprint oc t =       let bprint oc t =
990        Printf.bprintf oc "SERVERS QUERY REPLY:\n";        Printf.bprintf oc "SERVERS QUERY REPLY:\n";
991        Printf.bprintf oc  "%s:%d\n" (        Printf.bprintf oc  "%s:%d\n" (
992          Ip.to_string t.server_ip) t.server_port;          Ip.to_string t.server_ip) t.server_port;
993        List.iter (fun s ->        List.iter (fun s ->
994            Printf.bprintf oc  "%s:%d\n" (Ip.to_string s.ip) s.port;            Printf.bprintf oc "%s:%d\n" (Ip.to_string s.ip) s.port;
995        ) t.servers        ) t.servers
996          
997      let write buf t =      let write buf t =
998        if (t.server_port = 0) then        if (t.server_port = 0) then
999          begin          begin
1000            buf_int8 buf (List.length t.servers);            buf_int8 buf (List.length t.servers);
1001            List.iter (fun s ->            List.iter (fun s ->
1002                         buf_ip buf s.ip; buf_int16 buf s.port) t.servers                         buf_ip buf s.ip; buf_int16 buf s.port) t.servers
1003          end          end
1004        else        else
1005          begin          begin
1006            buf_ip buf t.server_ip;            buf_ip buf t.server_ip;
1007            buf_port buf t.server_port;            buf_port buf t.server_port;
1008            buf_int8 buf (List.length t.servers);            buf_int8 buf (List.length t.servers);
1009            List.iter (fun s ->            List.iter (fun s ->
1010                         buf_ip buf s.ip; buf_int16 buf s.port) t.servers                         buf_ip buf s.ip; buf_int16 buf s.port) t.servers
1011          end          end
1012          
1013    end    end
1014    
1015    
1016  module Req  = struct  module Req = struct
1017      type t      type t
1018          
1019      let parse len s = raise Not_found      let parse len s = raise Not_found
1020      let print t = raise Not_found      let print t = raise Not_found
1021      let write buf s = raise Not_found      let write buf s = raise Not_found
1022    end    end
1023    
1024  type t =  type t =
1025  | ConnectReq of Connect.t  | ConnectReq of Connect.t
1026  | SetIDReq of SetID.t  | SetIDReq of SetID.t
1027  | AckIDReq of AckID.t  | AckIDReq of AckID.t
# Line 1064  type t = Line 1046  type t =
1046  | UnknownReq of string  | UnknownReq of string
1047    
1048  (****************  (****************
1049                       MLdonkey extensions messages                       MLdonkey extensions messages
1050  ***************)  ***************)
1051      
1052  (* server to client: client has been recognized as  (* server to client: client has been recognized as
1053  a mldonkey client by a mldonkey server *)  a mldonkey client by a mldonkey server *)
1054  | Mldonkey_MldonkeyUserReplyReq  | Mldonkey_MldonkeyUserReplyReq
# Line 1076  a mldonkey client by a mldonkey server * Line 1058  a mldonkey client by a mldonkey server *
1058  | Mldonkey_NotificationReq of int * QueryReply.t  | Mldonkey_NotificationReq of int * QueryReply.t
1059  (* client to server: the client want to cancel a subscription *)  (* client to server: the client want to cancel a subscription *)
1060  | Mldonkey_CloseSubscribeReq of int  | Mldonkey_CloseSubscribeReq of int
1061      
1062  let mldonkey_extensions len s =  let mldonkey_extensions len s =
1063    check_string s 1;    check_string s 1;
1064    let opcode = int_of_char s.[1] in    let opcode = int_of_char s.[1] in
1065    match opcode with      match opcode with
1066    | 1 ->    | 1 ->
1067        Mldonkey_MldonkeyUserReplyReq        Mldonkey_MldonkeyUserReplyReq
1068    | 2 ->    | 2 ->
1069        let num = get_int s 2 in        let num = get_int s 2 in
1070        let lifetime = get_int s 6 in        let lifetime = get_int s 6 in
1071        let query, pos = Query.parse_query s 10 in        let query, pos = Query.parse_query s 10 in
# Line 1092  let mldonkey_extensions len s = Line 1074  let mldonkey_extensions len s =
1074        let num = get_int s 2 in        let num = get_int s 2 in
1075        let files = QueryReply.get_replies s 6 in        let files = QueryReply.get_replies s 6 in
1076          Mldonkey_NotificationReq (num, files)          Mldonkey_NotificationReq (num, files)
1077          
1078    | 4 ->    | 4 ->
1079        let num = get_int s 2 in        let num = get_int s 2 in
1080        Mldonkey_CloseSubscribeReq num        Mldonkey_CloseSubscribeReq num
1081    | _ -> raise Not_found    | _ -> raise Not_found
1082      
1083  let rec parse magic s =  let rec parse magic s =
1084    try    try
1085      let len = String.length s in      let len = String.length s in
1086      if len = 0 then raise Not_found;      if len = 0 then raise Not_found;
1087      let opcode = int_of_char (s.[0]) in      let opcode = int_of_char (s.[0]) in
1088      match magic with      match magic with
1089        227 -> begin        227 -> begin
1090  (*    lprintf "opcode: %d\n" opcode; *)  (*    lprintf "opcode: %d\n" opcode; *)
1091            match opcode with            match opcode with
1092            | 1 -> ConnectReq (Connect.parse len s)            | 1 -> ConnectReq (Connect.parse len s)
1093            | 5 -> BadProtocolVersionReq            | 5 -> BadProtocolVersionReq
1094            | 20 -> AckIDReq (AckID.parse len s)            | 20 -> AckIDReq (AckID.parse len s)
1095            | 21 -> ShareReq (Share.parse len s)            | 21 -> ShareReq (Share.parse len s)
1096            | 22 -> QueryReq (Query.parse len s)            | 22 -> QueryReq (Query.parse len s)
# Line 1143  let rec parse magic s = Line 1125  let rec parse magic s =
1125                raise Not_found                raise Not_found
1126          end          end
1127      | 0xD4 -> (* 212 *)      | 0xD4 -> (* 212 *)
1128            
1129  (*        lprintf "Compressed Message...\n"; *)  (*        lprintf "Compressed Message...\n"; *)
1130            
1131          if Autoconf.has_zlib then          if Autoconf.has_zlib then
1132            let s = Autoconf.zlib__uncompress_string2 (String.sub s 1 (len-1)) in            let s = Autoconf.zlib__uncompress_string2 (String.sub s 1 (len-1)) in
1133            let s = Printf.sprintf "%c%s" (char_of_int opcode) s in            let s = Printf.sprintf "%c%s" (char_of_int opcode) s in
1134            parse 227 s            parse 227 s
1135          else          else
1136            failwith "No Zlib to uncompress packet"            failwith "No Zlib to uncompress packet"
1137      | _ ->        | _ ->
1138          failwith (Printf.sprintf "Unkown opcode %d from server\n" opcode)          failwith (Printf.sprintf "Unkown opcode %d from server\n" opcode)
1139    with    with
1140      e ->      e ->
1141        if !CommonOptions.verbose_unknown_messages then begin        if !CommonOptions.verbose_unknown_messages then begin
1142            lprintf_nl "Unknown message From server: %s (magic %d)"            lprintf_nl "Unknown message From server: %s (magic %d)"
1143              (Printexc2.to_string e) magic;              (Printexc2.to_string e) magic;
1144            let tmp_file = Filename.temp_file "comp" "pak" in            let tmp_file = Filename.temp_file "comp" "pak" in
1145            File.from_string tmp_file s;            File.from_string tmp_file s;
1146            lprintf_nl "Saved unknown packet %s" tmp_file;            lprintf_nl "Saved unknown packet %s" tmp_file;
1147            dump s;            dump s;
1148            lprint_newline ();            lprint_newline ();
1149          end;          end;
1150        UnknownReq s        UnknownReq s
1151          
1152  let print t =  let print t =
1153    begin    begin
1154      match t with      match t with
# Line 1184  let print t = Line 1166  let print t =
1166      | QueryLocationReq t      | QueryLocationReq t
1167        -> QueryLocation.print t        -> QueryLocation.print t
1168      | QueryLocationReplyReq t      | QueryLocationReplyReq t
1169        ->        ->
1170          QueryLocationReply.print t          QueryLocationReply.print t
1171      | QueryIDReq t -> QueryID.print t      | QueryIDReq t -> QueryID.print t
1172      | QueryIDFailedReq t -> QueryIDFailed.print t      | QueryIDFailedReq t -> QueryIDFailed.print t
# Line 1193  let print t = Line 1175  let print t =
1175      | QueryUsersReplyReq t -> QueryUsersReply.print t      | QueryUsersReplyReq t -> QueryUsersReply.print t
1176      | ChatRoomsReq t -> ChatRooms.print t      | ChatRoomsReq t -> ChatRooms.print t
1177    
1178      | QueryMoreResultsReq ->      | QueryMoreResultsReq ->
1179          lprintf_nl "QUERY MORE RESULTS";          lprintf_nl "QUERY MORE RESULTS";
1180      | Mldonkey_MldonkeyUserReplyReq ->      | Mldonkey_MldonkeyUserReplyReq ->
1181          lprintf_nl "MLDONKEY USER";          lprintf_nl "MLDONKEY USER";
1182      | Mldonkey_SubscribeReq (num, lifetime, t) ->      | Mldonkey_SubscribeReq (num, lifetime, t) ->
1183          lprintf_nl "MLDONKEY SUBSCRIPTION %d FOR %d SECONDS" num lifetime;          lprintf_nl "MLDONKEY SUBSCRIPTION %d FOR %d SECONDS" num lifetime;
1184            
1185          Query.print t          Query.print t
1186      | Mldonkey_NotificationReq (num,t) ->      | Mldonkey_NotificationReq (num,t) ->
1187          lprintf_nl "MLDONKEY NOTIFICATIONS TO %d" num;          lprintf_nl "MLDONKEY NOTIFICATIONS TO %d" num;
1188          QueryReply.print t          QueryReply.print t
1189      | Mldonkey_CloseSubscribeReq num ->      | Mldonkey_CloseSubscribeReq num ->
1190          lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;          lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;
1191      | UnknownReq s ->      | UnknownReq s ->
1192          let len = String.length s in          let len = String.length s in
1193          lprintf_nl "UnknownReq:";          lprintf_nl "UnknownReq:";
1194          lprintf "ascii: [";          lprintf "ascii: [";
# Line 1223  let print t = Line 1205  let print t =
1205          for i = 0 to len - 1 do          for i = 0 to len - 1 do
1206            let c = s.[i] in            let c = s.[i] in
1207            let n = int_of_char c in            let n = int_of_char c in
1208            lprintf "(%d)" n                        lprintf "(%d)" n
1209          done;          done;
1210          lprintf_nl "]";          lprintf_nl "]";
1211    end;    end;
# Line 1253  let bprint oc t = Line 1235  let bprint oc t =
1235      | QueryUsersReplyReq t -> QueryUsersReply.bprint oc t      | QueryUsersReplyReq t -> QueryUsersReply.bprint oc t
1236      | ChatRoomsReq t -> ChatRooms.bprint oc t      | ChatRoomsReq t -> ChatRooms.bprint oc t
1237    
1238      | QueryMoreResultsReq ->      | QueryMoreResultsReq ->
1239          Printf.bprintf oc "QUERY MORE RESULTS\n"          Printf.bprintf oc "QUERY MORE RESULTS\n"
1240      | Mldonkey_MldonkeyUserReplyReq ->      | Mldonkey_MldonkeyUserReplyReq ->
1241          Printf.bprintf oc "MLDONKEY USER\n"          Printf.bprintf oc "MLDONKEY USER\n"
1242      | Mldonkey_SubscribeReq (num, lifetime, t) ->      | Mldonkey_SubscribeReq (num, lifetime, t) ->
1243          Printf.bprintf oc "MLDONKEY SUBSCRIBE %d FOR %d SECONDS\n" num lifetime;          Printf.bprintf oc "MLDONKEY SUBSCRIBE %d FOR %d SECONDS\n" num lifetime;
1244          Query.bprint oc t          Query.bprint oc t
1245      | Mldonkey_NotificationReq (num,t) ->      | Mldonkey_NotificationReq (num,t) ->
1246          Printf.bprintf oc "MLDONKEY NOTIFICATIONS TO %d\n" num;          Printf.bprintf oc "MLDONKEY NOTIFICATIONS TO %d\n" num;
1247          QueryReply.bprint oc t          QueryReply.bprint oc t
1248      | Mldonkey_CloseSubscribeReq num ->      | Mldonkey_CloseSubscribeReq num ->
1249          lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;          lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;
1250            
1251      | UnknownReq s ->      | UnknownReq s ->
1252  (* let len = String.length s in*)  (* let len = String.length s in*)
1253          Printf.bprintf oc "UnknownReq\n"          Printf.bprintf oc "UnknownReq\n"
1254  (* lprintf "ascii: [";  (* lprintf "ascii: [";
# Line 1283  let bprint oc t = Line 1265  let bprint oc t =
1265          for i = 0 to len - 1 do          for i = 0 to len - 1 do
1266            let c = s.[i] in            let c = s.[i] in
1267            let n = int_of_char c in            let n = int_of_char c in
1268            lprintf "(%d)" n                        lprintf "(%d)" n
1269          done;          done;
1270          lprintf "]\n";          lprintf "]\n";
1271          lprint_newline ()*)          lprint_newline ()*)
1272    end    end
1273      
1274  (* Why is this called udp_write ??? It is the normal function to encode messages  (* Why is this called udp_write ??? It is the normal function to encode messages
1275    both on UDP and TCP connections !!! *)    both on UDP and TCP connections !!! *)
1276      
1277  let write buf t =  let write buf t =
1278    match t with    match t with
1279    | ConnectReq t ->    | ConnectReq t ->
1280        buf_int8 buf 1;        buf_int8 buf 1;
1281        Connect.write buf t        Connect.write buf t
1282    | BadProtocolVersionReq ->    | BadProtocolVersionReq ->
1283        buf_int8 buf 5        buf_int8 buf 5
1284    | SetIDReq t ->    | SetIDReq t ->
1285        buf_int8 buf 64;        buf_int8 buf 64;
1286        SetID.write buf  t        SetID.write buf t
1287    | AckIDReq t ->    | AckIDReq t ->
1288        buf_int8 buf 20;        buf_int8 buf 20;
1289        AckID.write buf  t        AckID.write buf t
1290    | MessageReq t ->    | MessageReq t ->
1291        buf_int8 buf 56;        buf_int8 buf 56;
1292        Message.write buf  t        Message.write buf t
1293    | ShareReq t ->    | ShareReq t ->
1294        buf_int8 buf 21;        buf_int8 buf 21;
1295        Share.write buf  t        Share.write buf t
1296    | InfoReq t ->    | InfoReq t ->
1297        buf_int8 buf 52;        buf_int8 buf 52;
1298        Info.write buf  t        Info.write buf t
1299    | ServerListReq t ->    | ServerListReq t ->
1300        buf_int8 buf 50;        buf_int8 buf 50;
1301        ServerList.write buf  t        ServerList.write buf t
1302    | ServerInfoReq t ->    | ServerInfoReq t ->
1303        buf_int8 buf 65;        buf_int8 buf 65;
1304        ServerInfo.write buf  t        ServerInfo.write buf t
1305    | QueryReplyReq t ->    | QueryReplyReq t ->
1306        buf_int8 buf 51;        buf_int8 buf 51;
1307        QueryReply.write buf t        QueryReply.write buf t
1308    | QueryReq t ->    | QueryReq t ->
1309        buf_int8 buf 22;        buf_int8 buf 22;
1310        Query.write buf t        Query.write buf t
1311    | QueryLocationReq t ->    | QueryLocationReq t ->
1312        buf_int8 buf 25;        buf_int8 buf 25;
1313        QueryLocation.write buf t        QueryLocation.write buf t
1314    | QueryLocationReplyReq t ->    | QueryLocationReplyReq t ->
1315        buf_int8 buf 66;        buf_int8 buf 66;
1316        QueryLocationReply.write buf t        QueryLocationReply.write buf t
1317    | QueryIDReq t ->    | QueryIDReq t ->
1318        buf_int8 buf 28;        buf_int8 buf 28;
1319        QueryID.write buf t        QueryID.write buf t
1320    | QueryIDReplyReq t ->    | QueryIDReplyReq t ->
1321        buf_int8 buf 53;        buf_int8 buf 53;
1322        QueryIDReply.write buf t        QueryIDReply.write buf t
1323    | QueryIDFailedReq t ->    | QueryIDFailedReq t ->
1324        buf_int8 buf 54;        buf_int8 buf 54;
1325        QueryIDFailed.write buf t        QueryIDFailed.write buf t
1326    | ChatRoomsReq t ->    | ChatRoomsReq t ->
# Line 1346  let write buf t = Line 1328  let write buf t =
1328        ChatRooms.write buf t        ChatRooms.write buf t
1329    | UnknownReq s ->    | UnknownReq s ->
1330        Buffer.add_string buf s        Buffer.add_string buf s
1331    | QueryUsersReq t ->    | QueryUsersReq t ->
1332        buf_int8 buf 26;        buf_int8 buf 26;
1333        QueryUsers.write buf t        QueryUsers.write buf t
1334    | QueryUsersReplyReq t ->    | QueryUsersReplyReq t ->
1335        buf_int8 buf 67;        buf_int8 buf 67;
1336        QueryUsersReply.write buf t        QueryUsersReply.write buf t
1337    | QueryMoreResultsReq ->    | QueryMoreResultsReq ->
1338        buf_int8 buf 33        buf_int8 buf 33
1339          
1340  (**************  (**************
1341  mldonkey extensions to the protocol  mldonkey extensions to the protocol
1342  **************)  **************)
1343      
1344    | Mldonkey_MldonkeyUserReplyReq ->    | Mldonkey_MldonkeyUserReplyReq ->
1345        buf_int8 buf 250; (* MLdonkey extensions opcode *)        buf_int8 buf 250; (* MLdonkey extensions opcode *)
1346        buf_int8 buf 1        buf_int8 buf 1
1347          
1348    | Mldonkey_SubscribeReq (num, lifetime, t) ->    | Mldonkey_SubscribeReq (num, lifetime, t) ->
1349        buf_int8 buf 250; (* MLdonkey extensions opcode *)        buf_int8 buf 250; (* MLdonkey extensions opcode *)
1350        buf_int8 buf 2;        buf_int8 buf 2;
# Line 1374  mldonkey extensions to the protocol Line 1356  mldonkey extensions to the protocol
1356        buf_int8 buf 250; (* MLdonkey extensions opcode *)        buf_int8 buf 250; (* MLdonkey extensions opcode *)
1357        buf_int8 buf 4;        buf_int8 buf 4;
1358        buf_int buf num;        buf_int buf num;
1359                
1360    | Mldonkey_NotificationReq (num,t) ->    | Mldonkey_NotificationReq (num,t) ->
1361        buf_int8 buf 250; (* MLdonkey extensions opcode *)        buf_int8 buf 250; (* MLdonkey extensions opcode *)
1362        buf_int8 buf 3;        buf_int8 buf 3;

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

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