/[mldonkey]/mldonkey/src/networks/donkey/donkeyProtoCom.ml
ViewVC logotype

Diff of /mldonkey/src/networks/donkey/donkeyProtoCom.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19 by spiralvoice, Sun Jul 17 16:12:59 2005 UTC revision 1.20 by spiralvoice, Fri Jul 22 10:58:55 2005 UTC
# Line 18  Line 18 
18  *)  *)
19  open Options  open Options
20  open Printf2  open Printf2
21      
22  open BasicSocket  open BasicSocket
23  open TcpBufferedSocket    open TcpBufferedSocket
24      
25  open AnyEndian  open AnyEndian
26  open LittleEndian  open LittleEndian
27    
28  open CommonOptions    open CommonOptions
29  open CommonTypes  open CommonTypes
30  open CommonGlobals  open CommonGlobals
31  open CommonFile  open CommonFile
32  open CommonGlobals    open CommonGlobals
33      
34  open DonkeyOptions  open DonkeyOptions
35  open DonkeyGlobals  open DonkeyGlobals
36  open DonkeyTypes  open DonkeyTypes
37  open DonkeyMftp  open DonkeyMftp
38      
39    let lprintf_nl () =
40      lprintf "%s[EDK]: "
41        (log_time ()); lprintf_nl2
42    
43    let lprintf_n () =
44      lprintf "%s[EDK]: "
45        (log_time ()); lprintf
46    
47  let buf = TcpBufferedSocket.internal_buf  let buf = TcpBufferedSocket.internal_buf
     
48    
           
49  let client_msg_to_string emule_version msg =  let client_msg_to_string emule_version msg =
50    Buffer.clear buf;    Buffer.clear buf;
51    buf_int8 buf 0;    buf_int8 buf 0;
# Line 50  let client_msg_to_string emule_version m Line 56  let client_msg_to_string emule_version m
56    s.[0] <- char_of_int magic;    s.[0] <- char_of_int magic;
57    str_int s 1 len;    str_int s 1 len;
58    s    s
59      
60  let server_msg_to_string msg =  let server_msg_to_string msg =
61    Buffer.clear buf;    Buffer.clear buf;
62    buf_int8 buf 227;    buf_int8 buf 227;
63    buf_int buf 0;    buf_int buf 0;
64    DonkeyProtoServer.write buf msg;    DonkeyProtoServer.write buf msg;
65      
     
66    if !verbose_msg_servers then begin    if !verbose_msg_servers then begin
67        lprintf_nl "MESSAGE TO SERVER:";          lprintf_nl () "MESSAGE TO SERVER:";
68        DonkeyProtoServer.print msg;        DonkeyProtoServer.print msg;
69        lprintf_nl "";        lprint_newline ();
70      end;      end;
71    
72    let s = Buffer.contents buf in    let s = Buffer.contents buf in
# Line 78  let server_send sock m = Line 83  let server_send sock m =
83    
84  let direct_client_sock_send emule_version sock m =  let direct_client_sock_send emule_version sock m =
85    write_string sock (client_msg_to_string emule_version m)    write_string sock (client_msg_to_string emule_version m)
86      
87  let client_send c m =  let client_send c m =
88    let emule_version = c.client_emule_proto in    let emule_version = c.client_emule_proto in
89    if !verbose_msg_clients || c.client_debug then begin    if !verbose_msg_clients || c.client_debug then begin
90        CommonGlobals.print_localtime ();        lprintf_n () "Sent to client[%d] %s(%s)" (client_num c)
       lprintf "Sent to client[%d] %s(%s)" (client_num c)  
91          c.client_name (brand_to_string c.client_brand);          c.client_name (brand_to_string c.client_brand);
92        (match c.client_kind with        (match c.client_kind with
93            Indirect_address _ | Invalid_address _ -> ()            Indirect_address _ | Invalid_address _ -> ()
94          | Direct_address (ip,port) ->          | Direct_address (ip,port) ->
95              lprintf " [%s:%d]" (Ip.to_string ip) port;              lprintf_nl2 " [%s:%d]" (Ip.to_string ip) port;
96                
97        );        );
98        DonkeyProtoClient.print m;        DonkeyProtoClient.print m;
99        lprintf_nl "";        lprint_newline ();
100      end;      end;
101    do_if_connected c.client_source.DonkeySources.source_sock (fun sock ->    do_if_connected c.client_source.DonkeySources.source_sock (fun sock ->
102        direct_client_sock_send emule_version sock m)        direct_client_sock_send emule_version sock m)
# Line 109  let emule_send sock m = Line 113  let emule_send sock m =
113      *)      *)
114    
115  (* let client_msg_to_string m = client_msg_to_string 227 m *)  (* let client_msg_to_string m = client_msg_to_string 227 m *)
116      
117  let servers_send socks m =  let servers_send socks m =
118    let m = server_msg_to_string m in    let m = server_msg_to_string m in
119    List.iter (fun s -> write_string s m) socks    List.iter (fun s -> write_string s m) socks
120      
         
121  let client_handler2 c ff f =  let client_handler2 c ff f =
122    let emule_version = match !c with    let emule_version = match !c with
123        None -> emule_proto ();        None -> emule_proto ();
# Line 123  let client_handler2 c ff f = Line 126  let client_handler2 c ff f =
126    let msgs = ref 0 in    let msgs = ref 0 in
127    fun sock nread ->    fun sock nread ->
128    
129      if !verbose then lprintf_nl "[DK]: between clients %d" nread;      if !verbose then lprintf_nl () "between clients %d" nread;
130      let module M= DonkeyProtoClient in      let module M= DonkeyProtoClient in
131      let b = TcpBufferedSocket.buf sock in      let b = TcpBufferedSocket.buf sock in
132      try      try
# Line 132  let client_handler2 c ff f = Line 135  let client_handler2 c ff f =
135          let msg_len = get_int b.buf (b.pos+1) in          let msg_len = get_int b.buf (b.pos+1) in
136          if b.len >= 5 + msg_len then          if b.len >= 5 + msg_len then
137            begin            begin
138              if !verbose then lprintf_nl "[DK]: client_to_client";              if !verbose then lprintf_nl () "client_to_client";
139              let s = String.sub b.buf (b.pos+5) msg_len in              let s = String.sub b.buf (b.pos+5) msg_len in
140              buf_used b  (msg_len + 5);              buf_used b  (msg_len + 5);
141              let t = M.parse emule_version opcode s in              let t = M.parse emule_version opcode s in
142  (*          M.print t;    (*          M.print t;
143  lprint_newline (); *)  lprint_newline (); *)
144              incr msgs;              incr msgs;
145              match !c with              match !c with
146                None ->                None ->
147                  c := ff t sock                  c := ff t sock
148              | Some c -> f c t sock              | Some c -> f c t sock
149            end            end
150          else raise Not_found          else raise Not_found
151        done        done
152      with Not_found -> ()      with Not_found -> ()
153      
154  let cut_messages parse f sock nread =  let cut_messages parse f sock nread =
155    if !verbose then lprintf_nl "[DK]: server to client %d" nread;    if !verbose then lprintf_nl () "server to client %d" nread;
156    let b = TcpBufferedSocket.buf sock in    let b = TcpBufferedSocket.buf sock in
157    try    try
158      while b.len >= 5 do      while b.len >= 5 do
# Line 157  let cut_messages parse f sock nread = Line 160  let cut_messages parse f sock nread =
160        let msg_len = get_int b.buf (b.pos+1) in        let msg_len = get_int b.buf (b.pos+1) in
161        if b.len >= 5 + msg_len then        if b.len >= 5 + msg_len then
162          begin          begin
163            if !verbose then lprintf_nl "[DK]: server_to_client";            if !verbose then lprintf_nl () "server_to_client";
164            let s = String.sub b.buf (b.pos+5) msg_len in            let s = String.sub b.buf (b.pos+5) msg_len in
165            buf_used b (msg_len + 5);            buf_used b (msg_len + 5);
166            let t = parse opcode s in            let t = parse opcode s in
# Line 168  let cut_messages parse f sock nread = Line 171  let cut_messages parse f sock nread =
171    with Not_found -> ()    with Not_found -> ()
172    
173  let udp_send t ip port msg =  let udp_send t ip port msg =
174      
175    if !verbose_udp then begin    if !verbose_udp then begin
176        lprintf_nl "[DK]: Message UDP to %s:%d\n%s" (Ip.to_string ip) port        lprintf_nl () "Message UDP to %s:%d\n%s" (Ip.to_string ip) port
177          (DonkeyProtoUdp.print msg);          (DonkeyProtoUdp.print msg);
178      end;      end;
179      
180    try    try
181      Buffer.clear buf;      Buffer.clear buf;
182      DonkeyProtoUdp.write buf msg;      DonkeyProtoUdp.write buf msg;
183      let s = Buffer.contents buf in      let s = Buffer.contents buf in
184      UdpSocket.write t false s ip port      UdpSocket.write t false s ip port
185    with e ->    with e ->
186        lprintf_nl "[DK]: Exception %s in udp_send" (Printexc2.to_string e)        lprintf_nl () "Exception %s in udp_send" (Printexc2.to_string e)
187          
188  let udp_handler f sock event =  let udp_handler f sock event =
189    let module M = DonkeyProtoUdp in    let module M = DonkeyProtoUdp in
190    match event with    match event with
191      UdpSocket.READ_DONE ->      UdpSocket.READ_DONE ->
192        UdpSocket.read_packets sock (fun p ->        UdpSocket.read_packets sock (fun p ->
193            try            try
194              let pbuf = p.UdpSocket.udp_content in              let pbuf = p.UdpSocket.udp_content in
195              let len = String.length pbuf in              let len = String.length pbuf in
# Line 198  let udp_handler f sock event = Line 201  let udp_handler f sock event =
201            with e -> ()            with e -> ()
202        ) ;        ) ;
203    | _ -> ()    | _ -> ()
204        
205  let udp_basic_handler f sock event =  let udp_basic_handler f sock event =
206    match event with    match event with
207      UdpSocket.READ_DONE ->      UdpSocket.READ_DONE ->
208        UdpSocket.read_packets sock (fun p ->        UdpSocket.read_packets sock (fun p ->
209            try            try
210              let pbuf = p.UdpSocket.udp_content in              let pbuf = p.UdpSocket.udp_content in
211              let len = String.length pbuf in              let len = String.length pbuf in
212              if len = 0 ||              if len = 0 ||
213                int_of_char pbuf.[0] <> DonkeyOpenProtocol.udp_magic then begin                int_of_char pbuf.[0] <> DonkeyOpenProtocol.udp_magic then begin
214                  if !verbose_unknown_messages then begin                  if !verbose_unknown_messages then begin
215                      lprintf_nl "[DK]: Received unknown UDP packet";                      lprintf_nl () "Received unknown UDP packet";
216                      dump pbuf;                      dump pbuf;
217                    end;                    end;
218                end else begin                end else begin
# Line 217  let udp_basic_handler f sock event = Line 220  let udp_basic_handler f sock event =
220                  f t p                  f t p
221                end                end
222            with e ->            with e ->
223                lprintf_nl "[DK]: Error %s in udp_basic_handler"                lprintf_nl () "Error %s in udp_basic_handler"
224                  (Printexc2.to_string e)                  (Printexc2.to_string e)
225        ) ;        ) ;
226    | _ -> ()    | _ -> ()
# Line 225  let udp_basic_handler f sock event = Line 228  let udp_basic_handler f sock event =
228    
229  let new_string msg s =  let new_string msg s =
230    let len = String.length s - 5 in    let len = String.length s - 5 in
231    str_int s 1 len      str_int s 1 len
232      
233  let empty_string = ""  let empty_string = ""
234      
235  let tag_file file =  let tag_file file =
236    (string_tag Field_Filename    (string_tag Field_Filename
237      (      (
# Line 236  let tag_file file = Line 239  let tag_file file =
239        let name = if String2.starts_with name "hidden." then        let name = if String2.starts_with name "hidden." then
240            String.sub name 7 (String.length name - 7)            String.sub name 7 (String.length name - 7)
241          else name in          else name in
242        if !verbose then lprintf_nl "[DK]: SHARING %s" name;        if !verbose then lprintf_nl () "Sharing %s" name;
243        name        name
244      ))::      ))::
245    (int64_tag Field_Size file.file_file.impl_file_size) ::    (int64_tag Field_Size file.file_file.impl_file_size) ::
# Line 245  let tag_file file = Line 248  let tag_file file =
248          FormatNotComputed next_time when          FormatNotComputed next_time when
249          next_time < last_time () ->          next_time < last_time () ->
250            (try            (try
251                if !verbose then lprintf_nl "%s: FIND FORMAT %s"                if !verbose then lprintf_nl () "%s: Find format %s"
252                      (string_of_date (last_time ()))                      (string_of_date (last_time ()))
253                    (file_disk_name file);                    (file_disk_name file);
254                file.file_format <- (                file.file_format <- (
255                  match                  match
256                  CommonMultimedia.get_info                  CommonMultimedia.get_info
257                      (file_disk_name file)                      (file_disk_name file)
258                  with                  with
259                    FormatUnknown -> FormatNotComputed (last_time () + 300)                    FormatUnknown -> FormatNotComputed (last_time () + 300)
# Line 258  let tag_file file = Line 261  let tag_file file =
261              with _ -> ())              with _ -> ())
262        | _ -> ()        | _ -> ()
263      );      );
264        
265      match file.file_format with      match file.file_format with
266        FormatNotComputed _ | FormatUnknown -> []        FormatNotComputed _ | FormatUnknown -> []
267      | AVI _ ->      | AVI _ ->
# Line 298  let tag_file file = Line 301  let tag_file file =
301            { tag_name = Field_Type; tag_value = String kind };            { tag_name = Field_Type; tag_value = String kind };
302            { tag_name = Field_Format; tag_value = String format };            { tag_name = Field_Format; tag_value = String format };
303          ]          ]
304    )            )
305    
306  (* Computes tags for shared files (for clients) *)  (* Computes tags for shared files (for clients) *)
307  let make_tagged sock files =  let make_tagged sock files =
308    (List2.tail_map (fun file ->    (List2.tail_map (fun file ->
309        {        {
310          f_md4 = file.file_md4;          f_md4 = file.file_md4;
311          f_ip = client_ip sock;          f_ip = client_ip sock;
312          f_port = !!donkey_port;          f_port = !!donkey_port;
# Line 327  let make_tagged_server newer_server sock Line 330  let make_tagged_server newer_server sock
330        ) files)        ) files)
331    else    else
332      make_tagged sock files      make_tagged sock files
333      
334  let server_send_share compressed sock msg =  let server_send_share compressed sock msg =
335    if !verbose then    if !verbose then
336        lprintf_nl "[DK]: Sending %d file(s) to server" (List.length msg);        lprintf_nl () "Sending %d file(s) to server" (List.length msg);
337    let max_len =    let max_len =
338      !!client_buffer_size - 100      !!client_buffer_size - 100
339        - TcpBufferedSocket.remaining_to_write sock        - TcpBufferedSocket.remaining_to_write sock
# Line 347  let server_send_share compressed sock ms Line 350  let server_send_share compressed sock ms
350        str_int s 0 nfiles;        str_int s 0 nfiles;
351        let s = String.sub s 0 prev_len in        let s = String.sub s 0 prev_len in
352        if !verbose_share then        if !verbose_share then
353           lprintf "[DK]: Sending %d share(s) to server : " nfiles;           lprintf_nl () "Sending %d share(s) to server : " nfiles;
354        Buffer.clear buf;        Buffer.clear buf;
355        let s_c =        let s_c =
356          if compressed && Autoconf.has_zlib then          if compressed && Autoconf.has_zlib then
# Line 360  let server_send_share compressed sock ms Line 363  let server_send_share compressed sock ms
363        if compressed && ((String.length s_c) < (String.length s))  then        if compressed && ((String.length s_c) < (String.length s))  then
364          begin          begin
365            if !verbose_share then            if !verbose_share then
366              lprintf_nl "Using zlib";              lprintf_nl () "Using zlib";
367            buf_int8 buf 0xD4;            buf_int8 buf 0xD4;
368            buf_int buf 0;            buf_int buf 0;
369            buf_int8 buf 21; (* ShareReq *)            buf_int8 buf 21; (* ShareReq *)
370            Buffer.add_string buf s_c;            Buffer.add_string buf s_c;
371            Buffer.contents buf            Buffer.contents buf
372          end          end
373        else        else
374          begin          begin
375            if !verbose_share then            if !verbose_share then
376              lprintf_nl "No compression";              lprintf_nl () "No compression";
377            buf_int8 buf 227;            buf_int8 buf 227;
378            buf_int buf 0;            buf_int buf 0;
379            buf_int8 buf 21; (* ShareReq *)            buf_int8 buf 21; (* ShareReq *)
# Line 381  let server_send_share compressed sock ms Line 384  let server_send_share compressed sock ms
384    let len = String.length s - 5 in    let len = String.length s - 5 in
385    str_int s 1 len;    str_int s 1 len;
386    write_string sock s    write_string sock s
387      
388  let client_send_files sock msg =  let client_send_files sock msg =
389    let max_len = !!client_buffer_size - 100 -    let max_len = !!client_buffer_size - 100 -
390      TcpBufferedSocket.remaining_to_write sock in      TcpBufferedSocket.remaining_to_write sock in
391    Buffer.clear buf;    Buffer.clear buf;
392    buf_int8 buf 227;    buf_int8 buf 227;
# Line 400  let client_send_files sock msg = Line 403  let client_send_files sock msg =
403    str_int s 6 nfiles;    str_int s 6 nfiles;
404    write_string sock s    write_string sock s
405    
     
406  let udp_server_send s t =  let udp_server_send s t =
407    udp_send (get_udp_sock ()) s.server_ip (s.server_port+4)  t    udp_send (get_udp_sock ()) s.server_ip (s.server_port+4) t

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26