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
26 open TcpBufferedSocket
34 open CommonComplexOptions
41 open DonkeyProtoClient
51 packets_in
: Buffer.t
;
52 packets_out
: Buffer.t
;
56 client_proto
: emule_proto
;
57 mutable client_comp
: compressed_parts
option;
60 let extendedrequest e
= e
.emule_extendedrequest
62 let connections = Hashtbl.create
13
63 let udp_packets = ref []
65 let first_message parse b
=
67 let len = String.length b
in
68 if len - !pos >= 5 then
69 let opcode = get_uint8 b
!pos in
70 let msg_len = get_int b
(!pos+1) in
71 if len - !pos >= 5 + msg_len then
73 let s = String.sub b
(!pos+5) msg_len in
74 pos := !pos + msg_len + 5;
81 let cut_messages parse b
=
83 let len = String.length b
in
85 while len - !pos >= 5 do
86 let opcode = get_uint8 b
!pos in
87 let msg_len = get_int b
(!pos+1) in
88 if len - !pos >= 5 + msg_len then
90 let s = String.sub b
(!pos+5) msg_len in
91 pos := !pos + msg_len + 5;
98 let update_emule_proto_from_tags e tags
=
100 match tag
.tag_name
with
101 | Field_KNOWN
"compression" ->
102 for_int_tag tag
(fun i
->
103 e
.emule_compression
<- i
)
104 | Field_KNOWN
"udpver" ->
105 for_int_tag tag
(fun i
->
107 | Field_KNOWN
"udpport" -> ()
108 | Field_KNOWN
"sourceexchange" ->
109 for_int_tag tag
(fun i
->
110 e
.emule_sourceexchange
<- i
)
111 | Field_KNOWN
"comments" ->
112 for_int_tag tag
(fun i
->
113 e
.emule_comments
<- i
)
114 | Field_KNOWN
"extendedrequest" ->
115 for_int_tag tag
(fun i
->
116 e
.emule_extendedrequest
<- i
)
117 | Field_KNOWN
"features" ->
118 for_int_tag tag
(fun i
->
119 e
.emule_secident
<- i
land 0x3)
121 if !verbose_msg_clients
then
122 lprintf
"Unknown Emule tag: [%s]\n" (string_of_field
s)
125 let client_parse c
opcode s =
126 let emule = c
.client_proto
in
127 if extendedrequest emule >= 0 then begin
128 let module P
= DonkeyProtoClient
in
129 let t = P.parse
emule opcode s in
131 P.EmuleClientInfoReq info
132 | P.EmuleClientInfoReplyReq info
->
133 let tags = info
.P.EmuleClientInfo.tags in
134 update_emule_proto_from_tags emule tags;
136 | P.ConnectReq
{ P.Connect.tags = tags }
137 | P.ConnectReplyReq
{ P.Connect.tags = tags } ->
141 let options = find_tag
(Field_KNOWN
"emule_miscoptions1") tags in
144 | Uint64 v
| Fint64 v
->
145 update_emule_proto_from_miscoptions1
emule v
147 lprintf
"CANNOT INTERPRETE EMULE OPTIONS\n"
150 let options2 = find_tag
(Field_KNOWN
"emule_miscoptions2") tags in
153 | Uint64 v
| Fint64 v
->
154 update_emule_proto_from_miscoptions2
emule v
156 lprintf
"CANNOT INTERPRETE EMULE OPTIONS2\n"
162 | P.UnknownReq
(227,_
) ->
163 emule.emule_extendedrequest
<- -1
165 | P.EmuleCompressedPart
t ->
167 let comp = match c
.client_comp
with
170 comp_md4
= t.EmuleCompressedPart.md4
;
171 comp_pos
= t.EmuleCompressedPart.statpos
;
172 comp_total
= Int64.to_int
t.EmuleCompressedPart.newsize
;
176 c
.client_comp
<- Some
comp;
180 comp.comp_blocs
<- t.EmuleCompressedPart.bloc
:: comp.comp_blocs
;
181 comp.comp_len
<- comp.comp_len
+ String.length
t.EmuleCompressedPart.bloc
;
183 (* lprintf "Comp bloc: %d/%d\n" comp.comp_len comp.comp_total; *)
184 if comp.comp_len
= comp.comp_total
then begin
185 lprintf
"Compressed bloc received !!!!!!\n";
187 let s = String.create
comp.comp_len
in
192 let pos = iter tail
in
193 let len = String.length b
in
194 String.blit b
0 s pos len;
197 let pos = iter comp.comp_blocs
in
198 assert (pos = comp.comp_len
);
199 let s = Zlib.uncompress_string2
s in
200 lprintf
"Decompressed: %d/%d\n" (String.length
s) comp.comp_len
;
202 c
.client_comp
<- None
;
204 if comp.comp_len
> comp.comp_total
then begin
205 lprintf
"ERROR: more data than compressed!!!\n";
206 c
.client_comp
<- None
;
210 P.print
t; lprintf
"\n";
213 let b = Buffer.create
100 in
214 let _ = DonkeyProtoClient.write
emule b t in
215 let ss = Buffer.contents
b in
216 if ss <> s then begin
217 if opcode = 212 then begin
218 let tt = P.parse
emule 0xc5 ss in
219 if t <> tt then begin
220 lprintf
"======= Parsing/Unparsing differs!!\n";
222 lprintf
"\n---------->\n";
226 lprintf
"<---------- %d \n" (String.length
ss) ;
228 lprintf
"=========== %d %d\n" opcode (String.length
s);
230 lprintf
"---------->\n";
234 if extendedrequest emule < 0 then
235 let module P
= DonkeyProtoServer
in
236 let t = P.parse
opcode s in
237 P.print
t; print_newline
();
239 P.UnknownReq
_ -> emule.emule_extendedrequest
<- 100
245 Unix2.tryopen_write
"trace.out" (fun oc
-> output_value oc
connections)
247 exception ServerConnection
251 Unix2.tryopen_read
"trace.out" (fun ic
-> input_value ic
) in
253 mldonkey_emule_proto
.emule_sourceexchange
<- 5;
255 Hashtbl.iter (fun _ cnx
->
258 let emule = { dummy_emule_proto
with
260 emule_extendedrequest
= 2; } in
263 client_proto
= emule;
267 let buffer = Buffer.contents cnx
.packets_in
in
269 let module D
= DonkeyProtoClient
in
270 let t = first_message
271 (D.parse
emule) buffer in
273 | D.EmuleClientInfoReplyReq
_
274 | D.EmuleClientInfoReq
_
276 | D.ConnectReplyReq
_ ->
277 lprintf
"CLIENT CONNECTION\n"
280 D.print
t; print_newline
();
281 raise ServerConnection
284 D.print
t; print_newline
();
285 lprintf
"COULD NOT RECOGNIZE CONNECTION\n"
288 | ServerConnection
->
289 lprintf
"PROBABLY A SERVER CONNECTION\n"
291 lprintf
"EMPTY CONNECTION (%d)\n" (String.length
buffer)
294 lprintf
"CONNECTION %s:%d --> %s:%d"
295 cnx
.ip1 cnx
.port1 cnx
.ip2 cnx
.port2
; print_newline
();
296 lprintf
" INCOMING:\n";
297 cut_messages (client_parse c) buffer;
298 lprintf
" OUTGOING:\n";
299 cut_messages (client_parse c)
300 (Buffer.contents cnx
.packets_out
);
304 lprintf
"Exception %s\n" (Printexc2.to_string e
)
307 let new_packet (kind
:t) (number
:int) ip1 port1 ip2 port2 data
=
312 udp_packets := (ip1
,port1
,ip2
,port2
,data
) :: !udp_packets;
313 (* lprintf "New packet:\n%s\n" (String.escaped data); *)
316 (* lprintf "Could not parse UDP packet:\n"; *)
320 let out_packet = (ip1
, port1
, ip2
, port2
) in
321 let in_packet = (ip2
, port2
, ip1
, port1
) in
324 let cnx = Hashtbl.find
connections out_packet in
325 Buffer.add_string
cnx.packets_out data
;
329 let cnx = Hashtbl.find
connections in_packet in
330 Buffer.add_string
cnx.packets_in data
337 packets_out
= Buffer.create
100;
338 packets_in
= Buffer.create
100;
340 Hashtbl.add
connections out_packet cnx;
341 Buffer.add_string
cnx.packets_out data