28 |
open Url |
open Url |
29 |
open TcpBufferedSocket |
open TcpBufferedSocket |
30 |
|
|
31 |
|
|
32 |
type http_request = |
type http_request = |
33 |
GET |
GET |
34 |
| POST |
| POST |
38 |
| TRACE |
| TRACE |
39 |
|
|
40 |
let verbose = ref false |
let verbose = ref false |
41 |
|
|
42 |
(* |
(* |
43 |
| OPTIONS of url option (* None = '*' *) |
| OPTIONS of url option (* None = '*' *) |
44 |
| CONNECT of string * int |
| CONNECT of string * int |
45 |
*) |
*) |
46 |
|
|
47 |
type request = { |
type request = { |
48 |
req_headers : ( string * string ) list; |
req_headers : ( string * string ) list; |
49 |
req_user_agent : string; |
req_user_agent : string; |
92 |
url); |
url); |
93 |
Printf.bprintf res " HTTP/1.0\r\nHost: %s%s\r\n" url.server (if url.port != 80 then Printf.sprintf ":%d" url.port else ""); |
Printf.bprintf res " HTTP/1.0\r\nHost: %s%s\r\n" url.server (if url.port != 80 then Printf.sprintf ":%d" url.port else ""); |
94 |
List.iter (fun (a,b) -> |
List.iter (fun (a,b) -> |
95 |
Printf.bprintf res "%s: %s\r\n" a b |
Printf.bprintf res "%s: %s\r\n" a b |
96 |
) r.req_headers; |
) r.req_headers; |
97 |
Printf.bprintf res "User-Agent: %s\r\n" r.req_user_agent; |
Printf.bprintf res "User-Agent: %s\r\n" r.req_user_agent; |
98 |
Printf.bprintf res "Accept: %s\r\n" r.req_accept; |
Printf.bprintf res "Accept: %s\r\n" r.req_accept; |
99 |
Printf.bprintf res "Connection: close\r\n"; |
Printf.bprintf res "Connection: close\r\n"; |
100 |
(match r.req_referer with None -> () |
(match r.req_referer with None -> () |
101 |
| Some url -> |
| Some url -> |
102 |
Printf.bprintf res "Referer: %s\r\n" (Url.to_string_no_args url)); |
Printf.bprintf res "Referer: %s\r\n" (Url.to_string_no_args url)); |
103 |
if is_real_post then begin |
if is_real_post then begin |
104 |
let post = Buffer.create 80 in |
let post = Buffer.create 80 in |
105 |
let rec make_post = function |
let rec make_post = function |
155 |
headers_handler sock ans_code headers; |
headers_handler sock ans_code headers; |
156 |
with _ -> |
with _ -> |
157 |
TcpBufferedSocket.close sock (Closed_for_error "bad header") |
TcpBufferedSocket.close sock (Closed_for_error "bad header") |
158 |
|
|
159 |
let read_header header_handler sock nread = |
let read_header header_handler sock nread = |
160 |
let b = TcpBufferedSocket.buf sock in |
let b = TcpBufferedSocket.buf sock in |
161 |
let end_pos = b.pos + b.len in |
let end_pos = b.pos + b.len in |
162 |
let new_pos = end_pos - nread in |
let new_pos = end_pos - nread in |
163 |
let new_pos = maxi 0 (new_pos - 1) in |
let new_pos = maxi 0 (new_pos - 1) in |
164 |
(* |
(* |
165 |
lprintf "received [%s]" (String.escaped |
lprintf "received [%s]" (String.escaped |
166 |
(String.sub b.buf new_pos nread)); |
(String.sub b.buf new_pos nread)); |
167 |
*) |
*) |
168 |
let rec iter i = |
let rec iter i = |
174 |
let len = i + 2 - b.pos in |
let len = i + 2 - b.pos in |
175 |
let header = String.sub b.buf b.pos len in |
let header = String.sub b.buf b.pos len in |
176 |
buf_used b len; |
buf_used b len; |
177 |
header_handler sock header |
header_handler sock header |
178 |
else |
else |
179 |
if c = '\r' && i <= end_pos - 3 && b.buf.[i+2] = '\n' then |
if c = '\r' && i <= end_pos - 3 && b.buf.[i+2] = '\n' then |
180 |
let len = i + 3 - b.pos in |
let len = i + 3 - b.pos in |
197 |
|
|
198 |
let get_page r content_handler f = |
let get_page r content_handler f = |
199 |
let rec get_url level r = |
let rec get_url level r = |
200 |
|
|
201 |
let url = r.req_url in |
let url = r.req_url in |
202 |
(* |
(* |
203 |
let args = ref [] in |
let args = ref [] in |
205 |
let ispost = ref false in |
let ispost = ref false in |
206 |
let timeout = ref 300.0 in |
let timeout = ref 300.0 in |
207 |
let proxy = ref None in |
let proxy = ref None in |
208 |
List.iter (function |
List.iter (function |
209 |
| Args l -> args := l@ !args |
| Args l -> args := l@ !args |
210 |
| Headers l -> headers := l @ !headers; |
| Headers l -> headers := l @ !headers; |
211 |
| Post -> ispost := true |
| Post -> ispost := true |
230 |
let token = create_token unlimited_connection_manager in |
let token = create_token unlimited_connection_manager in |
231 |
let sock = TcpBufferedSocket.connect token "http client connecting" |
let sock = TcpBufferedSocket.connect token "http client connecting" |
232 |
(Ip.to_inet_addr ip) |
(Ip.to_inet_addr ip) |
233 |
port (fun _ e -> |
port (fun _ e -> |
234 |
() |
() |
235 |
(* lprintf "Event %s\n" |
(* lprintf "Event %s\n" |
236 |
(match e with |
(match e with |
253 |
if !verbose then |
if !verbose then |
254 |
lprintf "Http_client.get_page: %s\n" (String.escaped request); |
lprintf "Http_client.get_page: %s\n" (String.escaped request); |
255 |
TcpBufferedSocket.write_string sock request; |
TcpBufferedSocket.write_string sock request; |
256 |
TcpBufferedSocket.set_reader sock (http_reply_handler nread |
TcpBufferedSocket.set_reader sock (http_reply_handler nread |
257 |
(default_headers_handler url level)); |
(default_headers_handler url level)); |
258 |
set_rtimeout sock 5.; |
set_rtimeout sock 5.; |
259 |
TcpBufferedSocket.set_closer sock (fun _ _ -> () |
TcpBufferedSocket.set_closer sock (fun _ _ -> () |
260 |
(* lprintf "Connection closed nread:%b\n" !nread; *) |
(* lprintf "Connection closed nread:%b\n" !nread; *) |
261 |
) |
) |
262 |
) |
) |
263 |
|
|
264 |
and default_headers_handler old_url level sock ans_code headers = |
and default_headers_handler old_url level sock ans_code headers = |
265 |
let print_headers () = |
let print_headers () = |
266 |
List.iter |
List.iter |
280 |
(* lprintf "default_headers_handler closer\n"; *) |
(* lprintf "default_headers_handler closer\n"; *) |
281 |
f () |
f () |
282 |
); |
); |
283 |
|
|
284 |
let content_length = ref (-1) in |
let content_length = ref (-1) in |
285 |
List.iter (fun (name, content) -> |
List.iter (fun (name, content) -> |
286 |
if String.lowercase name = "content-length" then |
if String.lowercase name = "content-length" then |
294 |
set_reader sock content_handler; |
set_reader sock content_handler; |
295 |
let buf = TcpBufferedSocket.buf sock in |
let buf = TcpBufferedSocket.buf sock in |
296 |
if buf.len > 0 then |
if buf.len > 0 then |
297 |
content_handler sock buf.len |
content_handler sock buf.len |
298 |
|
|
299 |
| 301 | 302 | 304 -> |
| 301 | 302 | 304 -> |
300 |
if !verbose then lprintf "Http_client %d: Redirect\n" ans_code; |
if !verbose then lprintf "Http_client %d: Redirect\n" ans_code; |
301 |
if level < 10 then |
if level < 10 then |
323 |
with e -> |
with e -> |
324 |
lprintf "Http_client: error understanding redirect response %d\n" ans_code; |
lprintf "Http_client: error understanding redirect response %d\n" ans_code; |
325 |
print_headers () |
print_headers () |
326 |
|
|
327 |
end |
end |
328 |
else lprintf "Http_client: more than 10 redirections, aborting." |
else lprintf "Http_client: more than 10 redirections, aborting." |
329 |
|
|
330 |
| 404 -> |
| 404 -> |
331 |
lprintf "Http_client 404: Not found %s\n" (Url.to_string_no_args r.req_url); |
lprintf "Http_client 404: Not found %s\n" (Url.to_string_no_args r.req_url); |
332 |
close sock (Closed_for_error "bad reply"); |
close sock (Closed_for_error "bad reply"); |
333 |
raise Not_found |
raise Not_found |
334 |
|
|
335 |
| _ -> |
| _ -> |
336 |
lprintf "Http_client: bad reply %d for: %s\n" |
lprintf "Http_client: bad reply %d for: %s\n" |
337 |
ans_code (Url.to_string_no_args r.req_url); |
ans_code (Url.to_string_no_args r.req_url); |
340 |
|
|
341 |
in get_url 0 r |
in get_url 0 r |
342 |
|
|
343 |
|
|
344 |
let wget r f = |
let wget r f = |
345 |
|
|
346 |
let file_buf = Buffer.create 1000 in |
let file_buf = Buffer.create 1000 in |
347 |
let file_size = ref 0 in |
let file_size = ref 0 in |
375 |
close_out oc; |
close_out oc; |
376 |
try |
try |
377 |
(f filename : unit); |
(f filename : unit); |
378 |
Sys.remove filename |
Sys.remove filename |
379 |
with e -> lprintf |
with e -> lprintf |
380 |
"Exception %s in loading downloaded file %s" |
"Exception %s in loading downloaded file %s" |
381 |
(Printexc2.to_string e) filename; |
(Printexc2.to_string e) filename; |
382 |
Sys.remove filename |
Sys.remove filename |
383 |
) |
) |
384 |
|
|
385 |
let whead r f = |
let whead r f = |
386 |
|
|
387 |
get_page r |
get_page r |
388 |
(fun maxlen headers -> |
(fun maxlen headers -> |
389 |
lprintf "Http_client.headers...\n"; |
lprintf "Http_client.headers...\n"; |
392 |
close sock Closed_by_user |
close sock Closed_by_user |
393 |
) |
) |
394 |
(fun _ -> ()) |
(fun _ -> ()) |
395 |
|
|
396 |
let wget_string r f progress = |
let wget_string r f progress = |
397 |
|
|
398 |
let file_buf = Buffer.create 1000 in |
let file_buf = Buffer.create 1000 in |
399 |
let file_size = ref 0 in |
let file_size = ref 0 in |
419 |
f (Buffer.contents file_buf) |
f (Buffer.contents file_buf) |
420 |
) |
) |
421 |
|
|
422 |
|
|
423 |
let split_header header = |
let split_header header = |
424 |
for i = 0 to String.length header - 1 do |
for i = 0 to String.length header - 1 do |
425 |
if header.[i] = '\r' then header.[i] <- '\n'; |
if header.[i] = '\r' then header.[i] <- '\n'; |
426 |
done; |
done; |
446 |
with e -> |
with e -> |
447 |
lprintf "Exception in cut_headers: %s\n" (Printexc2.to_string e); |
lprintf "Exception in cut_headers: %s\n" (Printexc2.to_string e); |
448 |
raise e |
raise e |
|
|
|