1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
34 module QueryReplyUdp
= struct
36 type t
= tagged_file list
38 let names_of_tag = file_common_tags
41 let md4 = get_md4 s pos
in
42 let ip = get_ip s
(pos
+ 16) in
43 let port = get_port s
(pos
+ 20) in
44 let tags, pos
= get_tags s
(pos
+22) names_of_tag in
54 let rec iter pos list
=
56 let file, pos
= get_file s pos
in
58 iter pos (file :: list
)
64 Printf.bprintf oc
"FOUND:\n";
66 Printf.bprintf oc
"%s\n" (Md4.to_string t
.f_md4
);
67 Printf.bprintf oc
"%s\n" (Ip.to_string t
.f_ip
);
68 Printf.bprintf oc
"%d\n" t
.f_port
;
69 Printf.bprintf oc
"TAGS:\n";
70 bprint_tags oc t
.f_tags
;
71 Printf.bprintf oc
"\n"
75 List.iter (fun file ->
76 buf_md4 buf
file.f_md4
;
78 buf_port buf
file.f_port
;
79 buf_tags buf
file.f_tags
names_of_tag
84 module QueryCallUdp
= struct
92 let ip = get_ip s
1 in
93 let port = get_port s
5 in
94 let id = id_of_ip
(get_ip s
7) in
95 { ip = ip; port = port; id = id; }
98 Printf.bprintf oc
"QueryCall %s : %d --> %Ld\n" (Ip.to_string t
.ip)
104 buf_ip buf
(ip_of_id t
.id)
108 module PingServerUdp
= struct (* client -> serveur pour identification ? *)
113 get_uint64_32 s
1 (*, get_int8 s 2, get_int8 s 3*)
117 Printf.bprintf oc
"PING %s\n" (Int64.to_string t
)
122 (* let bprint oc (t1,t2,t3) =
123 Printf.bprintf oc "MESSAGE 150 UDP %d %d %d\n" t1 t2 t3*)
125 (*let write buf (t1,t2,t3) =
132 module PingServerReplyUdp
= struct (* reponse du serveur a 150 *)
138 soft_limit
: int64
option;
139 hard_limit
: int64
option;
140 max_users
: int64
option;
141 lowid_users
: int64
option;
148 udp_obfuscation
: bool;
149 tcp_obfuscation
: bool;
153 let challenge = get_uint64_32 s
1 in
154 let users = get_uint64_32 s
5 in
155 let files = get_uint64_32 s
9 in
156 let max_users = if len
>= 17 then Some
(get_uint64_32 s
13) else None
in
157 let soft_limit = if len
>= 21 then Some
(get_uint64_32 s
17) else None
in
158 let hard_limit = if len
>= 25 then Some
(get_uint64_32 s
21) else None
in
159 let flags = if len
>= 29 then get_int s
25 else 0 in
160 let lowid_users = if len
>= 33 then Some
(get_uint64_32 s
29) else None
in
163 challenge = challenge;
166 soft_limit = soft_limit;
167 hard_limit = hard_limit;
168 max_users = max_users;
169 lowid_users = lowid_users;
170 get_sources
= 0x01 land flags = 0x01;
171 get_files
= 0x02 land flags = 0x02;
172 newtags
= 0x08 land flags = 0x08;
173 unicode
= 0x10 land flags = 0x10;
174 get_sources2
= 0x20 land flags = 0x20;
175 largefiles
= 0x100 land flags = 0x100;
176 udp_obfuscation
= 0x200 land flags = 0x200;
177 tcp_obfuscation
= 0x200 land flags = 0x200;
181 Printf.bprintf oc
"PING REPLY\n";
182 Printf.bprintf oc
" %Ld users %Ld files\n" t
.users t
.files;
183 (match t
.soft_limit with Some x
-> Printf.bprintf oc
" Soft limit: %Ld\n" x
| None
-> ());
184 (match t
.hard_limit with Some x
-> Printf.bprintf oc
" Hard limit: %Ld\n" x
| None
-> ());
185 (match t
.max_users with Some x
-> Printf.bprintf oc
" Max nusers: %Ld\n" x
| None
-> ());
186 (match t
.lowid_users with Some x
-> Printf.bprintf oc
" LowId nusers: %Ld\n" x
| None
-> ());
187 Printf.bprintf oc
" get_sources %b, get_files %b, newtags %b, unicode %b, get_sources2 %b, largefiles %b, udp_obfuscation %b, tcp_obfuscation %b"
188 t
.get_sources t
.get_files t
.newtags t
.unicode t
.get_sources2 t
.largefiles t
.udp_obfuscation t
.tcp_obfuscation
191 buf_int64_32 buf t
.challenge;
192 buf_int64_32 buf t
.users;
193 buf_int64_32 buf t
.files;
194 (match t
.soft_limit, t
.hard_limit, t
.max_users with
195 None
, None
, None
-> ()
198 match t
.soft_limit with Some x
-> x
| None
-> 0L);
200 match t
.hard_limit with Some x
-> x
| None
-> 0L);
202 match t
.max_users with Some x
-> x
| None
-> 0L)
206 module ServerDescUdp
= struct
209 let invalid_len = Int64.of_int
0xF0FF
211 let parse len s
= Int64.of_string s
214 Printf.bprintf b
"ServerDescUdpReq\n"
217 // eserver 16.45+ supports a new OP_SERVER_DESC_RES answer, if the OP_SERVER_DESC_REQ contains a uint32
218 // challenge, the server returns additional info with OP_SERVER_DESC_RES. To properly distinguish the
219 // old and new OP_SERVER_DESC_RES answer, the challenge has to be selected carefully. The first 2 bytes
220 // of the challenge (in network byte order) MUST NOT be a valid string-len-int16!
228 module ServerDescReplyUdp
= struct
237 "\001", Field_KNOWN
"servername";
238 "\011", Field_KNOWN
"description";
239 "\012", Field_KNOWN
"ping";
240 "\013", Field_KNOWN
"fail";
241 "\014", Field_KNOWN
"preference";
242 "\015", Field_KNOWN
"port";
243 "\016", Field_KNOWN
"ip";
244 "\133", Field_KNOWN
"dynip";
245 "\135", Field_KNOWN
"maxusers";
246 "\136", Field_KNOWN
"softfiles";
247 "\137", Field_KNOWN
"hardfiles";
248 "\144", Field_KNOWN
"lastping";
249 "\145", Field_KNOWN
"version";
250 "\146", Field_KNOWN
"udpflags";
251 "\147", Field_KNOWN
"auxportslist";
252 "\148", Field_KNOWN
"lowidusers";
255 let parse1 len s
challenge =
256 let name, pos = get_string s
1 in
257 let desc, pos = get_string s
pos in
262 challenge = challenge;
265 let parse2 len s
challenge =
266 let stags,pos = get_tags s
5 names_of_tag in
269 List.iter (fun tag
->
271 | { tag_name
= Field_KNOWN
"servername"; tag_value
= String v
} ->
273 | { tag_name
= Field_KNOWN
"description"; tag_value
= String v
} ->
281 challenge = challenge;
285 let challenge = get_uint64_32 s
1 in
286 let test = right64
(left64
challenge 48) 48 in
287 let f = if test = ServerDescUdp.invalid_len then parse2 else parse1 in
291 Printf.bprintf b
"ServerDescReplyUdpReq\n";
292 Printf.bprintf b
"name : %s\n" t
.name;
293 Printf.bprintf b
"desc : %s\n" t
.desc
296 buf_string buf t
.name;
297 buf_string buf t
.desc
301 module ServerListUdp
= struct
308 let ip = get_ip s
1 in
318 Printf.bprintf b
"ServerListUdp %s\n" (Ip.to_string t
.ip)
325 module QueryServersUdp
= DonkeyProtoServer.QueryServers
326 module QueryServersReplyUdp
= DonkeyProtoServer.QueryServersReply
327 module QueryLocationUdp
= struct
328 open DonkeyProtoServer.QueryLocation
333 let rec iter pos list
=
335 iter (pos+16) (get_md4 s
pos :: list
)
342 Printf.bprintf b
"UDP QUERY LOCATIONS: ";
343 List.iter (fun md4 -> Printf.bprintf b
"%s " (Md4.to_string
md4)) t
346 List.iter (fun md4 -> buf_md4 buf
md4) t
349 module QueryLocationUdpReq2
= struct
351 type t
= (Md4.t
* Int64.t
) list
353 (* We never parse this anyway, it is outgoing only *)
355 let rec iter pos list
=
357 iter (pos+20) ( (get_md4 s
pos, get_uint64_32 s
(pos+16)) :: list
)
364 Printf.bprintf b
"UDP QUERY LOCATIONS2: ";
365 List.iter (fun (md4,size
) -> Printf.bprintf b
"%s|%Ld " (Md4.to_string
md4) size
) t
;
366 Printf.bprintf b
"\n"
369 List.iter (fun (md4,size
) -> buf_md4 buf
md4; buf_int64_32 buf size
) t
373 module QueryLocationReplyUdp
= struct
374 open DonkeyProtoServer.QueryLocationReply
376 type t
= DonkeyProtoServer.QueryLocationReply.t list
379 let rec iter_len pos list
=
381 let md4 = get_md4 s
pos in
382 let n = get_uint8 s
(pos+16) in
384 if i
= n then [] else
385 let ip = get_ip s
(pos+17 + i
* 6) in
386 let port = get_port s
(pos+21+ i
* 6) in
387 { ip = ip; port = port; } :: (iter (i
+1))
390 let pos = pos+17+6*n + 2 in
391 iter_len pos ({ locs =locs; md4 = md4 } :: list
)
398 Printf.bprintf b
"UDP LOCATION: %d\n" (List.length t
);
400 Printf.bprintf b
" of %s:\n" (Md4.to_string t
.md4);
402 Printf.bprintf b
"%s:%d " (Ip.to_string l
.ip) l
.port;
404 Printf.bprintf b
"\n") t
409 buf_int8 buf
(List.length t
.locs);
419 module QueryUdp
= DonkeyProtoServer.Query
423 let rec iter list pos =
425 let t, pos = parse_query s pos in
432 Printf.bprintf b "UDP QUERY: %d\n" (List.length t);
433 List.iter (bprint_query b) t
441 module QueryIDReplyUdp
= DonkeyProtoServer.QueryIDReply
444 | QueryServersUdpReq
of QueryServersUdp.t
445 | QueryServersReplyUdpReq
of QueryServersReplyUdp.t
447 | PingServerUdpReq
of PingServerUdp.t
448 | PingServerReplyUdpReq
of PingServerReplyUdp.t
450 | QueryLocationUdpReq2
of QueryLocationUdpReq2.t
451 | QueryLocationUdpReq
of QueryLocationUdp.t
452 | QueryLocationReplyUdpReq
of QueryLocationReplyUdp.t
454 | QueryReplyUdpReq
of QueryReplyUdp.t
455 | QueryUdpReq
of CommonTypes.query
456 | QueryMultipleUdpReq
of CommonTypes.query
457 | QueryCallUdpReq
of QueryCallUdp.t
458 | QueryIDReplyUdpReq
of QueryIDReplyUdp.t
459 | FileGroupInfoUdpReq
of QueryLocationReplyUdp.t
460 | ServerDescUdpReq
of ServerDescUdp.t
461 | ServerDescReplyUdpReq
of ServerDescReplyUdp.t
462 | ServerListUdpReq
of ServerListUdp.t
464 | EmuleReaskFilePingUdpReq
of Md4.t
465 | EmuleReaskAckUdpReq
of Md4.t
466 | EmuleFileNotFoundUdpReq
467 | EmuleQueueFullUdpReq
470 | UnknownUdpReq
of int * string
474 let len = String.length s
in
475 if len = 0 then raise Not_found
;
476 let opcode = int_of_char
(s
.[0]) in
477 (* lprintf "opcode: %d" opcode; lprint_newline (); *)
479 | 150 -> PingServerUdpReq
(PingServerUdp.parse len s
)
480 | 151 -> PingServerReplyUdpReq
(PingServerReplyUdp.parse len s
)
482 | 146 -> QueryMultipleUdpReq
(QueryUdp.parse len s
)
483 | 152 -> QueryUdpReq
(QueryUdp.parse len s
)
484 | 153 -> QueryReplyUdpReq
(QueryReplyUdp.parse len s
)
485 | 154 -> QueryLocationUdpReq
(QueryLocationUdp.parse len s
)
486 | 155 -> QueryLocationReplyUdpReq
(QueryLocationReplyUdp.parse len s
)
487 | 156 -> QueryCallUdpReq
(QueryCallUdp.parse len s
)
488 | 160 -> QueryServersUdpReq
(QueryServersUdp.parse len s
)
489 | 161 -> QueryServersReplyUdpReq
(QueryServersReplyUdp.parse len s
)
490 | 162 -> ServerDescUdpReq
(ServerDescUdp.parse len s
)
491 | 163 -> ServerDescReplyUdpReq
(ServerDescReplyUdp.parse len s
)
492 | 164 -> ServerListUdpReq
(ServerListUdp.parse len s
)
494 | 144 -> EmuleReaskFilePingUdpReq
(get_md4 s
1)
495 | 145 -> EmuleReaskAckUdpReq
(get_md4 s
1)
496 (* | 146 -> EmuleFileNotFoundUdpReq *)
497 | 147 -> EmuleQueueFullUdpReq
498 | 254 -> EmulePortTestReq
503 if !verbose_unknown_messages
then begin lprintf
"Unknown UDP request:\n"; dump s
end;
504 UnknownUdpReq
(magic
, s
)
507 let b = Buffer.create
100 in
511 | QueryUdpReq
t -> QueryUdp.bprint b t
512 | QueryMultipleUdpReq
t -> QueryUdp.bprint b t
513 | QueryReplyUdpReq
t -> QueryReplyUdp.bprint b t
514 | QueryLocationUdpReq2
t -> QueryLocationUdpReq2.bprint b t
515 | QueryLocationUdpReq
t -> QueryLocationUdp.bprint b t
516 | QueryLocationReplyUdpReq
t
517 | FileGroupInfoUdpReq
t -> QueryLocationReplyUdp.bprint b t
518 | QueryCallUdpReq
t -> QueryCallUdp.bprint b t
520 | QueryServersUdpReq
t -> QueryServersUdp.bprint b t
521 | QueryServersReplyUdpReq
t -> QueryServersReplyUdp.bprint b t
522 | QueryIDReplyUdpReq
t -> QueryIDReplyUdp.bprint b t
524 | PingServerUdpReq
t -> PingServerUdp.bprint b t
525 | PingServerReplyUdpReq
t -> PingServerReplyUdp.bprint b t
526 | ServerDescUdpReq
t -> ServerDescUdp.bprint b t
527 | ServerDescReplyUdpReq
t -> ServerDescReplyUdp.bprint b t
528 | ServerListUdpReq
t -> ServerListUdp.bprint b t
530 | EmuleReaskFilePingUdpReq
md4 ->
531 Printf.bprintf
b "EmuleReaskFilePingUdpReq %s" (Md4.to_string
md4)
532 | EmuleReaskAckUdpReq
md4 ->
533 Printf.bprintf
b "EmuleReaskAckUdpReq %s" (Md4.to_string
md4)
534 | EmuleFileNotFoundUdpReq
->
535 Printf.bprintf
b "EmuleFileNotFoundUdpReq"
536 | EmuleQueueFullUdpReq
->
537 Printf.bprintf
b "EmuleQueueFullUdpReq"
538 | EmulePortTestReq
->
539 Printf.bprintf
b "EmulePortTestReq"
541 | UnknownUdpReq
(magic
, s
) ->
542 Printf.bprintf
b "UnknownReq magic %d\n" magic
;
545 Printf.bprintf
b "\n";
551 | UnknownUdpReq
(magic
, s
) ->
553 Buffer.add_string buf s
555 | EmuleReaskFilePingUdpReq
md4 ->
560 | EmuleReaskAckUdpReq
md4 ->
565 | EmuleFileNotFoundUdpReq
->
569 | EmuleQueueFullUdpReq
->
576 | QueryServersUdpReq
t ->
578 QueryServersUdp.write buf
t
579 | QueryServersReplyUdpReq
t ->
581 QueryServersReplyUdp.write buf
t
583 | ServerDescUdpReq
t ->
585 ServerDescUdp.write buf
t
586 | ServerDescReplyUdpReq
t ->
588 ServerDescReplyUdp.write buf
t
589 | ServerListUdpReq
t ->
591 ServerListUdp.write buf
t
593 | PingServerUdpReq
t ->
595 PingServerUdp.write buf
t
596 | PingServerReplyUdpReq
t ->
598 PingServerReplyUdp.write buf
t
600 | QueryLocationUdpReq
t ->
602 QueryLocationUdp.write buf
t
603 | QueryLocationUdpReq2
t ->
605 QueryLocationUdpReq2.write buf
t
606 | QueryLocationReplyUdpReq
t ->
608 QueryLocationReplyUdp.write buf
t
612 | QueryMultipleUdpReq
t ->
615 | QueryReplyUdpReq
t ->
617 QueryReplyUdp.write buf
t
618 | QueryCallUdpReq
t ->
620 QueryCallUdp.write buf
t
621 | FileGroupInfoUdpReq
t ->
623 QueryLocationReplyUdp.write buf
t
625 | QueryIDReplyUdpReq
t ->
627 QueryIDReplyUdp.write buf
t
629 | EmulePortTestReq
->
637 | EmuleQueueFullUdpReq
638 | EmuleFileNotFoundUdpReq
639 | EmuleReaskAckUdpReq _
640 | EmuleReaskFilePingUdpReq _
641 | UnknownUdpReq _
-> assert false