/[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.20 by spiralvoice, Thu Jul 14 14:02:28 2005 UTC revision 1.21 by spiralvoice, Fri Jul 22 10:58:55 2005 UTC
# Line 39  type http_request = Line 39  type http_request =
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;
# Line 58  type request = { Line 53  type request = {
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;
# Line 117  let make_full_request r = Line 116  let make_full_request r =
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 =
# Line 139  let parse_header headers_handler sock he Line 138  let parse_header headers_handler sock he
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
# Line 255  let get_page r content_handler f = Line 254  let get_page r content_handler f =
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));
# Line 265  let get_page r content_handler f = Line 264  let get_page r content_handler f =
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 (); *)
# Line 293  let get_page r content_handler f = Line 292  let get_page r content_handler f =
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
# Line 303  let get_page r content_handler f = Line 302  let get_page r content_handler f =
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
# Line 322  let get_page r content_handler f = Line 321  let get_page r content_handler f =
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        
# Line 379  let wget r f = Line 378  let wget r f =
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
# Line 390  let wget r f = Line 389  let wget r f =
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
# Line 460  let cut_headers headers = Line 459  let cut_headers headers =
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

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21

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