[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] Changes to mldonkey/src/networks/fasttrack/fasttrackP
From: |
mldonkey-commits |
Subject: |
[Mldonkey-commits] Changes to mldonkey/src/networks/fasttrack/fasttrackProtocol.ml |
Date: |
Sun, 07 Aug 2005 08:57:36 -0400 |
Index: mldonkey/src/networks/fasttrack/fasttrackProtocol.ml
diff -u mldonkey/src/networks/fasttrack/fasttrackProtocol.ml:1.7
mldonkey/src/networks/fasttrack/fasttrackProtocol.ml:1.8
--- mldonkey/src/networks/fasttrack/fasttrackProtocol.ml:1.7 Mon Nov 1
11:23:01 2004
+++ mldonkey/src/networks/fasttrack/fasttrackProtocol.ml Sun Aug 7
12:57:22 2005
@@ -31,13 +31,13 @@
open CommonOptions
open CommonGlobals
open CommonShared
-
+
open FasttrackNetwork
open FasttrackOptions
open FasttrackTypes
open FasttrackGlobals
-let set_fasttrack_sock sock info ghandler =
+let set_fasttrack_sock sock info ghandler =
let gconn = {
gconn_file_info_sent = [];
gconn_client_info_sent = false;
@@ -56,27 +56,26 @@
fun sock ->
match gconn.gconn_refill with
[] -> ()
- | _ :: tail ->
+ | _ :: tail ->
gconn.gconn_refill <- tail;
match tail with
- [] ->
- if gconn.gconn_close_on_write then
+ [] ->
+ if gconn.gconn_close_on_write then
set_lifetime sock 30.
(* TcpBufferedSocket.close sock "write done" *)
| refill :: _ -> refill sock)
-
let udp_handler f sock event =
match event with
UdpSocket.READ_DONE ->
- UdpSocket.read_packets sock (fun p ->
+ UdpSocket.read_packets sock (fun p ->
try
let pbuf = p.UdpSocket.udp_content in
let len = String.length pbuf in
f p
with e ->
lprintf "Error %s in udp_handler\n"
- (Printexc2.to_string e);
+ (Printexc2.to_string e);
) ;
| _ -> ()
@@ -86,7 +85,7 @@
let len4 = Int64.of_int (128*128*128)
let len3 = Int64.of_int (128*128)
let len2 = Int64.of_int (128)
-
+
let int64_7f = Int64.of_int 0x7f
let int64_80 = Int64.of_int 0x80
@@ -101,16 +100,16 @@
let s = String.create (len+1) in
s.[len] <- char_of_int (Int64.to_int n);
s
-
-let buf_dynint b data =
+
+let buf_dynint b data =
let data = Int64.logand bits32 data in
Buffer.add_string b (iter 0 data)
-
+
let buf_dynint b data =
let data = Int64.logand bits32 data in
let buf = String.create 6 in
- let len =
+ let len =
if data > len5 then 5 else
if data > len4 then 4 else
if data > len3 then 3 else
@@ -121,7 +120,7 @@
(* last byte doesn't have high bit set *)
buf.[i] <- char_of_int (Int64.to_int (Int64.logand data int64_7f));
let data = ref (Int64.shift_right_logical data 7) in
-
+
for i = i - 1 downto 0 do
buf.[i] <- char_of_int (0x80 lor (Int64.to_int
(Int64.logand !data int64_7f)));
@@ -133,31 +132,30 @@
let b = Buffer.create 10 in
buf_dynint b v;
Buffer.contents b
-
-
+
let get_dynint s pos =
let len = String.length s in
let rec iter len pos ret =
if pos < len then
let i = int_of_char s.[pos] in
- let ret = Int64.logor (Int64.shift_left ret 7)
+ let ret = Int64.logor (Int64.shift_left ret 7)
(Int64.of_int (i land 0x7f)) in
- if i land 0x80 <> 0 then
+ if i land 0x80 <> 0 then
iter len (pos+1) ret
else
ret, pos+1
- else
+ else
ret, len
in
let v,pos = iter len pos zero in
- let v = if Int64.logand v neg32_bit <> zero then
+ let v = if Int64.logand v neg32_bit <> zero then
42949672956L -- v else v in
v, pos
-
+
let known_download_headers = []
-
+
let parse_headers c first_line headers =
-
+
if !verbose_unknown_messages then begin
let unknown_header = ref false in
List.iter (fun (header, _) ->
@@ -169,13 +167,12 @@
List.iter (fun (header, (value,header2)) ->
lprintf " [%s] = [%s](%s)\n" header value header2;
) headers;
- lprintf "FT DEVEL: end of header\n";
+ lprintf "FT DEVEL: end of header\n";
end;
end
-
+
let fasttrack_200_ok = "no such thing :)"
-
-
+
(* This is the typical reply of a busy FT client.
ascii:[
HTTP/1.0 503 Service Unavailable(10)
@@ -187,35 +184,33 @@
*)
open CommonUploads
-
-let headers_of_shared_file gconn sh =
+
+let headers_of_shared_file gconn sh =
let headers = ref [] in
List.iter (fun uid ->
match Uid.to_uid uid with
Md5Ext hash ->
let hash = Md5Ext.to_hexa_case false hash in
- headers :=
+ headers :=
("X-KazaaTag", Printf.sprintf "3=%s" hash) :: !headers
| _ -> ()
) sh.shared_uids;
-
+
if not (List.mem sh.shared_id gconn.gconn_file_info_sent) then begin
-
- gconn.gconn_file_info_sent <-
+ gconn.gconn_file_info_sent <-
sh.shared_id :: gconn.gconn_file_info_sent;
-
(* TODO: add other X-KazaaTag headers using 'name_of_tag' *)
()
end;
!headers
-
-let request_of_download request d =
- let url = Printf.sprintf "/.hash=%s" d.download_uri in
+
+let request_of_download request d =
+ let url = Printf.sprintf "/.hash=%s" d.download_uri in
let s = Printf.sprintf "%s %s HTTP/1.0" request url in
s
-
+
let make_download_request c s headers =
-
+
(* hum... what will happen if no client support HEAD request ? We might
lose them during the first connection... *)
@@ -243,11 +238,11 @@
("Host", Printf.sprintf "%s:%d" (Ip.to_string ip) port) :: headers)
in
make_http_header s headers
-
+
let find_download_by_index index dlist = raise Not_found
-
-let find_file_to_upload gconn url =
- let sh =
+
+let find_file_to_upload gconn url =
+ let sh =
let file = url.Url.short_file in
if String2.starts_with file "/.hash=" then
@@ -258,24 +253,22 @@
lprintf "Trying to find %s\n" urn;
find_by_uid uid
else
- raise Not_found
+ raise Not_found
in
-
-
+
let impl = sh.shared_impl in
impl.impl_shared_requests <- impl.impl_shared_requests + 1;
shared_must_update_downloaded (as_shared impl);
let info = IndexedSharedFiles.get_result sh.shared_info in
(fun pos upload_buffer spos rlen ->
-
+
let impl = sh.shared_impl in
- impl.impl_shared_uploaded <-
+ impl.impl_shared_uploaded <-
impl.impl_shared_uploaded ++ (Int64.of_int rlen);
shared_must_update_downloaded (as_shared impl);
-
+
Unix32.read sh.shared_fd pos upload_buffer spos rlen),
info.shared_size,
-
+
headers_of_shared_file gconn info
-
\ No newline at end of file
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Mldonkey-commits] Changes to mldonkey/src/networks/fasttrack/fasttrackProtocol.ml,
mldonkey-commits <=