[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyProtoSe
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyProtoServer.ml |
|
Date: |
Mon, 08 Aug 2005 12:47:41 -0400 |
Index: mldonkey/src/networks/donkey/donkeyProtoServer.ml
diff -u mldonkey/src/networks/donkey/donkeyProtoServer.ml:1.17
mldonkey/src/networks/donkey/donkeyProtoServer.ml:1.18
--- mldonkey/src/networks/donkey/donkeyProtoServer.ml:1.17 Fri Jul 22
10:58:55 2005
+++ mldonkey/src/networks/donkey/donkeyProtoServer.ml Mon Aug 8 16:47:31 2005
@@ -24,11 +24,11 @@
open LittleEndian
open CommonTypes
open CommonGlobals
-
+
open DonkeyTypes
open DonkeyMftp
-(*
+(*
let field_of_tagname s =
match s with
| "size" -> Field_Size
@@ -39,8 +39,7 @@
| "format" -> Field_Format
| "type" -> Field_Type
| s -> Field_UNKNOWN s
-
-
+
let tagname_of_field field =
match field with
Field_Size -> "size"
@@ -53,15 +52,15 @@
| Field_Uid -> "uid"
| Field_unknown s -> s
*)
-
-module Connect = struct
+
+module Connect = struct
type t = {
md4 : Md4.t;
ip: Ip.t;
port: int;
tags : tag list;
}
-
+
let names_of_tag =
[
"\001", Field_UNKNOWN "name";
@@ -70,7 +69,7 @@
"\032", Field_UNKNOWN "extended";
"\251", Field_UNKNOWN "emule_version";
]
-
+
let parse len s =
let md4 = get_md4 s 1 in
let ip = get_ip s 17 in
@@ -84,18 +83,18 @@
tags = tags;
}
- let print t =
+ let print t =
lprintf_nl "CONNECT:";
- lprintf_nl "MD4: %s" (Md4.to_string t.md4);
+ lprintf_nl "MD4: %s" (Md4.to_string t.md4);
lprintf_nl "ip: %s" (Ip.to_string t.ip);
lprintf_nl "port: %d" t.port;
lprintf "tags: ";
print_tags t.tags;
lprint_newline ()
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "CONNECT:\n";
- Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
+ Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
Printf.bprintf oc "%d\n" t.port;
Printf.bprintf oc "TAGS:\n";
@@ -106,23 +105,22 @@
buf_md4 buf t.md4;
buf_ip buf t.ip;
buf_port buf t.port;
- buf_tags buf t.tags names_of_tag
+ buf_tags buf t.tags names_of_tag
end
module ChatRooms = struct (* request: 57 *)
-
+
(* example:
-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)]
*)
-
-
+
type channel = {
name : string;
number : int;
}
-
+
type t = channel list
-
+
let parse len s =
let nchans = get_uint8 s 1 in
let rec iter s pos nchans =
@@ -150,17 +148,17 @@
List.iter (fun c ->
buf_string buf c.name;
buf_int buf c.number) t
-
+
end
-module SetID = struct
+module SetID = struct
type t = {
ip : Ip.t;
zlib : bool;
port : int option
}
-
- let parse len s =
+
+ let parse len s =
let ip = get_ip s 1 in
let zlib = (0x01 land get_int s 5) = 0x01 in
let port =
@@ -186,7 +184,7 @@
let bprint oc t =
Printf.bprintf oc "SET_ID: %s\n" (if t.zlib then "Zlib" else "");
Printf.bprintf oc "id: %s\n" (Ip.to_string t.ip)
-
+
let write buf t =
if t.zlib then buf_int buf 1;
buf_ip buf t.ip
@@ -195,47 +193,47 @@
let unit = ()
-module AckID = struct
+module AckID = struct
type t = unit
-
+
let parse len s = ()
-
- let print t =
+
+ let print t =
lprintf_nl "ACK_ID:"
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "ACK_ID\n"
-
+
let write (buf: Buffer.t) (t: t) = unit
let t = (() : t)
end
-module Message = struct
+module Message = struct
type t = string
-
- let parse len s =
+
+ let parse len s =
let v, pos = get_string s 1 in
v
-
- let print t =
+
+ let print t =
lprintf_nl "MESSAGE:";
lprintf_nl "message = \"%s\"" (String.escaped t)
-
- let bprint oc t =
+
+ let bprint oc t =
Printf.bprintf oc "MESSAGE:\n";
Printf.bprintf oc "%s\n" (String.escaped t)
let write buf t =
buf_string buf t
end
-
-module Share = struct
-
+
+module Share = struct
+
type t = tagged_file list
-
+
let names_of_tag = file_common_tags
-
+
let rec get_files s pos n =
if n = 0 then [], pos else
let md4 = get_md4 s pos in
@@ -250,14 +248,13 @@
} in
let files, pos = get_files s pos (n-1) in
file :: files, pos
-
-
+
let parse len s =
let n = get_int s 1 in
let files, pos = get_files s 5 n in
files
-
- let print t =
+
+ let print t =
lprintf_nl "SHARED:";
List.iter (fun t ->
lprintf_nl "FILE:";
@@ -267,8 +264,8 @@
lprintf " tags: ";
print_tags t.f_tags;
lprint_newline ();) t
-
- let bprint oc t =
+
+ let bprint oc t =
Printf.bprintf oc "SHARED:\n";
List.iter (fun t ->
Printf.bprintf oc "FILE:\n";
@@ -279,7 +276,7 @@
bprint_tags oc t.f_tags;
Printf.bprintf oc "\n"
) t
-
+
let rec write_files buf files =
match files with
[] -> ()
@@ -289,11 +286,11 @@
buf_port buf file.f_port;
buf_tags buf file.f_tags names_of_tag;
write_files buf files
-
- let write buf t =
+
+ let write buf t =
buf_int buf (List.length t);
write_files buf t
-
+
let rec write_files_max buf files nfiles max_len =
let prev_len = Buffer.length buf in
match files with
@@ -307,40 +304,40 @@
write_files_max buf files (nfiles+1) max_len
else
nfiles, prev_len
-
+
end
-module Info = struct
+module Info = struct
type t = int * int
-
+
let parse len s =
-
+
let users = get_int s 1 in
let files = get_int s 5 in
users, files
-
- let print (users, files) =
+
+ let print (users, files) =
lprintf_nl "INFO:";
- lprintf_nl "users: %d files: %d" users files
+ lprintf_nl "users: %d files: %d" users files
- let bprint oc (users, files) =
+ let bprint oc (users, files) =
Printf.bprintf oc "INFO:\n";
- Printf.bprintf oc "%d\n %d\n" users files
-
+ Printf.bprintf oc "%d\n %d\n" users files
+
let write buf (users, files) =
buf_int buf users;
buf_int buf files
end
-module ServerList = struct
+module ServerList = struct
type server = {
ip : Ip.t;
port : int;
}
-
+
type t = server list
-
- let parse len s =
+
+ let parse len s =
let n = get_uint8 s 1 in
let rec iter i =
if i = n then [] else
@@ -349,20 +346,20 @@
{ ip = ip; port = port; } :: (iter (i+1))
in
iter 0
-
- let print t =
+
+ let print t =
lprintf_nl "SERVER LIST";
- List.iter (fun l ->
+ List.iter (fun l ->
lprintf_nl " %s : %d" (Ip.to_string l.ip) l.port;
) t
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "SERVER LIST\n";
- List.iter (fun l ->
+ List.iter (fun l ->
Printf.bprintf oc "%s:%d\n" (Ip.to_string l.ip) l.port;
) t
-
- let write buf t =
+
+ let write buf t =
buf_int8 buf (List.length t);
List.iter (fun l ->
buf_ip buf l.ip;
@@ -370,22 +367,20 @@
) t
end
-
-
-module ServerInfo = struct
+module ServerInfo = struct
type t = {
md4 : Md4.t;
ip: Ip.t;
port: int;
tags : tag list;
}
-
+
let names_of_tag =
[
"\001", Field_UNKNOWN "name";
"\011", Field_UNKNOWN "description";
]
-
+
let parse len s =
let md4 = get_md4 s 1 in
let ip = get_ip s 17 in
@@ -398,8 +393,8 @@
port = port;
tags = tags;
}
-
- let print t =
+
+ let print t =
lprintf_nl "SERVER INFO:";
lprintf_nl "MD4: %s" (Md4.to_string t.md4);
lprintf_nl "ip: %s" (Ip.to_string t.ip);
@@ -407,7 +402,7 @@
lprintf "tags: ";
print_tags t.tags
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "SERVER INFO:\n";
Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
@@ -415,22 +410,21 @@
Printf.bprintf oc "TAGS:\n";
bprint_tags oc t.tags;
Printf.bprintf oc "\n"
-
+
let write buf t =
buf_md4 buf t.md4;
buf_ip buf t.ip;
buf_port buf t.port;
buf_tags buf t.tags names_of_tag
-
+
end
-module QueryReply = struct
-
+module QueryReply = struct
+
type t = tagged_file list
let names_of_tag = file_common_tags
-
-
+
let rec get_files s pos n =
if n = 0 then [], pos else
try
@@ -446,17 +440,17 @@
} in
let files, pos = get_files s pos (n-1) in
file :: files, pos
- with _ ->
+ with _ ->
raise Not_found
- let get_replies s pos =
+ let get_replies s pos =
let n = get_int s pos in
let files, pos = get_files s (pos+4) n in
files
-
+
let parse len s = get_replies s 1
-
- let print t =
+
+ let print t =
lprintf_nl "FOUND:";
List.iter (fun t ->
lprintf_nl "FILE:";
@@ -467,7 +461,7 @@
print_tags t.f_tags;
lprint_newline ()) t
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "FOUND:\n";
List.iter (fun t ->
Printf.bprintf oc "FILE:\n";
@@ -478,7 +472,7 @@
bprint_tags oc t.f_tags;
Printf.bprintf oc "\n"
) t
-
+
let rec write_files buf files =
match files with
[] -> ()
@@ -489,46 +483,44 @@
buf_tags buf file.f_tags names_of_tag;
write_files buf files
- let write_replies buf t =
+ let write_replies buf t =
buf_int buf (List.length t);
write_files buf t
-
- let write buf t =
+
+ let write buf t =
write_replies buf t;
buf_int8 buf 0
end
let unit = ()
-module NoArg = functor(M: sig val m : string end) -> (struct
+module NoArg = functor(M: sig val m : string end) -> (struct
type t = unit
-
+
let parse len s = ()
-
- let print t =
+
+ let print t =
lprintf_nl "%s:" M.m
-
+
let write (buf: Buffer.t) (t: t) = unit
-
+
let t = (() : t)
end : sig
type t
val parse : int -> string -> t
val print : t -> unit
val write : Buffer.t -> t -> unit
- val t :t
+ val t :t
end
)
module QueryNext = NoArg(struct let m = "QUERY NEXT" end)
-
-
module Query = struct (* request 22 *)
(* TODO : build a complete list of tags used in these queries and their correct
translation, i.e. Field_Artist = "Artist" instead of "artist" *)
-
+
let names_of_tag =
[
"\002", Field_Size;
@@ -537,40 +529,40 @@
"\021", Field_Availability;
"\048", Field_Completesources;
]
-
+
let rec parse_query s pos =
let t = get_uint8 s pos in
match t with
- 0 ->
+ 0 ->
let t = get_uint8 s (pos+1) in
begin
match t with
- 0 ->
+ 0 ->
let q1, pos = parse_query s (pos + 2) in
let q2, pos = parse_query s pos in
QAnd (q1,q2), pos
- | 1 ->
+ | 1 ->
let q1, pos = parse_query s (pos + 2) in
let q2, pos = parse_query s pos in
QOr (q1,q2), pos
- | 2 ->
+ | 2 ->
let q1, pos = parse_query s (pos + 2) in
let q2, pos = parse_query s pos in
QAndNot (q1,q2), pos
|_ -> failwith "Unknown QUERY operator"
end
| 1 -> let s, pos = get_string s (pos + 1) in QHasWord s, pos
- | 2 ->
+ | 2 ->
let field, pos = get_string s (pos + 1) in
- let name, pos = get_string s pos in
+ let name, pos = get_string s pos in
let name = try
List.assoc name names_of_tag
with _ -> field_of_string name
in
-
+
QHasField (name, field), pos
-
- | 3 ->
+
+ | 3 ->
let field = get_uint64_32 s (pos + 1) in
let minmax = get_uint8 s (pos + 5) in
let name, pos = get_string s (pos + 6) in
@@ -586,32 +578,30 @@
end, pos
| 4 -> QHasWord "", pos + 1
| _ -> failwith "Unknown QUERY format"
-
- let parse len s =
+
+ let parse len s =
let t, pos = parse_query s 1 in t
(*
type = "Col" pour voir les collections
Fields:
"Album" | "Artist" | "Title"
-
*)
-
+
let rec print_query t =
match t with
- QOr (q1, q2) ->
- print_query q1;
+ QOr (q1, q2) ->
+ print_query q1;
lprint_string " OR ";
print_query q2
- | QAnd (q1, q2) ->
- print_query q1;
+ | QAnd (q1, q2) ->
+ print_query q1;
lprint_string " AND ";
print_query q2
- | QAndNot (q1, q2) ->
- print_query q1;
+ | QAndNot (q1, q2) ->
+ print_query q1;
lprint_string " NOT ";
print_query q2
-
| QHasWord s ->
lprintf "Contains[%s]" s
| QHasField (name, field) ->
@@ -623,27 +613,25 @@
| QNone ->
lprintf "print_query: QNone in query\n";
()
-
- let print t =
+
+ let print t =
lprintf "QUERY";
print_query t
-
-
+
let rec bprint_query oc t =
match t with
- QOr (q1, q2) ->
- print_query q1;
+ QOr (q1, q2) ->
+ print_query q1;
Printf.bprintf oc " OR ";
print_query q2
- | QAnd (q1, q2) ->
- print_query q1;
+ | QAnd (q1, q2) ->
+ print_query q1;
Printf.bprintf oc " AND ";
print_query q2
- | QAndNot (q1, q2) ->
- print_query q1;
+ | QAndNot (q1, q2) ->
+ print_query q1;
Printf.bprintf oc " NOT ";
print_query q2
-
| QHasWord s ->
Printf.bprintf oc "Contains[%s]" s
| QHasField (name, field) ->
@@ -655,57 +643,55 @@
| QNone ->
lprintf_nl "print_query: QNone in query";
()
-
-
- let bprint oc t =
+
+ let bprint oc t =
Printf.bprintf oc "QUERY:\n";
bprint_query oc t;
Printf.bprintf oc "\n"
-
- let rec write buf t =
+
+ let rec write buf t =
match t with
- QOr (q1, q2) ->
+ QOr (q1, q2) ->
buf_int8 buf 0;
buf_int8 buf 1;
- write buf q1;
- write buf q2;
- | QAnd (q1, q2) ->
+ write buf q1;
+ write buf q2;
+ | QAnd (q1, q2) ->
buf_int8 buf 0;
buf_int8 buf 0;
- write buf q1;
- write buf q2;
- | QAndNot (q1, q2) ->
+ write buf q1;
+ write buf q2;
+ | QAndNot (q1, q2) ->
buf_int8 buf 0;
buf_int8 buf 2;
- write buf q1;
- write buf q2;
+ write buf q1;
+ write buf q2;
| QHasWord s ->
buf_int8 buf 1;
buf_string buf s
| QHasField (name, field) ->
-
let name = try
rev_assoc name names_of_tag
with _ -> string_of_field name in
-
+
buf_int8 buf 2;
buf_string buf field;
buf_string buf name
-
+
| QHasMinVal (name, field) ->
-
- let name = try
+
+ let name = try
rev_assoc name names_of_tag
with _ -> string_of_field name
in
-
+
buf_int8 buf 3;
buf_int64_32 buf field;
buf_int8 buf 1;
buf_string buf name
| QHasMaxVal (name, field) ->
-
+
let name = try
rev_assoc name names_of_tag
with _ -> string_of_field name in
@@ -718,31 +704,30 @@
| QNone ->
lprintf_nl "print_query: QNone in query";
()
-
+
end
-
module QueryUsers = struct (* request 26 *)
-
+
type t = string
-
+
let parse len s =
let targ = get_uint8 s 1 in
match targ with
4 -> ""
- | 1 ->
+ | 1 ->
let name, pos = get_string s 2 in
name
- | _ ->
+ | _ ->
lprintf_nl "QueryUsers: unknown tag %d" targ;
raise Not_found
-
+
let print t =
lprintf_nl "QUERY USERS [%s]" t
let bprint oc t =
Printf.bprintf oc "QUERY USERS [%s]\n" t
-
+
let write buf t =
if t = "" then
buf_int8 buf 4
@@ -751,7 +736,7 @@
buf_string buf t
end
end
-
+
module QueryUsersReply = struct (* request 67 *)
type client = {
md4 : Md4.t;
@@ -759,16 +744,16 @@
port: int;
tags : tag list;
}
-
+
type t = client list
-
+
let names_of_tag =
[
"\001", Field_UNKNOWN "name";
"\017", Field_UNKNOWN "version";
"\015", Field_UNKNOWN "port";
]
-
+
let rec parse_clients s pos nclients left =
if nclients = 0 then List.rev left else
let md4 = get_md4 s pos in
@@ -782,32 +767,32 @@
port = port;
tags = tags;
} :: left)
-
+
let parse len s =
let nclients = get_int s 1 in
parse_clients s 5 nclients []
-
- let print t =
+
+ let print t =
lprintf_nl "QUERY USERS REPLY:";
List.iter (fun t ->
- lprintf_nl "MD4: %s" (Md4.to_string t.md4);
+ lprintf_nl "MD4: %s" (Md4.to_string t.md4);
lprintf_nl "ip: %s" (Ip.to_string t.ip);
lprintf_nl "port: %d" t.port;
lprintf "tags: ";
print_tags t.tags;
lprint_newline ();) t
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "QUERY USERS REPLY:\n";
List.iter (fun t ->
- Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
+ Printf.bprintf oc "%s\n" (Md4.to_string t.md4);
Printf.bprintf oc "%s\n" (Ip.to_string t.ip);
Printf.bprintf oc "%d\n" t.port;
Printf.bprintf oc "TAGS:\n";
bprint_tags oc t.tags;
Printf.bprintf oc "\n"
) t
-
+
let write buf t =
buf_int buf (List.length t);
List.iter (fun t ->
@@ -816,35 +801,35 @@
buf_port buf t.port;
buf_tags buf t.tags names_of_tag) t
end
-
-module QueryLocation = struct
+
+module QueryLocation = struct
type t = Md4.t
-
- let parse len s =
+
+ let parse len s =
get_md4 s 1
-
- let print t =
+
+ let print t =
lprintf_nl "QUERY LOCATION OF %s" (Md4.to_string t)
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "QUERY LOCATION OF %s\n" (Md4.to_string t)
-
- let write buf t =
+
+ let write buf t =
buf_md4 buf t
end
-module QueryLocationReply = struct
+module QueryLocationReply = struct
type location = {
ip : Ip.t;
port : int;
}
-
+
type t = {
md4: Md4.t;
- locs :location list;
+ locs :location list;
}
-
- let parse len s =
+
+ let parse len s =
let md4 = get_md4 s 1 in
let n = get_uint8 s 17 in
let rec iter i =
@@ -855,118 +840,115 @@
in
let locs = iter 0 in
{ locs =locs; md4 = md4 }
-
- let print t =
+
+ let print t =
lprintf_nl "LOCATION OF %s" (Md4.to_string t.md4);
- List.iter (fun l ->
+ List.iter (fun l ->
lprintf_nl " %s : %d %s" (Ip.to_string l.ip) l.port
(if not (Ip.valid l.ip) then
Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)
else "");
-
) t.locs
-
- let bprint oc t =
+
+ let bprint oc t =
Printf.bprintf oc "LOCATION OF %s\n" (Md4.to_string t.md4);
- List.iter (fun l ->
+ List.iter (fun l ->
Printf.bprintf oc "%s:%d %s\n" (Ip.to_string l.ip) l.port
(if not (Ip.valid l.ip) then
Printf.sprintf "(Firewalled %Ld)" (id_of_ip l.ip)
else "");
;
) t.locs
-
- let write buf t =
+
+ let write buf t =
buf_md4 buf t.md4;
buf_int8 buf (List.length t.locs);
List.iter (fun l ->
buf_ip buf l.ip;
buf_port buf l.port
) t.locs
-
+
end
-
-module QueryID = struct
+
+module QueryID = struct
type t = int64
-
- let parse len s =
+
+ let parse len s =
id_of_ip (get_ip s 1)
-
- let print t =
+
+ let print t =
lprintf "QUERY IP OF %Ld" t
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "QUERY IP OF %Ld\n" t
-
- let write buf t =
+
+ let write buf t =
buf_ip buf (ip_of_id t)
end
-
-module QueryIDFailed = struct
+
+module QueryIDFailed = struct
type t = int64
-
- let parse len s =
+
+ let parse len s =
id_of_ip (get_ip s 1)
-
- let print t =
+
+ let print t =
lprintf "QUERY IP OF %Ld FAILED" t
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "QUERY IP OF %Ld FAILED\n" t
-
- let write buf t =
+
+ let write buf t =
buf_ip buf (ip_of_id t)
end
-module QueryIDReply = struct
+module QueryIDReply = struct
type t = {
ip : Ip.t;
port : int;
}
-
- let parse len s =
+
+ let parse len s =
let ip = get_ip s 1 in
let port = get_port s 5 in
{ ip = ip; port = port; }
-
- let print t =
+
+ let print t =
lprintf_nl "IDENTIFICATION %s : %d" (Ip.to_string t.ip) t.port
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "IDENTIFICATION %s : %d\n" (Ip.to_string t.ip) t.port
-
-
- let write buf t =
+
+ let write buf t =
buf_ip buf t.ip;
buf_port buf t.port
-
+
end
-module QueryServers = struct
+module QueryServers = struct
type t = {
ip : Ip.t;
port : int;
}
-
- let parse len s =
+
+ let parse len s =
let ip = get_ip s 1 in
let port = get_port s 5 in
{ ip = ip; port = port; }
-
- let print t =
+
+ let print t =
lprintf_nl "QUERY SERVERS %s : %d" (Ip.to_string t.ip) t.port
- let bprint oc t =
+ let bprint oc t =
Printf.bprintf oc "QUERY SERVERS %s : %d\n" (Ip.to_string t.ip) t.port
-
-
- let write buf t =
+
+ let write buf t =
buf_ip buf t.ip;
buf_port buf t.port
-
+
end
-module QueryServersReply = struct
+module QueryServersReply = struct
type server = {
ip : Ip.t;
port : int;
@@ -977,14 +959,14 @@
server_port : int;
servers: server list;
}
-
- let rec parse_servers nservers s pos =
+
+ let rec parse_servers nservers s pos =
if nservers = 0 then [] else
let ip = get_ip s pos in
let port = get_port s (pos+4) in
{ ip = ip; port = port; } ::
(parse_servers (nservers-1) s (pos+6))
-
+
let parse len s =
try
let ip = get_ip s 1 in
@@ -995,51 +977,51 @@
with _ ->
let nservers = get_uint8 s 1 in
let servers = parse_servers nservers s 2 in
- { server_ip = Ip.null; server_port = 0; servers = servers }
-
- let print t =
+ { server_ip = Ip.null; server_port = 0; servers = servers }
+
+ let print t =
lprintf_nl "SERVERS QUERY REPLY %s : %d" (
Ip.to_string t.server_ip) t.server_port;
- List.iter (fun s ->
- lprintf_nl " %s:%d" (Ip.to_string s.ip) s.port;
+ List.iter (fun s ->
+ lprintf_nl " %s:%d" (Ip.to_string s.ip) s.port;
) t.servers
- let bprint oc t =
- Printf.bprintf oc "SERVERS QUERY REPLY:\n";
+ let bprint oc t =
+ Printf.bprintf oc "SERVERS QUERY REPLY:\n";
Printf.bprintf oc "%s:%d\n" (
Ip.to_string t.server_ip) t.server_port;
- List.iter (fun s ->
- Printf.bprintf oc "%s:%d\n" (Ip.to_string s.ip) s.port;
+ List.iter (fun s ->
+ Printf.bprintf oc "%s:%d\n" (Ip.to_string s.ip) s.port;
) t.servers
-
- let write buf t =
+
+ let write buf t =
if (t.server_port = 0) then
begin
buf_int8 buf (List.length t.servers);
- List.iter (fun s ->
- buf_ip buf s.ip; buf_int16 buf s.port) t.servers
+ List.iter (fun s ->
+ buf_ip buf s.ip; buf_int16 buf s.port) t.servers
end
else
begin
buf_ip buf t.server_ip;
buf_port buf t.server_port;
buf_int8 buf (List.length t.servers);
- List.iter (fun s ->
+ List.iter (fun s ->
buf_ip buf s.ip; buf_int16 buf s.port) t.servers
end
-
+
end
-module Req = struct
- type t
-
+module Req = struct
+ type t
+
let parse len s = raise Not_found
let print t = raise Not_found
let write buf s = raise Not_found
end
-type t =
+type t =
| ConnectReq of Connect.t
| SetIDReq of SetID.t
| AckIDReq of AckID.t
@@ -1064,9 +1046,9 @@
| UnknownReq of string
(****************
- MLdonkey extensions messages
+ MLdonkey extensions messages
***************)
-
+
(* server to client: client has been recognized as
a mldonkey client by a mldonkey server *)
| Mldonkey_MldonkeyUserReplyReq
@@ -1076,14 +1058,14 @@
| Mldonkey_NotificationReq of int * QueryReply.t
(* client to server: the client want to cancel a subscription *)
| Mldonkey_CloseSubscribeReq of int
-
+
let mldonkey_extensions len s =
check_string s 1;
let opcode = int_of_char s.[1] in
- match opcode with
- | 1 ->
+ match opcode with
+ | 1 ->
Mldonkey_MldonkeyUserReplyReq
- | 2 ->
+ | 2 ->
let num = get_int s 2 in
let lifetime = get_int s 6 in
let query, pos = Query.parse_query s 10 in
@@ -1092,23 +1074,23 @@
let num = get_int s 2 in
let files = QueryReply.get_replies s 6 in
Mldonkey_NotificationReq (num, files)
-
+
| 4 ->
let num = get_int s 2 in
Mldonkey_CloseSubscribeReq num
| _ -> raise Not_found
-
+
let rec parse magic s =
- try
+ try
let len = String.length s in
if len = 0 then raise Not_found;
let opcode = int_of_char (s.[0]) in
- match magic with
+ match magic with
227 -> begin
(* lprintf "opcode: %d\n" opcode; *)
- match opcode with
+ match opcode with
| 1 -> ConnectReq (Connect.parse len s)
- | 5 -> BadProtocolVersionReq
+ | 5 -> BadProtocolVersionReq
| 20 -> AckIDReq (AckID.parse len s)
| 21 -> ShareReq (Share.parse len s)
| 22 -> QueryReq (Query.parse len s)
@@ -1143,30 +1125,30 @@
raise Not_found
end
| 0xD4 -> (* 212 *)
-
+
(* lprintf "Compressed Message...\n"; *)
-
+
if Autoconf.has_zlib then
let s = Autoconf.zlib__uncompress_string2 (String.sub s 1 (len-1)) in
- let s = Printf.sprintf "%c%s" (char_of_int opcode) s in
+ let s = Printf.sprintf "%c%s" (char_of_int opcode) s in
parse 227 s
else
failwith "No Zlib to uncompress packet"
- | _ ->
+ | _ ->
failwith (Printf.sprintf "Unkown opcode %d from server\n" opcode)
with
- e ->
+ e ->
if !CommonOptions.verbose_unknown_messages then begin
lprintf_nl "Unknown message From server: %s (magic %d)"
- (Printexc2.to_string e) magic;
+ (Printexc2.to_string e) magic;
let tmp_file = Filename.temp_file "comp" "pak" in
File.from_string tmp_file s;
- lprintf_nl "Saved unknown packet %s" tmp_file;
+ lprintf_nl "Saved unknown packet %s" tmp_file;
dump s;
lprint_newline ();
end;
UnknownReq s
-
+
let print t =
begin
match t with
@@ -1184,7 +1166,7 @@
| QueryLocationReq t
-> QueryLocation.print t
| QueryLocationReplyReq t
- ->
+ ->
QueryLocationReply.print t
| QueryIDReq t -> QueryID.print t
| QueryIDFailedReq t -> QueryIDFailed.print t
@@ -1193,20 +1175,20 @@
| QueryUsersReplyReq t -> QueryUsersReply.print t
| ChatRoomsReq t -> ChatRooms.print t
- | QueryMoreResultsReq ->
- lprintf_nl "QUERY MORE RESULTS";
+ | QueryMoreResultsReq ->
+ lprintf_nl "QUERY MORE RESULTS";
| Mldonkey_MldonkeyUserReplyReq ->
- lprintf_nl "MLDONKEY USER";
- | Mldonkey_SubscribeReq (num, lifetime, t) ->
- lprintf_nl "MLDONKEY SUBSCRIPTION %d FOR %d SECONDS" num lifetime;
-
+ lprintf_nl "MLDONKEY USER";
+ | Mldonkey_SubscribeReq (num, lifetime, t) ->
+ lprintf_nl "MLDONKEY SUBSCRIPTION %d FOR %d SECONDS" num lifetime;
+
Query.print t
| Mldonkey_NotificationReq (num,t) ->
- lprintf_nl "MLDONKEY NOTIFICATIONS TO %d" num;
+ lprintf_nl "MLDONKEY NOTIFICATIONS TO %d" num;
QueryReply.print t
| Mldonkey_CloseSubscribeReq num ->
- lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;
- | UnknownReq s ->
+ lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;
+ | UnknownReq s ->
let len = String.length s in
lprintf_nl "UnknownReq:";
lprintf "ascii: [";
@@ -1223,7 +1205,7 @@
for i = 0 to len - 1 do
let c = s.[i] in
let n = int_of_char c in
- lprintf "(%d)" n
+ lprintf "(%d)" n
done;
lprintf_nl "]";
end;
@@ -1253,20 +1235,20 @@
| QueryUsersReplyReq t -> QueryUsersReply.bprint oc t
| ChatRoomsReq t -> ChatRooms.bprint oc t
- | QueryMoreResultsReq ->
+ | QueryMoreResultsReq ->
Printf.bprintf oc "QUERY MORE RESULTS\n"
| Mldonkey_MldonkeyUserReplyReq ->
Printf.bprintf oc "MLDONKEY USER\n"
- | Mldonkey_SubscribeReq (num, lifetime, t) ->
+ | Mldonkey_SubscribeReq (num, lifetime, t) ->
Printf.bprintf oc "MLDONKEY SUBSCRIBE %d FOR %d SECONDS\n" num
lifetime;
Query.bprint oc t
| Mldonkey_NotificationReq (num,t) ->
- Printf.bprintf oc "MLDONKEY NOTIFICATIONS TO %d\n" num;
+ Printf.bprintf oc "MLDONKEY NOTIFICATIONS TO %d\n" num;
QueryReply.bprint oc t
| Mldonkey_CloseSubscribeReq num ->
lprintf_nl "MLDONKEY CLOSE SUBSCRIPTION %d" num;
-
- | UnknownReq s ->
+
+ | UnknownReq s ->
(* let len = String.length s in*)
Printf.bprintf oc "UnknownReq\n"
(* lprintf "ascii: [";
@@ -1283,62 +1265,62 @@
for i = 0 to len - 1 do
let c = s.[i] in
let n = int_of_char c in
- lprintf "(%d)" n
+ lprintf "(%d)" n
done;
lprintf "]\n";
lprint_newline ()*)
end
-
+
(* Why is this called udp_write ??? It is the normal function to encode
messages
both on UDP and TCP connections !!! *)
-
+
let write buf t =
match t with
- | ConnectReq t ->
+ | ConnectReq t ->
buf_int8 buf 1;
Connect.write buf t
| BadProtocolVersionReq ->
buf_int8 buf 5
- | SetIDReq t ->
+ | SetIDReq t ->
buf_int8 buf 64;
- SetID.write buf t
- | AckIDReq t ->
+ SetID.write buf t
+ | AckIDReq t ->
buf_int8 buf 20;
- AckID.write buf t
- | MessageReq t ->
+ AckID.write buf t
+ | MessageReq t ->
buf_int8 buf 56;
- Message.write buf t
- | ShareReq t ->
+ Message.write buf t
+ | ShareReq t ->
buf_int8 buf 21;
- Share.write buf t
- | InfoReq t ->
+ Share.write buf t
+ | InfoReq t ->
buf_int8 buf 52;
- Info.write buf t
- | ServerListReq t ->
+ Info.write buf t
+ | ServerListReq t ->
buf_int8 buf 50;
- ServerList.write buf t
- | ServerInfoReq t ->
+ ServerList.write buf t
+ | ServerInfoReq t ->
buf_int8 buf 65;
- ServerInfo.write buf t
+ ServerInfo.write buf t
| QueryReplyReq t ->
buf_int8 buf 51;
QueryReply.write buf t
- | QueryReq t ->
+ | QueryReq t ->
buf_int8 buf 22;
Query.write buf t
| QueryLocationReq t ->
buf_int8 buf 25;
QueryLocation.write buf t
- | QueryLocationReplyReq t ->
+ | QueryLocationReplyReq t ->
buf_int8 buf 66;
QueryLocationReply.write buf t
- | QueryIDReq t ->
+ | QueryIDReq t ->
buf_int8 buf 28;
QueryID.write buf t
- | QueryIDReplyReq t ->
+ | QueryIDReplyReq t ->
buf_int8 buf 53;
QueryIDReply.write buf t
- | QueryIDFailedReq t ->
+ | QueryIDFailedReq t ->
buf_int8 buf 54;
QueryIDFailed.write buf t
| ChatRoomsReq t ->
@@ -1346,23 +1328,23 @@
ChatRooms.write buf t
| UnknownReq s ->
Buffer.add_string buf s
- | QueryUsersReq t ->
+ | QueryUsersReq t ->
buf_int8 buf 26;
QueryUsers.write buf t
- | QueryUsersReplyReq t ->
+ | QueryUsersReplyReq t ->
buf_int8 buf 67;
QueryUsersReply.write buf t
| QueryMoreResultsReq ->
buf_int8 buf 33
-
+
(**************
mldonkey extensions to the protocol
**************)
-
+
| Mldonkey_MldonkeyUserReplyReq ->
buf_int8 buf 250; (* MLdonkey extensions opcode *)
buf_int8 buf 1
-
+
| Mldonkey_SubscribeReq (num, lifetime, t) ->
buf_int8 buf 250; (* MLdonkey extensions opcode *)
buf_int8 buf 2;
@@ -1374,7 +1356,7 @@
buf_int8 buf 250; (* MLdonkey extensions opcode *)
buf_int8 buf 4;
buf_int buf num;
-
+
| Mldonkey_NotificationReq (num,t) ->
buf_int8 buf 250; (* MLdonkey extensions opcode *)
buf_int8 buf 3;
- [Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyProtoServer.ml,
mldonkey-commits <=