/[mldonkey]/mldonkey/src/networks/fasttrack/fasttrackProtocol.ml
ViewVC logotype

Diff of /mldonkey/src/networks/fasttrack/fasttrackProtocol.ml

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

revision 1.7 by mldonkey, Mon Nov 1 11:23:01 2004 UTC revision 1.8 by spiralvoice, Sun Aug 7 12:57:22 2005 UTC
# Line 31  open CommonTypes Line 31  open CommonTypes
31  open CommonOptions  open CommonOptions
32  open CommonGlobals  open CommonGlobals
33  open CommonShared  open CommonShared
34      
35  open FasttrackNetwork  open FasttrackNetwork
36  open FasttrackOptions  open FasttrackOptions
37  open FasttrackTypes  open FasttrackTypes
38  open FasttrackGlobals  open FasttrackGlobals
39    
40  let set_fasttrack_sock sock info ghandler =  let set_fasttrack_sock sock info ghandler =
41    let gconn = {    let gconn = {
42        gconn_file_info_sent = [];        gconn_file_info_sent = [];
43        gconn_client_info_sent = false;        gconn_client_info_sent = false;
# Line 56  let set_fasttrack_sock sock info ghandle Line 56  let set_fasttrack_sock sock info ghandle
56      fun sock ->      fun sock ->
57        match gconn.gconn_refill with        match gconn.gconn_refill with
58          [] -> ()          [] -> ()
59        | _ :: tail ->        | _ :: tail ->
60            gconn.gconn_refill <- tail;            gconn.gconn_refill <- tail;
61            match tail with            match tail with
62              [] ->              [] ->
63                if gconn.gconn_close_on_write then                if gconn.gconn_close_on_write then
64                  set_lifetime sock 30.                  set_lifetime sock 30.
65  (*                TcpBufferedSocket.close sock "write done" *)  (*                TcpBufferedSocket.close sock "write done" *)
66            | refill :: _ -> refill sock)            | refill :: _ -> refill sock)
67    
     
68  let udp_handler f sock event =  let udp_handler f sock event =
69    match event with    match event with
70      UdpSocket.READ_DONE ->      UdpSocket.READ_DONE ->
71        UdpSocket.read_packets sock (fun p ->        UdpSocket.read_packets sock (fun p ->
72            try            try
73              let pbuf = p.UdpSocket.udp_content in              let pbuf = p.UdpSocket.udp_content in
74              let len = String.length pbuf in              let len = String.length pbuf in
75              f p              f p
76            with e ->            with e ->
77                lprintf "Error %s in udp_handler\n"                lprintf "Error %s in udp_handler\n"
78                  (Printexc2.to_string e);                  (Printexc2.to_string e);
79        ) ;        ) ;
80    | _ -> ()    | _ -> ()
81    
# Line 86  let len5 = Int64.of_int (128*128*128*128 Line 85  let len5 = Int64.of_int (128*128*128*128
85  let len4 = Int64.of_int (128*128*128)  let len4 = Int64.of_int (128*128*128)
86  let len3 = Int64.of_int (128*128)  let len3 = Int64.of_int (128*128)
87  let len2 = Int64.of_int (128)  let len2 = Int64.of_int (128)
88      
89  let int64_7f = Int64.of_int 0x7f  let int64_7f = Int64.of_int 0x7f
90  let int64_80 = Int64.of_int 0x80  let int64_80 = Int64.of_int 0x80
91    
# Line 101  let rec iter len n = Line 100  let rec iter len n =
100    let s = String.create (len+1) in    let s = String.create (len+1) in
101    s.[len] <- char_of_int (Int64.to_int n);    s.[len] <- char_of_int (Int64.to_int n);
102    s    s
103      
104  let buf_dynint b data =  let buf_dynint b data =
105    let data = Int64.logand bits32 data in    let data = Int64.logand bits32 data in
106    Buffer.add_string b (iter 0 data)    Buffer.add_string b (iter 0 data)
107      
108  let buf_dynint b data =  let buf_dynint b data =
109    let data = Int64.logand bits32 data in    let data = Int64.logand bits32 data in
110    let buf = String.create 6 in    let buf = String.create 6 in
111    
112    let len =    let len =
113      if data > len5 then 5 else      if data > len5 then 5 else
114      if data > len4 then 4 else      if data > len4 then 4 else
115      if data > len3 then 3 else      if data > len3 then 3 else
# Line 121  let buf_dynint b data = Line 120  let buf_dynint b data =
120    (* last byte doesn't have high bit set *)    (* last byte doesn't have high bit set *)
121    buf.[i] <-  char_of_int (Int64.to_int (Int64.logand data int64_7f));    buf.[i] <-  char_of_int (Int64.to_int (Int64.logand data int64_7f));
122    let data = ref (Int64.shift_right_logical data  7) in    let data = ref (Int64.shift_right_logical data  7) in
123      
124    for i = i - 1 downto 0 do    for i = i - 1 downto 0 do
125      buf.[i] <- char_of_int (0x80 lor (Int64.to_int      buf.[i] <- char_of_int (0x80 lor (Int64.to_int
126            (Int64.logand !data int64_7f)));            (Int64.logand !data int64_7f)));
# Line 133  let dynint v = Line 132  let dynint v =
132    let b = Buffer.create 10 in    let b = Buffer.create 10 in
133    buf_dynint b v;    buf_dynint b v;
134    Buffer.contents b    Buffer.contents b
135      
     
136  let get_dynint s pos =  let get_dynint s pos =
137    let len = String.length s in    let len = String.length s in
138    let rec iter len pos ret =    let rec iter len pos ret =
139      if pos < len then      if pos < len then
140        let i = int_of_char s.[pos] in        let i = int_of_char s.[pos] in
141        let ret = Int64.logor (Int64.shift_left ret 7)        let ret = Int64.logor (Int64.shift_left ret 7)
142          (Int64.of_int (i land 0x7f)) in          (Int64.of_int (i land 0x7f)) in
143        if i land 0x80 <> 0 then        if i land 0x80 <> 0 then
144          iter len (pos+1) ret          iter len (pos+1) ret
145        else        else
146          ret, pos+1          ret, pos+1
147      else      else
148        ret, len        ret, len
149    in    in
150    let v,pos = iter len pos zero in    let v,pos = iter len pos zero in
151    let v = if Int64.logand v neg32_bit <> zero then    let v = if Int64.logand v neg32_bit <> zero then
152        42949672956L -- v else v in        42949672956L -- v else v in
153    v, pos    v, pos
154    
155  let known_download_headers = []  let known_download_headers = []
156    
157  let parse_headers c first_line headers =  let parse_headers c first_line headers =
158      
159    if !verbose_unknown_messages then begin    if !verbose_unknown_messages then begin
160        let unknown_header = ref false in        let unknown_header = ref false in
161        List.iter (fun (header, _) ->        List.iter (fun (header, _) ->
# Line 169  let parse_headers c first_line headers = Line 167  let parse_headers c first_line headers =
167            List.iter (fun (header, (value,header2)) ->            List.iter (fun (header, (value,header2)) ->
168                lprintf "    [%s] = [%s](%s)\n" header value header2;                lprintf "    [%s] = [%s](%s)\n" header value header2;
169            ) headers;            ) headers;
170            lprintf "FT DEVEL: end of header\n";                    lprintf "FT DEVEL: end of header\n";
171          end;          end;
172      end      end
173      
174  let fasttrack_200_ok = "no such thing :)"  let fasttrack_200_ok = "no such thing :)"
175      
     
176  (* This is the typical reply of a busy FT client.  (* This is the typical reply of a busy FT client.
177  ascii:[  ascii:[
178  HTTP/1.0 503 Service Unavailable(10)  HTTP/1.0 503 Service Unavailable(10)
# Line 187  X-Kazaa-SupernodeIP: 80.57.???.???:1070( Line 184  X-Kazaa-SupernodeIP: 80.57.???.???:1070(
184  *)  *)
185    
186  open CommonUploads  open CommonUploads
187      
188  let headers_of_shared_file gconn sh =  let headers_of_shared_file gconn sh =
189    let headers = ref [] in    let headers = ref [] in
190    List.iter (fun uid ->    List.iter (fun uid ->
191        match Uid.to_uid uid with        match Uid.to_uid uid with
192          Md5Ext hash ->          Md5Ext hash ->
193            let hash = Md5Ext.to_hexa_case false hash in            let hash = Md5Ext.to_hexa_case false hash in
194            headers :=            headers :=
195            ("X-KazaaTag", Printf.sprintf "3=%s" hash) :: !headers            ("X-KazaaTag", Printf.sprintf "3=%s" hash) :: !headers
196        | _ -> ()        | _ -> ()
197    ) sh.shared_uids;    ) sh.shared_uids;
198      
199    if not (List.mem sh.shared_id gconn.gconn_file_info_sent) then begin    if not (List.mem sh.shared_id gconn.gconn_file_info_sent) then begin
200                gconn.gconn_file_info_sent <-
       gconn.gconn_file_info_sent <-  
201          sh.shared_id :: gconn.gconn_file_info_sent;          sh.shared_id :: gconn.gconn_file_info_sent;
         
202  (* TODO: add other X-KazaaTag headers using 'name_of_tag' *)  (* TODO: add other X-KazaaTag headers using 'name_of_tag' *)
203        ()        ()
204      end;      end;
205    !headers    !headers
206      
207  let request_of_download request d =  let request_of_download request d =
208    let url = Printf.sprintf "/.hash=%s" d.download_uri in    let url = Printf.sprintf "/.hash=%s" d.download_uri in
209    let s = Printf.sprintf "%s %s HTTP/1.0" request url in    let s = Printf.sprintf "%s %s HTTP/1.0" request url in
210    s    s
211      
212  let make_download_request c s headers =  let make_download_request c s headers =
213      
214  (* hum... what will happen if no client support HEAD request ? We might  (* hum... what will happen if no client support HEAD request ? We might
215  lose them during the first connection... *)  lose them during the first connection... *)
216    
# Line 243  lose them during the first connection... Line 238  lose them during the first connection...
238            ("Host", Printf.sprintf "%s:%d" (Ip.to_string ip) port) :: headers)            ("Host", Printf.sprintf "%s:%d" (Ip.to_string ip) port) :: headers)
239    in    in
240    make_http_header s headers    make_http_header s headers
241      
242  let find_download_by_index index dlist = raise Not_found  let find_download_by_index index dlist = raise Not_found
243      
244  let find_file_to_upload gconn url =  let find_file_to_upload gconn url =
245    let sh =    let sh =
246      let file = url.Url.short_file in      let file = url.Url.short_file in
247    
248      if String2.starts_with file "/.hash=" then      if String2.starts_with file "/.hash=" then
# Line 258  let find_file_to_upload gconn url = Line 253  let find_file_to_upload gconn url =
253        lprintf "Trying to find %s\n" urn;        lprintf "Trying to find %s\n" urn;
254        find_by_uid uid        find_by_uid uid
255      else      else
256      raise Not_found      raise Not_found
257    in    in
258        
     
259    let impl = sh.shared_impl in    let impl = sh.shared_impl in
260    impl.impl_shared_requests <- impl.impl_shared_requests + 1;    impl.impl_shared_requests <- impl.impl_shared_requests + 1;
261    shared_must_update_downloaded (as_shared impl);    shared_must_update_downloaded (as_shared impl);
262    
263    let info = IndexedSharedFiles.get_result sh.shared_info in    let info = IndexedSharedFiles.get_result sh.shared_info in
264    (fun pos upload_buffer spos rlen ->    (fun pos upload_buffer spos rlen ->
265          
266        let impl = sh.shared_impl in        let impl = sh.shared_impl in
267        impl.impl_shared_uploaded <-        impl.impl_shared_uploaded <-
268          impl.impl_shared_uploaded ++ (Int64.of_int rlen);          impl.impl_shared_uploaded ++ (Int64.of_int rlen);
269        shared_must_update_downloaded (as_shared impl);        shared_must_update_downloaded (as_shared impl);
270          
271        Unix32.read sh.shared_fd pos upload_buffer spos rlen),        Unix32.read sh.shared_fd pos upload_buffer spos rlen),
272    info.shared_size,    info.shared_size,
273      
274    headers_of_shared_file gconn info    headers_of_shared_file gconn info
     

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

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