patch #8106
[mldonkey.git] / src / networks / donkey / donkeyProtoUdp.ml
blob7a7adaf4e5a9342e10072563505c6af9573ef80a
1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
2 (*
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
20 open Printf2
21 open Md4
22 open Autoconf
23 open LittleEndian
24 open AnyEndian
26 open CommonTypes
27 open CommonGlobals
28 open CommonOptions
30 open DonkeyTypes
31 open DonkeyMftp
32 open Int64ops
34 module QueryReplyUdp = struct
36 type t = tagged_file list
38 let names_of_tag = file_common_tags
40 let get_file s pos =
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
45 let file = {
46 f_md4 = md4;
47 f_ip = ip;
48 f_port = port;
49 f_tags = tags;
50 } in
51 file, pos
53 let parse len s =
54 let rec iter pos list =
55 if pos < len then
56 let file, pos = get_file s pos in
57 let pos = pos + 2 in
58 iter pos (file :: list)
59 else List.rev list
61 iter 1 []
63 let bprint oc t =
64 Printf.bprintf oc "FOUND:\n";
65 List.iter (fun t ->
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"
72 ) t
74 let write buf t =
75 List.iter (fun file ->
76 buf_md4 buf file.f_md4;
77 buf_ip buf file.f_ip;
78 buf_port buf file.f_port;
79 buf_tags buf file.f_tags names_of_tag
80 ) t
82 end
84 module QueryCallUdp = struct
85 type t = {
86 ip : Ip.t;
87 port : int;
88 id : int64;
91 let parse len s =
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; }
97 let bprint oc t =
98 Printf.bprintf oc "QueryCall %s : %d --> %Ld\n" (Ip.to_string t.ip)
99 t.port t.id
101 let write buf t =
102 buf_ip buf t.ip;
103 buf_port buf t.port;
104 buf_ip buf (ip_of_id t.id)
108 module PingServerUdp = struct (* client -> serveur pour identification ? *)
109 type t = int64
111 let parse len s =
113 get_uint64_32 s 1 (*, get_int8 s 2, get_int8 s 3*)
114 with _ -> 0L
116 let bprint oc t =
117 Printf.bprintf oc "PING %s\n" (Int64.to_string t)
119 let write buf t =
120 buf_int64_32 buf 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) =
126 buf_int8 buf t1;
127 buf_int8 buf t2;
128 buf_int8 buf t3;*)
132 module PingServerReplyUdp = struct (* reponse du serveur a 150 *)
134 type t = {
135 challenge : int64;
136 users : int64;
137 files : int64;
138 soft_limit : int64 option;
139 hard_limit : int64 option;
140 max_users : int64 option;
141 lowid_users : int64 option;
142 get_sources : bool;
143 get_files : bool;
144 newtags : bool;
145 unicode : bool;
146 get_sources2 : bool;
147 largefiles : bool;
148 udp_obfuscation : bool;
149 tcp_obfuscation : bool;
152 let parse len s =
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;
164 users = users;
165 files = files;
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;
180 let bprint oc t =
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
190 let write buf t =
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 -> ()
196 | _ ->
197 buf_int64_32 buf (
198 match t.soft_limit with Some x -> x | None -> 0L);
199 buf_int64_32 buf (
200 match t.hard_limit with Some x -> x | None -> 0L);
201 buf_int64_32 buf (
202 match t.max_users with Some x -> x | None -> 0L)
206 module ServerDescUdp = struct
207 type t = int64
209 let invalid_len = Int64.of_int 0xF0FF
211 let parse len s = Int64.of_string s
213 let bprint b t =
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!
223 let write buf t =
224 buf_int64_32 buf t
228 module ServerDescReplyUdp = struct
229 type t = {
230 name : string;
231 desc : string;
232 tags : tag list;
233 challenge : int64;
236 let names_of_tag = [
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
259 tags = [];
260 name = name;
261 desc = desc;
262 challenge = challenge;
265 let parse2 len s challenge =
266 let stags,pos = get_tags s 5 names_of_tag in
267 let name = ref "" in
268 let desc = ref "" in
269 List.iter (fun tag ->
270 match tag with
271 | { tag_name = Field_KNOWN "servername"; tag_value = String v } ->
272 name := v
273 | { tag_name = Field_KNOWN "description"; tag_value = String v } ->
274 desc := v
275 | _ -> ()
276 ) stags;
278 tags = stags;
279 name = !name;
280 desc = !desc;
281 challenge = challenge;
284 let parse len s =
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
288 f len s challenge
290 let bprint b t =
291 Printf.bprintf b "ServerDescReplyUdpReq\n";
292 Printf.bprintf b "name : %s\n" t.name;
293 Printf.bprintf b "desc : %s\n" t.desc
295 let write buf t =
296 buf_string buf t.name;
297 buf_string buf t.desc
301 module ServerListUdp = struct
302 type t = {
303 ip : Ip.t;
306 let parse len s =
308 let ip = get_ip s 1 in
310 ip = ip;
312 with _ ->
314 ip = Ip.null
317 let bprint b t =
318 Printf.bprintf b "ServerListUdp %s\n" (Ip.to_string t.ip)
320 let write buf t =
321 buf_ip buf t.ip
325 module QueryServersUdp = DonkeyProtoServer.QueryServers
326 module QueryServersReplyUdp = DonkeyProtoServer.QueryServersReply
327 module QueryLocationUdp = struct
328 open DonkeyProtoServer.QueryLocation
330 type t = Md4.t list
332 let parse len s =
333 let rec iter pos list =
334 if pos < len then
335 iter (pos+16) (get_md4 s pos :: list)
336 else
337 List.rev list
339 iter 1 []
341 let bprint b t =
342 Printf.bprintf b "UDP QUERY LOCATIONS: ";
343 List.iter (fun md4 -> Printf.bprintf b "%s " (Md4.to_string md4)) t
345 let write buf 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 *)
354 let parse len s =
355 let rec iter pos list =
356 if pos < len then
357 iter (pos+20) ( (get_md4 s pos, get_uint64_32 s (pos+16)) :: list)
358 else
359 List.rev list
361 iter 1 []
363 let bprint b t =
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"
368 let write buf t =
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
378 let parse len s =
379 let rec iter_len pos list =
380 if pos < len then
381 let md4 = get_md4 s pos in
382 let n = get_uint8 s (pos+16) in
383 let rec iter i =
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))
389 let locs = iter 0 in
390 let pos = pos+17+6*n + 2 in
391 iter_len pos ({ locs =locs; md4 = md4 } :: list)
392 else
393 List.rev list
395 iter_len 1 []
397 let bprint b t =
398 Printf.bprintf b "UDP LOCATION: %d\n" (List.length t);
399 List.iter (fun t ->
400 Printf.bprintf b " of %s:\n" (Md4.to_string t.md4);
401 List.iter (fun l ->
402 Printf.bprintf b "%s:%d " (Ip.to_string l.ip) l.port;
403 ) t.locs;
404 Printf.bprintf b "\n") t
406 let write buf t =
407 List.iter (fun t ->
408 buf_md4 buf t.md4;
409 buf_int8 buf (List.length t.locs);
410 List.iter (fun l ->
411 buf_ip buf l.ip;
412 buf_port buf l.port;
413 ) t.locs
419 module QueryUdp = DonkeyProtoServer.Query
422 let parse len s =
423 let rec iter list pos =
424 if len > pos then
425 let t, pos = parse_query s pos in
426 iter (t :: list) pos
427 else List.rev list
429 iter [] 1
431 let bprint b t =
432 Printf.bprintf b "UDP QUERY: %d\n" (List.length t);
433 List.iter (bprint_query b) t
435 let write buf t =
436 List.iter write t
441 module QueryIDReplyUdp = DonkeyProtoServer.QueryIDReply
443 type t =
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
468 | EmulePortTestReq
470 | UnknownUdpReq of int * string
472 let parse magic s =
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 (); *)
478 match opcode with
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
500 | _ -> raise Exit
501 with
502 e ->
503 if !verbose_unknown_messages then begin lprintf "Unknown UDP request:\n"; dump s end;
504 UnknownUdpReq (magic, s)
506 let print t =
507 let b = Buffer.create 100 in
508 begin
509 match t with
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;
543 bdump b s;
544 end;
545 Printf.bprintf b "\n";
546 Buffer.contents b
548 let write buf t =
549 match t with
551 | UnknownUdpReq (magic, s) ->
552 buf_int8 buf magic;
553 Buffer.add_string buf s
555 | EmuleReaskFilePingUdpReq md4 ->
556 buf_int8 buf 197;
557 buf_int8 buf 145;
558 buf_md4 buf md4
560 | EmuleReaskAckUdpReq md4 ->
561 buf_int8 buf 197;
562 buf_int8 buf 145;
563 buf_md4 buf md4
565 | EmuleFileNotFoundUdpReq ->
566 buf_int8 buf 197;
567 buf_int8 buf 146
569 | EmuleQueueFullUdpReq ->
570 buf_int8 buf 197;
571 buf_int8 buf 147
573 | _ ->
574 buf_int8 buf 227;
575 match t with
576 | QueryServersUdpReq t ->
577 buf_int8 buf 160;
578 QueryServersUdp.write buf t
579 | QueryServersReplyUdpReq t ->
580 buf_int8 buf 161;
581 QueryServersReplyUdp.write buf t
583 | ServerDescUdpReq t ->
584 buf_int8 buf 162;
585 ServerDescUdp.write buf t
586 | ServerDescReplyUdpReq t ->
587 buf_int8 buf 163;
588 ServerDescReplyUdp.write buf t
589 | ServerListUdpReq t ->
590 buf_int8 buf 164;
591 ServerListUdp.write buf t
593 | PingServerUdpReq t ->
594 buf_int8 buf 150;
595 PingServerUdp.write buf t
596 | PingServerReplyUdpReq t ->
597 buf_int8 buf 151;
598 PingServerReplyUdp.write buf t
600 | QueryLocationUdpReq t ->
601 buf_int8 buf 154;
602 QueryLocationUdp.write buf t
603 | QueryLocationUdpReq2 t ->
604 buf_int8 buf 148;
605 QueryLocationUdpReq2.write buf t
606 | QueryLocationReplyUdpReq t ->
607 buf_int8 buf 155;
608 QueryLocationReplyUdp.write buf t
609 | QueryUdpReq t ->
610 buf_int8 buf 152;
611 QueryUdp.write buf t
612 | QueryMultipleUdpReq t ->
613 buf_int8 buf 146;
614 QueryUdp.write buf t
615 | QueryReplyUdpReq t ->
616 buf_int8 buf 153;
617 QueryReplyUdp.write buf t
618 | QueryCallUdpReq t ->
619 buf_int8 buf 156;
620 QueryCallUdp.write buf t
621 | FileGroupInfoUdpReq t ->
622 buf_int8 buf 251;
623 QueryLocationReplyUdp.write buf t
625 | QueryIDReplyUdpReq t ->
626 buf_int8 buf 53;
627 QueryIDReplyUdp.write buf t
629 | EmulePortTestReq ->
630 buf_int8 buf 2;
631 buf_int8 buf 0;
632 buf_int8 buf 0;
633 buf_int8 buf 0;
634 buf_int8 buf 0xfe;
635 buf_int8 buf 0x31
637 | EmuleQueueFullUdpReq
638 | EmuleFileNotFoundUdpReq
639 | EmuleReaskAckUdpReq _
640 | EmuleReaskFilePingUdpReq _
641 | UnknownUdpReq _ -> assert false