25 |
|
|
26 |
open BasicSocket |
open BasicSocket |
27 |
open TcpBufferedSocket |
open TcpBufferedSocket |
28 |
|
|
29 |
open CommonShared |
open CommonShared |
30 |
open CommonUploads |
open CommonUploads |
31 |
open CommonOptions |
open CommonOptions |
36 |
open CommonTypes |
open CommonTypes |
37 |
open CommonFile |
open CommonFile |
38 |
open CommonGlobals |
open CommonGlobals |
39 |
open CommonDownloads |
open CommonDownloads |
40 |
|
|
41 |
open FileTPTypes |
open FileTPTypes |
42 |
open FileTPOptions |
open FileTPOptions |
43 |
open FileTPGlobals |
open FileTPGlobals |
61 |
(* MAIN *) |
(* MAIN *) |
62 |
(* *) |
(* *) |
63 |
(*************************************************************************) |
(*************************************************************************) |
64 |
|
|
65 |
let http_send_range_request c range sock d = |
let http_send_range_request c range sock d = |
66 |
let url = d.download_url in |
let url = d.download_url in |
67 |
|
|
68 |
let (x,y) = range in |
let (x,y) = range in |
69 |
let range = Printf.sprintf "%Ld-%Ld" x (y -- (Int64.one)) in |
let range = Printf.sprintf "%Ld-%Ld" x (y -- (Int64.one)) in |
70 |
|
|
71 |
let buf = Buffer.create 100 in |
let buf = Buffer.create 100 in |
72 |
|
|
73 |
Printf.bprintf buf "GET %s HTTP/1.0\r\n" url.Url.full_file; |
Printf.bprintf buf "GET %s HTTP/1.0\r\n" url.Url.full_file; |
74 |
|
|
75 |
(* |
(* |
76 |
(match d.download_uri with |
(match d.download_uri with |
77 |
FileByUrl url -> Printf.bprintf buf "GET %s HTTP/1.0\r\n" url |
FileByUrl url -> Printf.bprintf buf "GET %s HTTP/1.0\r\n" url |
78 |
| FileByIndex (index, name) -> |
| FileByIndex (index, name) -> |
79 |
Printf.bprintf buf "GET /get/%d/%s HTTP/1.1\r\n" index |
Printf.bprintf buf "GET /get/%d/%s HTTP/1.1\r\n" index |
80 |
name); *) |
name); *) |
81 |
Printf.bprintf buf "Host: %s\r\n" c.client_hostname; |
Printf.bprintf buf "Host: %s\r\n" c.client_hostname; |
82 |
Printf.bprintf buf "User-Agent: %s\r\n" user_agent; |
Printf.bprintf buf "User-Agent: %s\r\n" user_agent; |
83 |
Printf.bprintf buf "Range: bytes=%s\r\n" range; |
Printf.bprintf buf "Range: bytes=%s\r\n" range; |
84 |
Printf.bprintf buf "Connection: Keep-Alive\r\n"; |
Printf.bprintf buf "Connection: Keep-Alive\r\n"; |
85 |
Printf.bprintf buf "\r\n"; |
Printf.bprintf buf "\r\n"; |
97 |
(* *) |
(* *) |
98 |
(*************************************************************************) |
(*************************************************************************) |
99 |
|
|
100 |
|
let rec client_parse_header c gconn sock header = |
|
let rec client_parse_header c gconn sock header = |
|
101 |
if !verbose_msg_clients then |
if !verbose_msg_clients then |
102 |
lprintf_nl () "CLIENT PARSE HEADER"; |
lprintf_nl () "CLIENT PARSE HEADER"; |
103 |
try |
try |
104 |
set_lifetime sock 3600.; |
set_lifetime sock 3600.; |
105 |
let d = |
let d = |
106 |
match c.client_requests with |
match c.client_requests with |
107 |
[] -> failwith "No download request !!!" |
[] -> failwith "No download request !!!" |
108 |
| d :: tail -> |
| d :: tail -> |
109 |
c.client_requests <- tail; |
c.client_requests <- tail; |
110 |
d |
d |
111 |
in |
in |
112 |
connection_ok c.client_connection_control; |
connection_ok c.client_connection_control; |
113 |
set_client_state c Connected_initiating; |
set_client_state c Connected_initiating; |
114 |
if !verbose_msg_clients then begin |
if !verbose_msg_clients then begin |
115 |
lprintf_nl () "HEADER FROM CLIENT:"; |
lprintf_nl () "HEADER FROM CLIENT:"; |
116 |
AnyEndian.dump_ascii header; |
AnyEndian.dump_ascii header; |
117 |
end; |
end; |
118 |
let file = d.download_file in |
let file = d.download_file in |
119 |
let size = file_size file in |
let size = file_size file in |
120 |
|
|
121 |
let endline_pos = String.index header '\n' in |
let endline_pos = String.index header '\n' in |
122 |
let http, code = |
let http, code = |
123 |
match String2.split (String.sub header 0 endline_pos |
match String2.split (String.sub header 0 endline_pos |
124 |
) ' ' with |
) ' ' with |
125 |
| http :: code :: ok :: _ -> |
| http :: code :: ok :: _ -> |
126 |
let code = int_of_string code in |
let code = int_of_string code in |
127 |
if not (String2.starts_with (String.lowercase http) "http") then |
if not (String2.starts_with (String.lowercase http) "http") then |
128 |
failwith "Not in http protocol"; |
failwith "Not in http protocol"; |
131 |
in |
in |
132 |
if !verbose_msg_clients then |
if !verbose_msg_clients then |
133 |
lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n"; |
lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n"; |
134 |
|
|
135 |
set_rtimeout sock 120.; |
set_rtimeout sock 120.; |
136 |
(* lprintf "SPLIT HEADER...\n"; *) |
(* lprintf "SPLIT HEADER...\n"; *) |
137 |
let lines = Http_client.split_header header in |
let lines = Http_client.split_header header in |
138 |
(* lprintf "REMOVE HEADLINE...\n"; *) |
(* lprintf "REMOVE HEADLINE...\n"; *) |
139 |
let first_line, headers = match lines with |
let first_line, headers = match lines with |
140 |
[] -> raise Not_found |
[] -> raise Not_found |
141 |
| line :: headers -> line, headers |
| line :: headers -> line, headers |
142 |
in |
in |
143 |
(* lprintf "CUT HEADERS...\n"; *) |
(* lprintf "CUT HEADERS...\n"; *) |
144 |
let headers = Http_client.cut_headers headers in |
let headers = Http_client.cut_headers headers in |
145 |
(* lprintf "START POS...\n"; *) |
(* lprintf "START POS...\n"; *) |
146 |
|
|
|
|
|
147 |
if !verbose_unknown_messages then begin |
if !verbose_unknown_messages then begin |
148 |
let unknown_header = ref false in |
let unknown_header = ref false in |
149 |
List.iter (fun (header, _) -> |
List.iter (fun (header, _) -> |
158 |
lprintf_nl () "end of header"; |
lprintf_nl () "end of header"; |
159 |
end; |
end; |
160 |
end; |
end; |
|
|
|
161 |
|
|
162 |
(* I think this is already handeled with the new headder check before |
(* I think this is already handeled with the new headder check before |
163 |
download start code |
download start code |
173 |
c.client_port <- u.Url.port; |
c.client_port <- u.Url.port; |
174 |
|
|
175 |
let file = new_file (Md4.random ()) u.Url.full_file zero in |
let file = new_file (Md4.random ()) u.Url.full_file zero in |
176 |
|
|
177 |
lprintf_nl () "DOWNLOAD FILE %s" (file_best_name file); |
lprintf_nl () "DOWNLOAD FILE %s" (file_best_name file); |
178 |
if not (List.memq file !current_files) then begin |
if not (List.memq file !current_files) then begin |
179 |
current_files := file :: !current_files; |
current_files := file :: !current_files; |
180 |
end; |
end; |
181 |
add_download file c u; |
add_download file c u; |
182 |
FileTPClients.get_file_from_source c file; |
FileTPClients.get_file_from_source c file; |
183 |
|
|
184 |
end; |
end; |
185 |
*) |
*) |
186 |
|
|
187 |
if code < 200 || code > 299 then |
if code < 200 || code > 299 then |
188 |
failwith "Bad HTTP code"; |
failwith "Bad HTTP code"; |
189 |
|
|
190 |
|
let start_pos, end_pos = |
|
let start_pos, end_pos = |
|
191 |
try |
try |
192 |
let (range,_) = List.assoc "content-range" headers in |
let (range,_) = List.assoc "content-range" headers in |
193 |
try |
try |
205 |
let y = Int64.of_string ( |
let y = Int64.of_string ( |
206 |
String.sub range (dash_pos+1) (slash_pos - dash_pos - 1)) |
String.sub range (dash_pos+1) (slash_pos - dash_pos - 1)) |
207 |
in |
in |
208 |
if slash_pos = star_pos - 1 then |
if slash_pos = star_pos - 1 then |
209 |
x,y ++ Int64.one (* "bytes x-y/*" *) |
x,y ++ Int64.one (* "bytes x-y/*" *) |
210 |
else |
else |
211 |
let z = Int64.of_string ( |
let z = Int64.of_string ( |
212 |
String.sub range (slash_pos+1) (len - slash_pos -1) ) |
String.sub range (slash_pos+1) (len - slash_pos -1) ) |
213 |
in |
in |
214 |
if y = z then x -- Int64.one, size else |
if y = z then x -- Int64.one, size else |
215 |
x,y ++ Int64.one |
x,y ++ Int64.one |
216 |
with |
with |
217 |
| e -> |
| e -> |
218 |
lprintf_nl () "Exception %s for range [%s]" |
lprintf_nl () "Exception %s for range [%s]" |
219 |
(Printexc2.to_string e) range; |
(Printexc2.to_string e) range; |
220 |
raise e |
raise e |
221 |
with e -> |
with e -> |
222 |
try |
try |
223 |
if code <> 206 && code <> 200 then raise Not_found; |
if code <> 206 && code <> 200 then raise Not_found; |
224 |
let (len,_) = List.assoc "content-length" headers in |
let (len,_) = List.assoc "content-length" headers in |
226 |
if !verbose then lprintf_nl () "Specified length: %Ld" len; |
if !verbose then lprintf_nl () "Specified length: %Ld" len; |
227 |
match d.download_ranges with |
match d.download_ranges with |
228 |
[] -> raise Not_found |
[] -> raise Not_found |
229 |
| (start_pos,end_pos,r) :: _ -> |
| (start_pos,end_pos,r) :: _ -> |
230 |
lprintf_nl () "WARNING: Assuming client is replying to range"; |
lprintf_nl () "WARNING: Assuming client is replying to range"; |
231 |
if len <> end_pos -- start_pos then |
if len <> end_pos -- start_pos then |
232 |
begin |
begin |
236 |
raise Not_found |
raise Not_found |
237 |
end; |
end; |
238 |
(start_pos, end_pos) |
(start_pos, end_pos) |
239 |
with _ -> |
with _ -> |
240 |
(* A bit dangerous, no ??? *) |
(* A bit dangerous, no ??? *) |
241 |
if !verbose_hidden_errors then |
if !verbose_hidden_errors then |
242 |
lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s" |
lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s" |
244 |
(String.escaped header); |
(String.escaped header); |
245 |
disconnect_client c (Closed_for_error "Bad HTTP Range"); |
disconnect_client c (Closed_for_error "Bad HTTP Range"); |
246 |
raise Exit |
raise Exit |
247 |
in |
in |
248 |
(try |
(try |
249 |
let (len,_) = List.assoc "content-length" headers in |
let (len,_) = List.assoc "content-length" headers in |
250 |
let len = Int64.of_string len in |
let len = Int64.of_string len in |
255 |
start_pos end_pos len |
start_pos end_pos len |
256 |
(String.escaped header); |
(String.escaped header); |
257 |
end |
end |
258 |
with _ -> |
with _ -> |
259 |
lprintf_nl () "[WARNING]: no Content-Length field\n%s\n" |
lprintf_nl () "[WARNING]: no Content-Length field\n%s\n" |
260 |
(String.escaped header) |
(String.escaped header) |
261 |
); |
); |
262 |
|
|
263 |
if !verbose then lprintf_nl () "Receiving range: %Ld-%Ld (len = %Ld)\n%s" |
if !verbose then lprintf_nl () "Receiving range: %Ld-%Ld (len = %Ld)\n%s" |
264 |
start_pos end_pos (end_pos -- start_pos) |
start_pos end_pos (end_pos -- start_pos) |
265 |
(String.escaped header) |
(String.escaped header) |
270 |
for i = 1 to max_queued_ranges do |
for i = 1 to max_queued_ranges do |
271 |
if List.length d.download_ranges <= max_queued_ranges then |
if List.length d.download_ranges <= max_queued_ranges then |
272 |
(try get_from_client sock c with _ -> ()); |
(try get_from_client sock c with _ -> ()); |
273 |
done; |
done; |
274 |
gconn.gconn_handler <- Reader (fun gconn sock -> |
gconn.gconn_handler <- Reader (fun gconn sock -> |
275 |
if file_state file <> FileDownloading then begin |
if file_state file <> FileDownloading then begin |
276 |
disconnect_client c Closed_by_user; |
disconnect_client c Closed_by_user; |
277 |
raise Exit; |
raise Exit; |
278 |
end; |
end; |
279 |
|
|
280 |
let b = TcpBufferedSocket.buf sock in |
let b = TcpBufferedSocket.buf sock in |
281 |
let to_read = (*min (end_pos -- !counter_pos) *) |
let to_read = (*min (end_pos -- !counter_pos) *) |
282 |
(Int64.of_int b.len) in |
(Int64.of_int b.len) in |
283 |
|
|
284 |
if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld" |
if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld" |
285 |
end_pos !counter_pos b.len to_read; |
end_pos !counter_pos b.len to_read; |
286 |
|
|
287 |
let to_read_int = Int64.to_int to_read in |
let to_read_int = Int64.to_int to_read in |
288 |
(* |
(* |
289 |
if !verbose then lprintf "CHUNK: %s\n" |
if !verbose then lprintf "CHUNK: %s\n" |
290 |
(String.escaped (String.sub b.buf b.pos to_read_int)); *) |
(String.escaped (String.sub b.buf b.pos to_read_int)); *) |
291 |
let swarmer = match file.file_swarmer with |
let swarmer = match file.file_swarmer with |
292 |
None -> assert false | Some sw -> sw |
None -> assert false | Some sw -> sw |
293 |
in |
in |
294 |
let old_downloaded = |
let old_downloaded = |
295 |
Int64Swarmer.downloaded swarmer in |
Int64Swarmer.downloaded swarmer in |
296 |
(* List.iter (fun (_,_,r) -> Int64Swarmer.free_range r) |
(* List.iter (fun (_,_,r) -> Int64Swarmer.free_range r) |
297 |
d.download_ranges; *) |
d.download_ranges; *) |
298 |
|
|
299 |
begin |
begin |
300 |
try |
try |
301 |
match d.download_uploader with |
match d.download_uploader with |
303 |
| Some up -> |
| Some up -> |
304 |
Int64Swarmer.received up |
Int64Swarmer.received up |
305 |
!counter_pos b.buf b.pos to_read_int; |
!counter_pos b.buf b.pos to_read_int; |
306 |
with e -> |
with e -> |
307 |
lprintf_nl () "Exception %s in Int64Swarmer.received" |
lprintf_nl () "Exception %s in Int64Swarmer.received" |
308 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
309 |
end; |
end; |
310 |
c.client_reconnect <- true; |
c.client_reconnect <- true; |
311 |
(* List.iter (fun (_,_,r) -> |
(* List.iter (fun (_,_,r) -> |
312 |
Int64Swarmer.alloc_range r) d.download_ranges; *) |
Int64Swarmer.alloc_range r) d.download_ranges; *) |
313 |
let new_downloaded = |
let new_downloaded = |
314 |
Int64Swarmer.downloaded swarmer in |
Int64Swarmer.downloaded swarmer in |
315 |
|
|
316 |
(match d.download_ranges with |
(match d.download_ranges with |
317 |
[] -> lprintf_nl () "EMPTY Ranges!" |
[] -> lprintf_nl () "EMPTY Ranges!" |
318 |
| r :: _ -> |
| r :: _ -> |
319 |
(* |
(* |
320 |
let (x,y) = Int64Swarmer.range_range r in |
let (x,y) = Int64Swarmer.range_range r in |
321 |
if !verbose then lprintf_nl "Received %Ld [%Ld] (%Ld-%Ld) -> %Ld" |
if !verbose then lprintf_nl "Received %Ld [%Ld] (%Ld-%Ld) -> %Ld" |
322 |
!counter_pos to_read |
!counter_pos to_read |
323 |
x y |
x y |
324 |
(new_downloaded -- old_downloaded) |
(new_downloaded -- old_downloaded) |
325 |
*) |
*) |
326 |
() |
() |
327 |
); |
); |
328 |
|
|
329 |
if new_downloaded = file_size file then |
if new_downloaded = file_size file then |
330 |
download_finished file; |
download_finished file; |
331 |
(* |
(* |
348 |
if d.download_ranges = [] then raise Exit; |
if d.download_ranges = [] then raise Exit; |
349 |
gconn.gconn_handler <- HttpHeader (client_parse_header c); |
gconn.gconn_handler <- HttpHeader (client_parse_header c); |
350 |
end) |
end) |
351 |
|
|
352 |
with e -> |
with e -> |
353 |
if !verbose_hidden_errors then |
if !verbose_hidden_errors then |
354 |
begin |
begin |
357 |
end; |
end; |
358 |
disconnect_client c (Closed_for_exception e); |
disconnect_client c (Closed_for_exception e); |
359 |
raise e |
raise e |
|
|
|
360 |
|
|
361 |
(*************************************************************************) |
(*************************************************************************) |
362 |
(* *) |
(* *) |
363 |
(* MAIN *) |
(* MAIN *) |
364 |
(* *) |
(* *) |
365 |
(*************************************************************************) |
(*************************************************************************) |
366 |
|
|
367 |
let http_set_sock_handler c sock = |
let http_set_sock_handler c sock = |
368 |
set_fileTP_sock sock (HttpHeader (client_parse_header c)) |
set_fileTP_sock sock (HttpHeader (client_parse_header c)) |
369 |
|
|
372 |
(* MAIN *) |
(* MAIN *) |
373 |
(* *) |
(* *) |
374 |
(*************************************************************************) |
(*************************************************************************) |
375 |
|
|
376 |
let http_check_size url start_download_file = |
let http_check_size url start_download_file = |
377 |
let module H = Http_client in |
let module H = Http_client in |
378 |
let r = { |
let r = { |
382 |
H.req_request = H.HEAD; |
H.req_request = H.HEAD; |
383 |
H.req_user_agent = user_agent; |
H.req_user_agent = user_agent; |
384 |
} in |
} in |
385 |
|
|
386 |
H.whead r (fun headers -> |
H.whead r (fun headers -> |
387 |
if !verbose then lprintf_nl () "RECEIVED HEADERS"; |
if !verbose then lprintf_nl () "RECEIVED HEADERS"; |
388 |
let content_length = ref None in |
let content_length = ref None in |
389 |
List.iter (fun (name, content) -> |
List.iter (fun (name, content) -> |
390 |
if String.lowercase name = "content-length" then |
if String.lowercase name = "content-length" then |
391 |
try |
try |
392 |
content_length := Some (Int64.of_string content) |
content_length := Some (Int64.of_string content) |
393 |
with _ -> |
with _ -> |
394 |
lprintf_nl () "bad content length [%s]" content; |
lprintf_nl () "bad content length [%s]" content; |
395 |
) headers; |
) headers; |
396 |
match !content_length with |
match !content_length with |
406 |
|
|
407 |
let http_connect token c f = |
let http_connect token c f = |
408 |
let ip = Ip.from_name c.client_hostname in |
let ip = Ip.from_name c.client_hostname in |
409 |
connect token "fileTP download" |
connect token "fileTP download" |
410 |
(Ip.to_inet_addr ip) c.client_port |
(Ip.to_inet_addr ip) c.client_port |
411 |
(fun sock event -> |
(fun sock event -> |
412 |
match event with |
match event with |
418 |
(* You can only use the CONNECTED signal if the socket is not yet controlled |
(* You can only use the CONNECTED signal if the socket is not yet controlled |
419 |
by the bandwidth manager... 2004/02/03: Normally, not true anymore, it should now work |
by the bandwidth manager... 2004/02/03: Normally, not true anymore, it should now work |
420 |
even in this case... *) |
even in this case... *) |
421 |
|
|
422 |
| CONNECTED -> |
| CONNECTED -> |
423 |
if !verbose then lprintf_nl () "CONNECTED !!! Asking for range..."; |
if !verbose then lprintf_nl () "CONNECTED !!! Asking for range..."; |
424 |
f sock |
f sock |
433 |
proto_string = "http"; |
proto_string = "http"; |
434 |
proto_connect = http_connect; |
proto_connect = http_connect; |
435 |
} |
} |
|
|
|