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; |
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 |
|
|
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 |
|
|
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 |
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))); |
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, _) -> |
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) |
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 |
|
|
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 |
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 |
|
|
|