/[mldonkey]/mldonkey/src/utils/net/http_client.ml
ViewVC logotype

Diff of /mldonkey/src/utils/net/http_client.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.18 by spiralvoice, Sun Apr 24 19:44:16 2005 UTC revision 1.19 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 28  open Unix Line 28  open Unix
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
# Line 38  type http_request = Line 38  type http_request =
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;
# Line 92  let make_full_request r = Line 92  let make_full_request r =
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
# Line 155  let parse_header headers_handler sock he Line 155  let parse_header headers_handler sock he
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 =
# Line 174  let read_header header_handler sock nrea Line 174  let read_header header_handler sock nrea
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
# Line 197  let http_reply_handler nr headers_handle Line 197  let http_reply_handler nr headers_handle
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
# Line 205  let get_page r content_handler f = Line 205  let get_page r content_handler f =
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
# Line 230  let get_page r content_handler f = Line 230  let get_page r content_handler f =
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
# Line 253  let get_page r content_handler f = Line 253  let get_page r content_handler f =
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
# Line 280  let get_page r content_handler f = Line 280  let get_page r content_handler f =
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
# Line 294  let get_page r content_handler f = Line 294  let get_page r content_handler f =
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
# Line 323  let get_page r content_handler f = Line 323  let get_page r content_handler f =
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);
# Line 340  let get_page r content_handler f = Line 340  let get_page r content_handler f =
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
# Line 375  let wget r f = Line 375  let wget r f =
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";
# Line 392  let whead r f = Line 392  let whead r f =
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
# Line 419  let wget_string r f progress = Line 419  let wget_string r f progress =
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;
# Line 446  let cut_headers headers = Line 446  let cut_headers headers =
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
         

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.19

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26