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 |
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" |
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"; |
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 |
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"; |
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 = |
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 = |
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 |
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 |
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:"; |
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"; |
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 |
[] -> () |
[] -> () |
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 |
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 |
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; |
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 |
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); |
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); |
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 |
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:"; |
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"; |
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 |
[] -> () |
[] -> () |
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; |
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 |
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) -> |
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) -> |
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 |
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 |
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; |
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 |
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 -> |
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 = |
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; |
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 |
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 |
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 |
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 |
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) |
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 |
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 |
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: ["; |
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; |
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: ["; |
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 -> |
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; |
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; |