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
25 open TcpBufferedSocket
31 let output_int32_8 oc i
=
32 output_char oc
(char_of_int
(Int64.to_int
(Int64.logand i
255L)))
34 let output_int32_32 oc i
=
36 output_int32_8 oc
(right64 i
8);
37 output_int32_8 oc
(right64 i
16);
38 output_int32_8 oc
(right64 i
24)
40 let output_int8 oc i
=
41 output_char oc
(char_of_int
(i
land 255))
45 output_int8 oc
(i
lsr 8);
46 output_int8 oc
(i
lsr 16);
47 output_int8 oc
(i
lsr 24)
51 buf_int32_32 buf (Int32.of_int int)
54 let rec rev_assoc x
= function
56 | (b
,a
)::l
-> if a
= x
then b
else rev_assoc x l
58 let buf_string buf s
=
59 buf_int16 buf
(String.length s
);
60 Buffer.add_string buf s
62 let buf_port buf port
=
66 let buf_addr buf
(ip
,port
) =
70 let buf_tag buf tag names_of_tag
=
71 let name = try rev_assoc tag
.tag_name names_of_tag
72 with _
-> string_of_field tag
.tag_name
75 let i = rev_assoc name names_of_tag in
76 String.make 1 (char_of_int i)
78 match tag
.tag_value
with
87 | Addr ip
-> assert false
98 | Pair _
-> assert false
100 let rec buf_tags buf tags names_of_tag
=
101 buf_int buf
(List.length tags
);
102 let rec iter_tags tags
=
106 buf_tag buf tag names_of_tag
;
112 Int64.of_int
(int_of_char
(input_char ic
))
114 let read_uint64_32 ic
=
115 let a0 = read_uint8 ic
in
116 let a1 = read_uint8 ic
in
117 let a2 = read_uint8 ic
in
118 let a3 = read_uint8 ic
in
119 a0 ++ (left64
a1 8) ++ (left64
a2 16) ++ (left64
a3 24)
121 let read_request ic
=
122 let c = int_of_char
(input_char ic
) in
124 let len32 = read_uint64_32 ic
in
125 let len = Int64.to_int
len32 in
126 let s = String.create
len in
127 really_input ic
s 0 len;
129 lprintf "read_request %d [%s]" len (String.escaped s);
134 let output_request oc
s =
135 output_char oc
(char_of_int
227);
136 let len = String.length
s in
138 lprintf "output_request %d [%s]" len (String.escaped s);
147 let get_string = get_string16
149 let get_tag (names_of_tag
: (string * field
) list
) s pos
=
150 let t2 = get_uint8
s pos
in
152 if t2 land 0x80 = 0x80 then
153 String.sub
s (pos
+1) 1, pos
+2
157 (* lprintf "tag name = %s" (String.escaped name); *)
158 let t = t2 land 0x7f in
159 let v, pos
= match t with
160 | 2 -> let v, pos
= get_string s pos2
in
162 | 1|3 -> let v = get_uint64_32
s pos2
in
164 | 4 -> let v = get_uint64_32
s pos2
in
166 | 8 -> let v = get_int16
s pos2
in
168 | 9 -> let v = get_uint8
s pos2
in
170 | _
when t >= 0x11 & t <= 0x20 -> let v = String.sub
s pos2
(t-0x10) in
171 String
v, pos2
+ t - 0x10
173 if !verbose_unknown_messages
then
174 lprintf
"get_tags: unknown tag %d at pos %d\n" t pos
;
179 List.assoc
name names_of_tag
181 (* lprintf "Unknown tag \"%s\"\n" (String.escaped name); *)
182 match field_of_string
name with
183 | Field_KNOWN
s -> Field_UNKNOWN
s
188 let get_tags s pos names_of_tag
=
189 let rec iter_tags ntags pos tags
=
190 if ntags
= 0 then List.rev tags
, pos
else
191 let tag, pos
= get_tag names_of_tag
s pos
in
192 iter_tags (ntags
-1) pos
(tag :: tags
)
194 iter_tags (get_int
s pos
) (pos
+4) []
197 let ip = get_ip
s pos
in
198 let port = get_port s (pos
+4) in
201 module type Request
= sig
203 val parse
: int -> string -> t
205 val write
: Buffer.t -> t -> unit
208 let file_common_tags = [
209 "\001", Field_Filename
;
212 "\004", Field_Format
;
213 "\005", Field_Lastseencomplete
;
214 "\021", Field_Availability
;
215 "\048", Field_Completesources
;
216 "\058", Field_Size_Hi
;
217 "\208", Field_Artist
;
220 "\211", Field_Medialength
;
221 "\212", Field_Bitrate
;
222 "\213", Field_Mediacodec
;
223 "\247", Field_Filerating
;
225 "Artist", Field_Artist
;
226 "Album", Field_Album
;
227 "Title", Field_Title
;
230 let client_common_tags =
236 "\032", "compression";
239 "\035", "sourceexchange";
241 "\037", "extendedrequest";
242 "\038", "compatibleclient";
245 "\060", "downloadtime";
246 "\061", "incompleteparts";
249 "\065", "mod_unknown41";
250 "\066", "mod_unknown42";
251 "\067", "mod_unknown43";
252 "\078", "neo_features";
253 "\084", "mod_featureset";
254 "\085", "mod_version";
255 "\086", "mod_protocol";
256 "\090", "mod_bowlfish";
257 "\092", "mod_secure_community";
258 "\093", "mod_unknown0x5d";
259 "\096", "mod_unknown0x60";
260 "\100", "mod_unknown0x64";
261 "\102", "mod_fusion";
262 "\103", "mod_fusion_version";
264 (* http://forums.shareaza.com/showthread.php?threadid=37323&perpage=15&pagenumber=2 *)
265 "\105", "edonkeyclc serverip?";
266 "\106", "edonkeyclc serverport?";
268 "\108", "mod_unknown0x6c";
269 "\117", "mod_unknown0x75"; (* http://emule-project.net @ NewMule *)
270 "\118", "mod_unknown0x76";
272 "\120", "mod_tarod_version";
274 "\128", "mod_morph_version";
275 "\130", "mod_mortillo";
276 "\131", "mod_mortillo_version";
277 "\132", "chanblard_version";
281 "\136", "mod_lsd_version";
282 "\144", "mod_lovelace_version";
283 "\148", "os_info"; (* reused by aMule to transfer client OS type *)
285 "\160", "mod_wombat";
286 "\161", "dev_wombat";
287 "\170", "koizo"; (* http://sourceforge.net/projects/koizo *)
288 "\205", "mod_unknown0xcd";
289 "\224", "isp_bypass";
290 "\225", "nat_tunneling";
291 "\239", "emule_compatoptions";
292 "\240", "nat_security";
293 "\249", "emule_udpports";
294 "\250", "emule_miscoptions1";
295 "\251", "emule_version";
298 "\254", "emule_miscoptions2";
299 "pr", "edonkeyclc horde";
300 "wombia", "wombat a";
301 "wombib", "wombat b";