/[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.23 by spiralvoice, Tue Aug 9 10:52:02 2005 UTC revision 1.24 by spiralvoice, Sun Aug 21 14:26:00 2005 UTC
# Line 48  type request = { Line 48  type request = {
48      req_url : url;      req_url : url;
49      req_request : http_request;      req_request : http_request;
50      req_referer : Url.url option;      req_referer : Url.url option;
51        req_retry : int;
52        req_max_retry : int;
53    }    }
54    
55  type content_handler =  type content_handler =
# Line 66  let basic_request = { Line 68  let basic_request = {
68      req_headers = [];      req_headers = [];
69      req_user_agent = "Wget 1.4";      req_user_agent = "Wget 1.4";
70      req_accept = "*/*";      req_accept = "*/*";
71        req_retry = 0;
72        req_max_retry = 0;
73    }    }
74                
75  let make_full_request r =  let make_full_request r =
# Line 194  let http_reply_handler nr headers_handle Line 198  let http_reply_handler nr headers_handle
198    nr := true;    nr := true;
199    read_header (parse_header headers_handler) sock nread    read_header (parse_header headers_handler) sock nread
200        
201  let get_page r content_handler f =  let rec get_page r content_handler f =
202    let error = ref false in    let error = ref false in
203    let rec get_url level r =    let rec get_url level r =
204    try    try
205      let url = r.req_url in      let url = r.req_url in
206  (*      let level = r.req_retry in
     let args = ref [] in  
     let headers = ref [] in  
     let ispost = ref false in  
     let timeout = ref 300.0 in  
     let proxy = ref None in  
     List.iter (function  
       | Args l -> args := l@ !args  
       | Headers l -> headers := l @ !headers;  
       | Post -> ispost := true  
       | Proxy (h,p) -> proxy := Some (h,p)  
     ) get_args;  
     let args = !args in  
     let headers = !headers in  
     let ispost = !ispost in  
     let proxy = !proxy in  
 *)      
207      let request = make_full_request r in      let request = make_full_request r in
208            
209            
# Line 303  let get_page r content_handler f = Line 291  let get_page r content_handler f =
291    
292      | 301 | 302 | 304 ->      | 301 | 302 | 304 ->
293          if !verbose then lprintf_nl () "%d: Redirect" ans_code;          if !verbose then lprintf_nl () "%d: Redirect" ans_code;
294          if level < 10 then          let retrynum = r.req_retry in
295            if retrynum < r.req_max_retry then
296            begin            begin
297              try              try
298                let url = ref "" in                let url = ref "" in
# Line 322  let get_page r content_handler f = Line 311  let get_page r content_handler f =
311                      old_url.Url.server old_url.Url.port !url                      old_url.Url.server old_url.Url.port !url
312                in                in
313                if !verbose then lprintf_nl () "Redirected to %s" url;                if !verbose then lprintf_nl () "Redirected to %s" url;
314                let r = { r with req_url = Url.of_string url } in                let r = { r with
315                get_url (level+1) r                          req_url = Url.of_string url;
316                            req_retry = retrynum+1 }
317                  in
318                  get_page r content_handler f
319                            
320              with e ->              with e ->
321                  lprintf_nl () "error understanding redirect response %d" ans_code;                  lprintf_nl () "error understanding redirect response %d" ans_code;
# Line 332  let get_page r content_handler f = Line 324  let get_page r content_handler f =
324                                    
325            end            end
326          else          else
327            lprintf_nl () "more than 10 redirections, aborting.";            lprintf_nl () "more than %d redirections, aborting." r.req_max_retry;
328            raise Not_found            raise Not_found
329                        
330      | 404 ->      | 404 ->
# Line 340  let get_page r content_handler f = Line 332  let get_page r content_handler f =
332          close sock (Closed_for_error "bad reply");          close sock (Closed_for_error "bad reply");
333          raise Not_found          raise Not_found
334    
335        | 502 | 503 | 504 ->
336            if !verbose then lprintf_nl () "%d: Unavailable" ans_code;
337            let retrynum = r.req_retry in
338            if retrynum < r.req_max_retry then
339              begin
340                if !verbose then
341                  print_headers ();
342                let seconds = (retrynum+1)*10 in
343                  lprintf_nl () "retry %d/%d in %d seconds for %s"
344                    (retrynum+1) r.req_max_retry seconds (Url.to_string_no_args r.req_url);
345                let r = { r with req_retry = retrynum+1 } in
346                  add_timer (float(seconds)) (fun t -> get_page r content_handler f)
347              end
348            else
349              lprintf_nl () "more than %d retries, aborting." r.req_max_retry;
350              raise Not_found
351              
352      | _ ->      | _ ->
353          lprintf_nl () "%d: bad reply for: %s"          lprintf_nl () "%d: bad reply for: %s"
354            ans_code (Url.to_string_no_args r.req_url);            ans_code (Url.to_string_no_args r.req_url);
355          close sock (Closed_for_error "bad reply");          close sock (Closed_for_error "bad reply");
356          raise Not_found          raise Not_found
357    in    in
358    get_url 0 r;    get_url 0 r;
359    if !error = true then begin    if !error = true then begin
360        lprintf_nl () "failed!";        lprintf_nl () "failed!";
# Line 396  let wget r f = Line 405  let wget r f =
405            Sys.remove filename;            Sys.remove filename;
406            raise Not_found            raise Not_found
407    )    )
408    with e -> lprintf_nl () "error in wget"; raise Not_found    with e -> lprintf_nl () "Exception %s in wget" (Printexc2.to_string e); raise Not_found
409    
410  let whead r f =  let whead r f =
411        

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

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