39 |
|
|
40 |
let verbose = ref false |
let verbose = ref false |
41 |
|
|
|
(* |
|
|
| OPTIONS of url option (* None = '*' *) |
|
|
| CONNECT of string * int |
|
|
*) |
|
|
|
|
42 |
type request = { |
type request = { |
43 |
req_headers : ( string * string ) list; |
req_headers : ( string * string ) list; |
44 |
req_user_agent : string; |
req_user_agent : string; |
53 |
type content_handler = |
type content_handler = |
54 |
int -> (string * string) list -> TcpBufferedSocket.t -> int -> unit |
int -> (string * string) list -> TcpBufferedSocket.t -> int -> unit |
55 |
|
|
56 |
|
let lprintf_nl () = |
57 |
|
lprintf "%s[HTTPcl]: " |
58 |
|
(log_time ()); lprintf_nl2 |
59 |
|
|
60 |
let basic_request = { |
let basic_request = { |
61 |
req_url = Url.of_string "http://www.mldonkey.net/"; |
req_url = Url.of_string "http://www.mldonkey.net/"; |
62 |
req_referer = None; |
req_referer = None; |
116 |
Buffer.add_string res "\r\n"; |
Buffer.add_string res "\r\n"; |
117 |
let s = Buffer.contents res in |
let s = Buffer.contents res in |
118 |
if !verbose then |
if !verbose then |
119 |
lprintf "Http_client.make_full_request on URL: %s\n" s; |
lprintf_nl () "make_full_request on URL: %s" (String.escaped s); |
120 |
s |
s |
121 |
|
|
122 |
let split_head s = |
let split_head s = |
138 |
match headers with |
match headers with |
139 |
[] -> failwith "Ill formed reply" |
[] -> failwith "Ill formed reply" |
140 |
| ans :: headers -> |
| ans :: headers -> |
141 |
if !verbose then lprintf "Http_client.parse_header: ANSWER %s\n" ans; |
if !verbose then lprintf_nl () "parse_header: ANSWER %s" ans; |
142 |
let ans_code = int_of_string (String.sub ans 9 3) in |
let ans_code = int_of_string (String.sub ans 9 3) in |
143 |
let headers = List.map (fun s -> |
let headers = List.map (fun s -> |
144 |
let sep = String.index s ':' in |
let sep = String.index s ':' in |
254 |
in |
in |
255 |
let nread = ref false in |
let nread = ref false in |
256 |
if !verbose then |
if !verbose then |
257 |
lprintf "Http_client.get_page: %s\n" (String.escaped request); |
lprintf_nl () "get_page: %s" (String.escaped request); |
258 |
TcpBufferedSocket.write_string sock request; |
TcpBufferedSocket.write_string sock request; |
259 |
TcpBufferedSocket.set_reader sock (http_reply_handler nread |
TcpBufferedSocket.set_reader sock (http_reply_handler nread |
260 |
(default_headers_handler url level)); |
(default_headers_handler url level)); |
264 |
) |
) |
265 |
|
|
266 |
) |
) |
267 |
with e -> lprintf "Http_client: error in get_url\n"; raise Not_found |
with e -> lprintf_nl () "error in get_url"; raise Not_found |
268 |
|
|
269 |
and default_headers_handler old_url level sock ans_code headers = |
and default_headers_handler old_url level sock ans_code headers = |
270 |
let print_headers () = |
let print_headers () = |
271 |
List.iter |
List.iter |
272 |
(fun (name, value) -> |
(fun (name, value) -> |
273 |
lprintf "[%s]=[%s]\n" name value; |
lprintf_nl () "[%s]=[%s]" name value; |
274 |
) headers; |
) headers; |
275 |
in |
in |
276 |
(* print_headers (); *) |
(* print_headers (); *) |
292 |
try |
try |
293 |
content_length := int_of_string content |
content_length := int_of_string content |
294 |
with _ -> |
with _ -> |
295 |
lprintf "bad content length [%s]\n" content; |
lprintf_nl () "bad content length [%s]" content; |
296 |
) headers; |
) headers; |
297 |
let location = "Location", Url.to_string old_url in |
let location = "Location", Url.to_string old_url in |
298 |
let content_handler = content_handler !content_length (location::headers) in |
let content_handler = content_handler !content_length (location::headers) in |
302 |
content_handler sock buf.len |
content_handler sock buf.len |
303 |
|
|
304 |
| 301 | 302 | 304 -> |
| 301 | 302 | 304 -> |
305 |
if !verbose then lprintf "Http_client %d: Redirect\n" ans_code; |
if !verbose then lprintf_nl () "%d: Redirect" ans_code; |
306 |
if level < 10 then |
if level < 10 then |
307 |
begin |
begin |
308 |
try |
try |
321 |
Printf.sprintf "http://%s:%d%s" |
Printf.sprintf "http://%s:%d%s" |
322 |
old_url.Url.server old_url.Url.port !url |
old_url.Url.server old_url.Url.port !url |
323 |
in |
in |
324 |
if !verbose then lprintf "Redirected to %s\n" url; |
if !verbose then lprintf_nl () "Redirected to %s" url; |
325 |
let r = { r with req_url = Url.of_string url } in |
let r = { r with req_url = Url.of_string url } in |
326 |
get_url (level+1) r |
get_url (level+1) r |
327 |
|
|
328 |
with e -> |
with e -> |
329 |
lprintf "Http_client: error understanding redirect response %d\n" ans_code; |
lprintf_nl () "error understanding redirect response %d" ans_code; |
330 |
print_headers (); |
print_headers (); |
331 |
raise Not_found |
raise Not_found |
332 |
|
|
333 |
end |
end |
334 |
else |
else |
335 |
lprintf "Http_client: more than 10 redirections, aborting."; |
lprintf_nl () "more than 10 redirections, aborting."; |
336 |
raise Not_found |
raise Not_found |
337 |
|
|
338 |
| 404 -> |
| 404 -> |
339 |
lprintf "Http_client: 404: Not found for: %s\n" (Url.to_string_no_args r.req_url); |
lprintf_nl () "404: Not found for: %s" (Url.to_string_no_args r.req_url); |
340 |
close sock (Closed_for_error "bad reply"); |
close sock (Closed_for_error "bad reply"); |
341 |
raise Not_found |
raise Not_found |
342 |
|
|
343 |
| _ -> |
| _ -> |
344 |
lprintf "Http_client: %d: bad reply for: %s\n" |
lprintf_nl () "%d: bad reply for: %s" |
345 |
ans_code (Url.to_string_no_args r.req_url); |
ans_code (Url.to_string_no_args r.req_url); |
346 |
close sock (Closed_for_error "bad reply"); |
close sock (Closed_for_error "bad reply"); |
347 |
raise Not_found |
raise Not_found |
348 |
in |
in |
349 |
get_url 0 r; |
get_url 0 r; |
350 |
if !error = true then begin |
if !error = true then begin |
351 |
lprintf "Http_client: failed!!\n"; |
lprintf_nl () "failed!"; |
352 |
raise Not_found |
raise Not_found |
353 |
end |
end |
354 |
|
|
378 |
end) |
end) |
379 |
(fun _ -> |
(fun _ -> |
380 |
let s = Buffer.contents file_buf in |
let s = Buffer.contents file_buf in |
381 |
if s = "" then begin |
if s = "" then begin |
382 |
lprintf "Empty content for url %s\n" |
lprintf_nl () "Empty content for url %s" |
383 |
(Url.to_string r.req_url); |
(Url.to_string r.req_url); |
384 |
end; |
end; |
385 |
let filename = Filename.temp_file "http_" ".tmp" in |
let filename = Filename.temp_file "http_" ".tmp" in |
389 |
try |
try |
390 |
(f filename : unit); |
(f filename : unit); |
391 |
Sys.remove filename |
Sys.remove filename |
392 |
with e -> lprintf |
with e -> lprintf_nl () |
393 |
"Exception %s in loading downloaded file %s" |
"Exception %s in loading downloaded file %s" |
394 |
(Printexc2.to_string e) filename; |
(Printexc2.to_string e) filename; |
395 |
Sys.remove filename; |
Sys.remove filename; |
396 |
raise Not_found |
raise Not_found |
397 |
) |
) |
398 |
with e -> lprintf "Http_client: error in wget\n"; raise Not_found |
with e -> lprintf_nl () "error in wget"; raise Not_found |
399 |
|
|
400 |
let whead r f = |
let whead r f = |
401 |
|
|
402 |
get_page r |
get_page r |
403 |
(fun maxlen headers -> |
(fun maxlen headers -> |
404 |
lprintf "Http_client.headers...\n"; |
lprintf_nl () "headers..."; |
405 |
(try f headers with _ -> ()); |
(try f headers with _ -> ()); |
406 |
fun sock nread -> |
fun sock nread -> |
407 |
close sock Closed_by_user |
close sock Closed_by_user |
459 |
String.sub s (pos+1) (len-pos-1), key |
String.sub s (pos+1) (len-pos-1), key |
460 |
) headers |
) headers |
461 |
with e -> |
with e -> |
462 |
lprintf "Exception in cut_headers: %s\n" (Printexc2.to_string e); |
lprintf_nl () "Exception in cut_headers: %s" (Printexc2.to_string e); |
463 |
raise e |
raise e |