46 |
|
|
47 |
open FileTPClients |
open FileTPClients |
48 |
|
|
49 |
|
(* prints a new logline with date, module and starts newline *) |
50 |
|
let lprintf_nl () = |
51 |
|
lprintf "%s[FTP] " |
52 |
|
(log_time ()); lprintf_nl2 |
53 |
|
|
54 |
|
(* prints a new logline with date, module and does not start newline *) |
55 |
|
let lprintf_n () = |
56 |
|
lprintf "%s[FTP] " |
57 |
|
(log_time ()); lprintf |
58 |
|
|
59 |
(*************************************************************************) |
(*************************************************************************) |
60 |
(* *) |
(* *) |
85 |
Printf.bprintf buf "\r\n"; |
Printf.bprintf buf "\r\n"; |
86 |
let s = Buffer.contents buf in |
let s = Buffer.contents buf in |
87 |
if !verbose_msg_clients then |
if !verbose_msg_clients then |
88 |
lprintf "SENDING REQUEST to %s: %s\n" |
lprintf_nl () "SENDING REQUEST to %s: %s" |
89 |
c.client_hostname |
c.client_hostname |
90 |
(String.escaped s); |
(String.escaped s); |
91 |
write_string sock s; |
write_string sock s; |
99 |
|
|
100 |
|
|
101 |
let rec client_parse_header c gconn sock header = |
let rec client_parse_header c gconn sock header = |
102 |
if !verbose_msg_clients then begin |
if !verbose_msg_clients then |
103 |
lprintf "CLIENT PARSE HEADER\n"; |
lprintf_nl () "CLIENT PARSE HEADER"; |
|
end; |
|
104 |
try |
try |
105 |
set_lifetime sock 3600.; |
set_lifetime sock 3600.; |
106 |
let d = |
let d = |
113 |
connection_ok c.client_connection_control; |
connection_ok c.client_connection_control; |
114 |
set_client_state c Connected_initiating; |
set_client_state c Connected_initiating; |
115 |
if !verbose_msg_clients then begin |
if !verbose_msg_clients then begin |
116 |
lprintf "HEADER FROM CLIENT:\n"; |
lprintf_nl () "HEADER FROM CLIENT:"; |
117 |
AnyEndian.dump_ascii header; |
AnyEndian.dump_ascii header; |
118 |
end; |
end; |
119 |
let file = d.download_file in |
let file = d.download_file in |
130 |
http, code |
http, code |
131 |
| _ -> failwith "Not a HTTP header line" |
| _ -> failwith "Not a HTTP header line" |
132 |
in |
in |
133 |
if !verbose_msg_clients then begin |
if !verbose_msg_clients then |
134 |
lprintf "GOOD HEADER FROM CONNECTED CLIENT\n"; |
lprintf_nl () "GOOD HEADER FROM CONNECTED CLIENT\n"; |
|
end; |
|
135 |
|
|
136 |
set_rtimeout sock 120.; |
set_rtimeout sock 120.; |
137 |
(* lprintf "SPLIT HEADER...\n"; *) |
(* lprintf "SPLIT HEADER...\n"; *) |
152 |
unknown_header := !unknown_header || not (List.mem header known_download_headers) |
unknown_header := !unknown_header || not (List.mem header known_download_headers) |
153 |
) headers; |
) headers; |
154 |
if !unknown_header then begin |
if !unknown_header then begin |
155 |
lprintf_nl "FileTP DEVEL: Download Header contains unknown fields"; |
lprintf_n () "Download Header contains unknown fields"; |
156 |
lprintf " %s\n" first_line; |
lprintf_nl2 " %s" first_line; |
157 |
List.iter (fun (header, (value,header2)) -> |
List.iter (fun (header, (value,header2)) -> |
158 |
lprintf " [%s] = [%s](%s)\n" header value header2; |
lprintf_nl () " [%s] = [%s](%s)" header value header2; |
159 |
) headers; |
) headers; |
160 |
lprintf_nl "FileTP DEVEL: end of header"; |
lprintf_nl () "end of header"; |
161 |
end; |
end; |
162 |
end; |
end; |
163 |
|
|
177 |
|
|
178 |
let file = new_file (Md4.random ()) u.Url.full_file zero in |
let file = new_file (Md4.random ()) u.Url.full_file zero in |
179 |
|
|
180 |
lprintf "DOWNLOAD FILE %s\n" (file_best_name file); |
lprintf_nl () "DOWNLOAD FILE %s" (file_best_name file); |
181 |
if not (List.memq file !current_files) then begin |
if not (List.memq file !current_files) then begin |
182 |
current_files := file :: !current_files; |
current_files := file :: !current_files; |
183 |
end; |
end; |
219 |
x,y ++ Int64.one |
x,y ++ Int64.one |
220 |
with |
with |
221 |
| e -> |
| e -> |
222 |
lprintf "Exception %s for range [%s]\n" |
lprintf_nl () "Exception %s for range [%s]" |
223 |
(Printexc2.to_string e) range; |
(Printexc2.to_string e) range; |
224 |
raise e |
raise e |
225 |
with e -> |
with e -> |
227 |
if code <> 206 && code <> 200 then raise Not_found; |
if code <> 206 && code <> 200 then raise Not_found; |
228 |
let (len,_) = List.assoc "content-length" headers in |
let (len,_) = List.assoc "content-length" headers in |
229 |
let len = Int64.of_string len in |
let len = Int64.of_string len in |
230 |
if !verbose then lprintf_nl "Specified length: %Ld" len; |
if !verbose then lprintf_nl () "Specified length: %Ld" len; |
231 |
match d.download_ranges with |
match d.download_ranges with |
232 |
[] -> raise Not_found |
[] -> raise Not_found |
233 |
| (start_pos,end_pos,r) :: _ -> |
| (start_pos,end_pos,r) :: _ -> |
234 |
lprintf "WARNING: Assuming client is replying to range\n"; |
lprintf_nl () "WARNING: Assuming client is replying to range"; |
235 |
if len <> end_pos -- start_pos then |
if len <> end_pos -- start_pos then |
236 |
begin |
begin |
237 |
lprintf "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n" |
lprintf_nl () "ERROR: bad computed range: %Ld-%Ld/%Ld \n%s" |
238 |
start_pos end_pos len |
start_pos end_pos len |
239 |
(String.escaped header); |
(String.escaped header); |
240 |
raise Not_found |
raise Not_found |
243 |
with _ -> |
with _ -> |
244 |
(* A bit dangerous, no ??? *) |
(* A bit dangerous, no ??? *) |
245 |
if !verbose_hidden_errors then |
if !verbose_hidden_errors then |
246 |
lprintf "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s\n" |
lprintf_nl () "ERROR: Could not find/parse range header (exception %s), disconnect\nHEADER: %s" |
247 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
248 |
(String.escaped header); |
(String.escaped header); |
249 |
disconnect_client c (Closed_for_error "Bad HTTP Range"); |
disconnect_client c (Closed_for_error "Bad HTTP Range"); |
252 |
(try |
(try |
253 |
let (len,_) = List.assoc "content-length" headers in |
let (len,_) = List.assoc "content-length" headers in |
254 |
let len = Int64.of_string len in |
let len = Int64.of_string len in |
255 |
if !verbose then lprintf_nl "Specified length: %Ld" len; |
if !verbose then lprintf_nl () "Specified length: %Ld" len; |
256 |
if len <> end_pos -- start_pos then |
if len <> end_pos -- start_pos then |
257 |
begin |
begin |
258 |
failwith "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n" |
failwith "\n\nERROR: bad computed range: %Ld-%Ld/%Ld \n%s\n" |
260 |
(String.escaped header); |
(String.escaped header); |
261 |
end |
end |
262 |
with _ -> |
with _ -> |
263 |
lprintf "[WARNING]: no Content-Length field\n%s\n" |
lprintf_nl () "[WARNING]: no Content-Length field\n%s\n" |
264 |
(String.escaped header) |
(String.escaped header) |
265 |
); |
); |
266 |
|
|
267 |
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" |
268 |
start_pos end_pos (end_pos -- start_pos) |
start_pos end_pos (end_pos -- start_pos) |
269 |
(String.escaped header) |
(String.escaped header) |
270 |
; |
; |
285 |
let to_read = (*min (end_pos -- !counter_pos) *) |
let to_read = (*min (end_pos -- !counter_pos) *) |
286 |
(Int64.of_int b.len) in |
(Int64.of_int b.len) in |
287 |
|
|
288 |
if !verbose then lprintf "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld\n" |
if !verbose then lprintf_nl () "Reading: end_pos %Ld counter_pos %Ld len %d = to_read %Ld" |
289 |
end_pos !counter_pos b.len to_read; |
end_pos !counter_pos b.len to_read; |
290 |
|
|
291 |
let to_read_int = Int64.to_int to_read in |
let to_read_int = Int64.to_int to_read in |
308 |
Int64Swarmer.received up |
Int64Swarmer.received up |
309 |
!counter_pos b.buf b.pos to_read_int; |
!counter_pos b.buf b.pos to_read_int; |
310 |
with e -> |
with e -> |
311 |
lprintf_nl "FileTP: Exception %s in Int64Swarmer.received" |
lprintf_nl () "Exception %s in Int64Swarmer.received" |
312 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
313 |
end; |
end; |
314 |
c.client_reconnect <- true; |
c.client_reconnect <- true; |
318 |
Int64Swarmer.downloaded swarmer in |
Int64Swarmer.downloaded swarmer in |
319 |
|
|
320 |
(match d.download_ranges with |
(match d.download_ranges with |
321 |
[] -> lprintf "EMPTY Ranges !!!\n" |
[] -> lprintf_nl () "EMPTY Ranges!" |
322 |
| r :: _ -> |
| r :: _ -> |
323 |
(* |
(* |
324 |
let (x,y) = Int64Swarmer.range_range r in |
let (x,y) = Int64Swarmer.range_range r in |
356 |
with e -> |
with e -> |
357 |
if !verbose_hidden_errors then |
if !verbose_hidden_errors then |
358 |
begin |
begin |
359 |
lprintf "Exception %s in client_parse_header\n" (Printexc2.to_string e); |
lprintf_nl () "Exception %s in client_parse_header" (Printexc2.to_string e); |
360 |
AnyEndian.dump header |
AnyEndian.dump header |
361 |
end; |
end; |
362 |
disconnect_client c (Closed_for_exception e); |
disconnect_client c (Closed_for_exception e); |
389 |
} in |
} in |
390 |
|
|
391 |
H.whead r (fun headers -> |
H.whead r (fun headers -> |
392 |
if !verbose then lprintf_nl "RECEIVED HEADERS"; |
if !verbose then lprintf_nl () "RECEIVED HEADERS"; |
393 |
let content_length = ref None in |
let content_length = ref None in |
394 |
List.iter (fun (name, content) -> |
List.iter (fun (name, content) -> |
395 |
if String.lowercase name = "content-length" then |
if String.lowercase name = "content-length" then |
396 |
try |
try |
397 |
content_length := Some (Int64.of_string content) |
content_length := Some (Int64.of_string content) |
398 |
with _ -> |
with _ -> |
399 |
lprintf "bad content length [%s]\n" content; |
lprintf_nl () "bad content length [%s]" content; |
400 |
) headers; |
) headers; |
401 |
match !content_length with |
match !content_length with |
402 |
None -> failwith "Unable to start download (HEAD failed)" |
None -> failwith "Unable to start download (HEAD failed)" |
425 |
even in this case... *) |
even in this case... *) |
426 |
|
|
427 |
| CONNECTED -> |
| CONNECTED -> |
428 |
if !verbose then lprintf_nl "CONNECTED !!! Asking for range..."; |
if !verbose then lprintf_nl () "CONNECTED !!! Asking for range..."; |
429 |
f sock |
f sock |
430 |
| _ -> () |
| _ -> () |
431 |
) |
) |