mldonkey-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...


From: mldonkey-commits
Subject: [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...
Date: Tue, 30 May 2006 10:54:14 +0000

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Branch:         
Changes by:     spiralvoice <address@hidden>    06/05/30 10:54:14

Modified files:
        distrib        : ChangeLog 
        src/daemon/common: commonFile.ml 
        src/networks/fileTP: fileTPClients.ml fileTPFTP.ml 
                             fileTPGlobals.ml fileTPHTTP.ml 
                             fileTPInteractive.ml fileTPOptions.ml 
                             fileTPSSH.ml fileTPTypes.ml 
        src/utils/net  : http_client.ml http_client.mli 

Log message:
        patch #5136

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/distrib/ChangeLog.diff?tr1=1.854&tr2=1.855&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/daemon/common/commonFile.ml.diff?tr1=1.52&tr2=1.53&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPClients.ml.diff?tr1=1.20&tr2=1.21&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPFTP.ml.diff?tr1=1.12&tr2=1.13&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml.diff?tr1=1.25&tr2=1.26&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPHTTP.ml.diff?tr1=1.23&tr2=1.24&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPInteractive.ml.diff?tr1=1.38&tr2=1.39&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPOptions.ml.diff?tr1=1.10&tr2=1.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPSSH.ml.diff?tr1=1.9&tr2=1.10&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/networks/fileTP/fileTPTypes.ml.diff?tr1=1.10&tr2=1.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/http_client.ml.diff?tr1=1.32&tr2=1.33&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/mldonkey/mldonkey/src/utils/net/http_client.mli.diff?tr1=1.7&tr2=1.8&r1=text&r2=text

Patches:
Index: mldonkey/distrib/ChangeLog
diff -u mldonkey/distrib/ChangeLog:1.854 mldonkey/distrib/ChangeLog:1.855
--- mldonkey/distrib/ChangeLog:1.854    Fri May 26 11:18:33 2006
+++ mldonkey/distrib/ChangeLog  Tue May 30 10:54:14 2006
@@ -14,6 +14,18 @@
 ChangeLog
 =========
 
+2006/05/30
+5136: FileTP: fixes and enhancements (zet)
+* Add "FTP-chunk_size" option (0 = no chunks = download full file at once)
+-- A chunk_size would be required if downloading from > 1 source
+* Add FTP downloads to bandwidth controller (for stats & speed limiter)
+* Support FTP sites that do not buffer input (MS FTP)
+* Add support for user/pass (http://user:address@hidden or 
ftp://user:address@hidden).
+  This also adds user/pass support to http_client.
+* Error codes from HTTP (ie: 404) and some from FTP are supported (530 
sometimes
+  signals a retry, sometimes a login failure so a regex was used (lftp)).
+  Downloads are paused when a hard error is received (and noted in the log).
+
 2006/05/25
 5131: New option gui_log_size: number of lines for GUI console messages
 5129: HTML: Display client_bind_addr in options menu
Index: mldonkey/src/daemon/common/commonFile.ml
diff -u mldonkey/src/daemon/common/commonFile.ml:1.52 
mldonkey/src/daemon/common/commonFile.ml:1.53
--- mldonkey/src/daemon/common/commonFile.ml:1.52       Fri May 19 23:43:54 2006
+++ mldonkey/src/daemon/common/commonFile.ml    Tue May 30 10:54:14 2006
@@ -306,6 +306,7 @@
         ( "1", "srh br ac", "Client number", "Num" ) ;
         ( "0", "srh br", "Client Name", "Name" ) ;
         ( "0", "srh br", "IP address", "IP address" ) ;
+        ( "0", "srh br", "Client software", "CS" ) ;
         ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) 
;
         ( "1", "srh ar br", "Total DL bytes from this client for all files", 
"DL" ) ; ];
 
@@ -326,6 +327,7 @@
           ("", "sr br ar", Printf.sprintf "%d" (client_num c));
           ("", "sr br", cinfo.GuiTypes.client_name);
           ("", "sr br", addr);
+          ("", "sr br", cinfo.GuiTypes.client_software);
           ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_uploaded));
           ("", "sr ar br", (size_of_int64 cinfo.GuiTypes.client_downloaded)); 
];
 
Index: mldonkey/src/networks/fileTP/fileTPClients.ml
diff -u mldonkey/src/networks/fileTP/fileTPClients.ml:1.20 
mldonkey/src/networks/fileTP/fileTPClients.ml:1.21
--- mldonkey/src/networks/fileTP/fileTPClients.ml:1.20  Thu May 25 19:47:25 2006
+++ mldonkey/src/networks/fileTP/fileTPClients.ml       Tue May 30 10:54:14 2006
@@ -48,15 +48,24 @@
       (*
 let max_range_size = Int64.of_int (256 * 1024)
   *)
+(*
 let range_size file =  min_range_size
+*)
   (*
   let range =  file_size file // 10L in
   max (min range max_range_size) min_range_size
 *)
+
 let max_queued_ranges = 1
 
 let nranges file =
-  Int64.to_int ((file_size file) // min_range_size) + 5
+  let filesize = file_size file in
+  if (filesize = 0L || !!chunk_size = 0) then 1
+  else Int64.to_int ((filesize) // (min_range_size file)) + 5
+
+let pause_for_cause f r = 
+  lprintf_nl "Pausing file %s (%s)" (file_best_name f) r;
+  file_pause (as_file f)
 
 let disconnect_client c r =
   match c.client_sock with
@@ -138,15 +147,12 @@
         raise Not_found
     | d :: tail ->
         let file = d.download_file in
-        if file_size file = zero || file_state file  <> FileDownloading then
+        if file_size file = 0L || file_state file  <> FileDownloading then
           iter tail
         else begin
             if !verbose_msg_clients then begin
-                lprintf "FINDING ON CLIENT\n";
-              end;
-            let file = d.download_file in
-            if !verbose_msg_clients then begin
-                lprintf "FILE FOUND, ASKING\n";
+              lprintf "Finding on client %s %s\n" 
+               (Md4.to_string file.file_id) (file_best_name file);
               end;
 
             if !verbose_swarming then begin
@@ -188,10 +194,12 @@
                               lprintf "Current Block: "; 
CommonSwarming.print_block b;
                             end;
                           try
-                            let (x,y,r) = 
-                             CommonSwarming.find_range up min_range_size in
-(*                            lprintf "GOT RANGE:\n"; *)
-                            if !verbose_swarming then 
CommonSwarming.print_uploaders swarmer;
+                            let range_size = (min_range_size file) in
+                            let (x,y,r) = CommonSwarming.find_range up 
range_size in
+                            if !verbose_swarming then begin
+                              lprintf_nl "find_range: %Ld =  x: %Ld y: %Ld" 
range_size x y;
+                              CommonSwarming.print_uploaders swarmer;
+                            end;
 
                             d.download_ranges <- d.download_ranges @ [x,y,r];
 (*                        CommonSwarming.alloc_range r; *)
@@ -244,38 +252,37 @@
 (*      lprintf "connect_client... pending\n"; *)
       let token =
         add_pending_connection connection_manager (fun token ->
-            if List.exists (fun d ->
+            let exists = List.exists (fun d ->
                   let file = d.download_file in
                   file_state file = FileDownloading
               ) c.client_downloads
-            then
+            in
+            if exists then
               try
-                if !verbose_msg_clients then begin
-                    lprintf "connect_client\n";
-                  end;
-                if !verbose_msg_clients then begin
-                    lprintf "connecting %s:%d\n" c.client_hostname
-                      c.client_port;
-                  end;
+                if !verbose_msg_clients then 
+                  lprintf_nl "connecting %s:%d" c.client_hostname 
c.client_port;
                 c.client_reconnect <- false;
                 let sock = c.client_proto.proto_connect token c (fun sock ->
-
+                    try 
                       List.iter (fun d ->
                           let file = d.download_file in
-                          if file_size file <> zero then
+                          if file_size file <> 0L then begin
                             let swarmer = match file.file_swarmer with
                                 None -> assert false | Some sw -> sw
                             in
-                            let chunks = [ Int64.zero, file_size file ] in
+                            let chunks = [ 0L, file_size file ] in
                             let up = CommonSwarming.register_uploader swarmer
-                              (as_client c)
-                                (AvailableIntervals chunks) in
+                              (as_client c) (AvailableIntervals chunks) 
+                            in
                             d.download_uploader <- Some up
+                         end
                       ) c.client_downloads;
 
                       init_client c sock;
-                      get_from_client sock c
+                      get_from_client sock c;
 
+                    with e ->
+                        lprintf_nl "Exception %s" (Printexc2.to_string e);
                   )
                 in
                 set_client_state c Connecting;
@@ -285,7 +292,7 @@
                 );
                 set_rtimeout sock 30.;
                 if !verbose_msg_clients then begin
-                    lprintf "READY TO DOWNLOAD FILE\n";
+                    lprintf_nl "SET_SOCK_HANDLER" ;
                   end;
 
                 c.client_proto.proto_set_sock_handler c sock
@@ -326,9 +333,6 @@
 (*  lprintf "done\n"; *)
   ()
 
-let nranges file =
-  Int64.to_int ((file_size file) // min_range_size) + 5
-
 let manage_hosts () =
   List.iter (fun file ->
       if file_state file = FileDownloading then
@@ -336,24 +340,23 @@
 (* For each file, we allow only (nranges+5) simultaneous communications,
   to prevent too many clients from saturing the line for only one file. *)
           let max_nconnected_clients = nranges file in
-(*           lprintf "max_nconnected_clients: %d > %d\n" max_nconnected_clients
-           file.file_nconnected_clients; *)
+          (* lprintf_nl "%s %d | %d < %d" (Md4.to_string file.file_id) 
(Queue.length file.file_clients_queue) file.file_nconnected_clients 
max_nconnected_clients; *)
           while file.file_nconnected_clients < max_nconnected_clients do
             let (_,c) = Queue.take file.file_clients_queue in
             c.client_in_queues <- List2.removeq file c.client_in_queues;
-
-            if file_size file = zero then
+            if file_size file = 0L then
               let proto = c.client_proto in
               List.iter (fun d ->
                   if d.download_file == file then
                     let url = d.download_url in
-                    proto.proto_check_size url (fun size ->
+                    proto.proto_check_size file url (fun size ->
                         set_file_size file size;
-                        connect_client c
-                    )
+                      connect_client c;
+                    );
               ) c.client_downloads
-            else
+            else begin
               connect_client c
+            end
           done
         with _ -> ()
   ) !current_files
Index: mldonkey/src/networks/fileTP/fileTPFTP.ml
diff -u mldonkey/src/networks/fileTP/fileTPFTP.ml:1.12 
mldonkey/src/networks/fileTP/fileTPFTP.ml:1.13
--- mldonkey/src/networks/fileTP/fileTPFTP.ml:1.12      Sun Apr  9 00:27:04 2006
+++ mldonkey/src/networks/fileTP/fileTPFTP.ml   Tue May 30 10:54:14 2006
@@ -52,10 +52,32 @@
 (*                                                                       *)
 (*************************************************************************)
 
+let default_user = "anonymous"
+let default_pass = "-mldonkey@"
+
+let get_user url = 
+  let url_user = url.Url.user in
+  let user = if url_user <> "" 
+    then url_user 
+    else default_user
+  in user
+
+let get_pass url = 
+  let url_pass = url.Url.passwd in
+  let pass = if url_pass <> "" 
+    then "-" ^ url_pass 
+    else default_pass
+  in pass
+
+
+let reg530 = Str.regexp ".*not connect more.*\\|.*too 
many.*\\|.*overloaded.*\\|.*try \\(again \\|back \\)?later.*\\|.*is restricted 
to.*\\|.*maximum number.*\\|.*only.*session.*allowed.*\\|.*more connection.*"
+
+let retry_530 s = 
+  Str.string_match reg530 s 0  
+
 let range_reader c d counter_pos end_pos sock nread =
   if nread > 0 then
     let file = d.download_file in
-    lprintf ".";
     if file_state file <> FileDownloading then begin
         disconnect_client c Closed_by_user;
         raise Exit;
@@ -81,23 +103,21 @@
 
             let swarmer = CommonSwarming.uploader_swarmer up in
 
-            let old_downloaded =
-              CommonSwarming.downloaded swarmer in
+            let old_downloaded = CommonSwarming.downloaded swarmer in
 
-            CommonSwarming.received up
-              !counter_pos b.buf b.pos to_read_int;
-            let new_downloaded =
-              CommonSwarming.downloaded swarmer in
+            CommonSwarming.received up !counter_pos b.buf b.pos to_read_int;
+            let new_downloaded = CommonSwarming.downloaded swarmer in
 
            c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- 
old_downloaded);
+            client_must_update (as_client c);
 
             if new_downloaded = file_size file then
               download_finished file;
 
       with e ->
-        lprintf "FT: Exception %s in CommonSwarming.received\n"
-          (Printexc2.to_string e)
+        lprintf_nl "Exception %s in CommonSwarming.received" 
(Printexc2.to_string e)
   end;
+  c.client_failed_attempts <- 0;
   c.client_reconnect <- true;
 (*          List.iter (fun (_,_,r) ->
               CommonSwarming.alloc_range r) d.download_ranges; *)
@@ -119,20 +139,23 @@
       | (_,_,r) :: tail ->
           d.download_ranges <- tail;
 (* If we have no more range to receive, disconnect *)
-          lprintf "\n ********** RANGE DOWNLOADED  ********** \n";
+          if !verbose then lprintf_nl "RANGE DOWNLOADED";
           close sock Closed_by_user
-
     end
 
 let download_on_port c d (x,y) ip port =
+  if !verbose then 
+    lprintf_nl "download_on_port: %Ld %Ld %s %d" x y (Ip.to_string ip) port;
+
+  let file = d.download_file in
+  set_client_state c (Connected_downloading (file_num file));
+
   let token = create_token unlimited_connection_manager in
-  let sock = TcpBufferedSocket.connect token "http client connecting"
-      (Ip.to_inet_addr ip)
-    port (fun _ e ->
-        ()
-    )
+  let sock = TcpBufferedSocket.connect token "filetp passive"
+      (Ip.to_inet_addr ip) port (fun _ e -> ())
   in
   TcpBufferedSocket.set_reader sock (range_reader c d (ref x) y);
+  init_client c sock; 
   set_rtimeout sock 15.;
   TcpBufferedSocket.set_closer sock (fun _ _ ->
         disconnect_client c Closed_by_user;
@@ -141,7 +164,10 @@
 let write_reqs sock reqs =
 
   let buf = Buffer.create 100 in
-  List.iter (fun s -> Printf.bprintf buf "%s\r\n" s) reqs;
+  List.iter (fun s -> 
+    if !verbose then lprintf_nl "write_reqs: [%s]" s;
+    Printf.bprintf buf "%s\r\n" s
+  ) reqs;
   let request = Buffer.contents buf in
 
 (*
@@ -172,80 +198,128 @@
 
 let ftp_send_range_request c (x,y) sock d =
 
-  lprintf "FTP: Asking range %Ld-%Ld\n" x y ;
-
+  if !verbose then lprintf_nl "Asking range %Ld-%Ld" x y;
   let file = d.download_url.Url.full_file in
-  let reqs = [
-      Printf.sprintf "CWD %s" (Filename.dirname file);
-(* 250 *)
-      "PASV";
-(* 227 *)
-      Printf.sprintf "REST %Ld" x;
-(* 350 *)
-      Printf.sprintf "RETR %s" (Filename.basename file);
-(* 150 *)
-    ]
-  in
-
-  write_reqs sock reqs;
-
   TcpBufferedSocket.set_reader sock (fun sock nread ->
       let b = TcpBufferedSocket.buf sock in
+      if !verbose then 
+        AnyEndian.dump_hex (String.sub b.buf b.pos b.len);
       let rec iter i =
         if i < b.len then
           if b.buf.[b.pos + i] = '\n' then begin
-              let slen = if i > 0 && b.buf.[b.pos + i - 1] = '\r' then
-                  i - 1
-                else i in
+              let slen = if i > 0 && b.buf.[b.pos + i - 1] = '\r' 
+                then i - 1
+                else i 
+              in
               let line = String.sub b.buf b.pos slen in
-              lprintf "FTP LINE [%s]\n" line;
+              if !verbose then lprintf_nl "SRR LINE [%s]" line;
               buf_used b (i+1);
-              if slen > 4 && String.sub line 0 4 = "227 " then
-                try
+              if slen > 3 then begin
+                match (String.sub line 0 4) with
+                | "220-" -> iter 0
+                | "220 " ->
+                  let reqs = [Printf.sprintf "USER %s" (get_user 
d.download_url)] in
+                  write_reqs sock reqs;
+                | "331 " -> 
+                  let reqs = [Printf.sprintf "PASS %s" (get_pass 
d.download_url)] in
+                  write_reqs sock reqs;
+                | "230 " ->
+                  let reqs = ["SYST"] in
+                  write_reqs sock reqs;
+                | "215 " ->
+                  let sys = String.sub line 4 (slen - 4) in
+                  c.client_software <- sys;
+                  if c.client_failed_attempts < 15 then
+                    c.client_reconnect <- true;
+                  client_must_update (as_client c);
+                  let reqs = ["PWD"] in
+                  write_reqs sock reqs;
+                | "250 " -> 
+                  let reqs = ["PASV"] in
+                  write_reqs sock reqs;
+                | "257 " ->
+                  let reqs = ["TYPE I"] in
+                  write_reqs sock reqs;
+                | "200 " -> 
+                  let reqs = [Printf.sprintf "CWD %s" (Filename.dirname file)] 
in
+                  write_reqs sock reqs; 
+                | "227 " ->
+                  (try
                   let pos = String.index line '(' in
                   let line = String.sub line (pos+1) (slen - pos - 1) in
                   let pos = String.index line ')' in
                   let line = String.sub line 0 pos in
-                  match
-                    List.map int_of_string (
-                      String2.split_simplify line ',') with
-                    [a0;a1;a2;a3;p0;p1] ->
-                      let ip = Ip.of_string
-                          (Printf.sprintf "%d.%d.%d.%d" a0 a1 a2 a3) in
+                    (match List.map int_of_string (String2.split_simplify line 
',') with
+                    | [a0;a1;a2;a3;p0;p1] ->
+                      let ip = Ip.of_string (Printf.sprintf "%d.%d.%d.%d" a0 
a1 a2 a3) in
                       let port = (p0 lsl 8) lor p1 in
                       set_rtimeout sock 3600.;
-                      download_on_port c d (x,y) ip port
+                      download_on_port c d (x,y) ip port;
+                      let reqs = [Printf.sprintf "REST %Ld" x] in
+                      write_reqs sock reqs; 
                   | _ ->
-                      lprintf "FTP: cannot read ip address [%s]\n" line;
-                      close sock Closed_by_user
+                      lprintf_nl "Cannot read ip address [%s]\n" line;
+                      close sock Closed_by_user)
                 with e ->
-                    lprintf "FTP: Error %s in reader\n"
-                      (Printexc.to_string e);
-                    close sock Closed_by_user
-              else
-              if slen > 4 && String.sub line 0 4 = "150 " then begin
-                  lprintf "FTP: should initiate connection !\n"
-                end
-              else
-              if slen > 4 && String.sub line 0 4 = "426 " then begin
-                  lprintf "ASK ANOTHER CHUNK\n";
+                    lprintf_nl "Error %s in reader" (Printexc.to_string e);
+                    close sock Closed_by_user)
+                | "350 " ->  
+                    let reqs = [Printf.sprintf "RETR %s" (Filename.basename 
file)] in
+                    write_reqs sock reqs; 
+                | "150 " ->
+                    if !verbose then begin
+                      lprintf_nl "should initiate connection!";
+                      lprintf_nl "%s" line;
+                    end;
+                | "426 " ->
+                    if !verbose then lprintf_nl "ASK ANOTHER CHUNK";
                   set_rtimeout sock 15.;
                   (try get_from_client sock c with _ -> ());
-                end
-              else
-                iter 0
+                | "530 " ->
+                    let reason = String.sub line 4 (slen - 4) in
+                    if not (retry_530 reason) then begin
+                      pause_for_cause d.download_file "530";
+                    end else begin
+                      c.client_reconnect <- true;
+                    end;
+                    disconnect_client c Closed_by_user;
+                | "550 " ->
+                    pause_for_cause d.download_file "550";
+                    disconnect_client c Closed_by_user;
+                | _ -> 
+                    if !verbose then lprintf_nl "Unexpected line %s" line;
+                    iter 0;
+                  end else iter 0 
             end else
             iter (i+1)
       in
       iter 0
   );
-  set_rtimeout sock 15.;
+  set_rtimeout sock 30.;
   TcpBufferedSocket.set_closer sock (fun _ _ ->
-    lprintf "\n+++++++++++ DISCONNECTED ++++++++++++++\n"
-
+    if !verbose then lprintf_nl "DISCONNECTED";
   );
   ()
 
+
+  (*
+
+  let reqs = [
+      Printf.sprintf "CWD %s" (Filename.dirname file);
+(* 250 *)
+      "PASV";
+(* 227 *)
+      Printf.sprintf "REST %Ld" x;
+(* 350 *)
+      Printf.sprintf "RETR %s" (Filename.basename file);
+(* 150 *)
+    ]
+  in
+
+  write_reqs sock reqs;
+
+*)
+
 (*************************************************************************)
 (*                                                                       *)
 (*                         MAIN                                          *)
@@ -253,7 +327,15 @@
 (*************************************************************************)
 
 let ftp_set_sock_handler c sock =
-
+  if !verbose then begin
+    let ip = 
+      try 
+        Ip.to_string (peer_ip sock)
+      with _ -> "Unknown"
+    in
+    lprintf_nl "ftp_set_sock_handler %s" ip;
+  end 
+(*
   write_reqs sock
     [
 (* 220 messages... *)
@@ -268,6 +350,7 @@
     "TYPE I";
 (* 200 *)
   ]
+*)
  (*  set_fileTP_sock sock (HttpHeader (client_parse_header c)) *)
 
 (*************************************************************************)
@@ -276,8 +359,9 @@
 (*                                                                       *)
 (*************************************************************************)
 
-let ftp_check_size url start_download_file =
+let ftp_check_size file url start_download_file =
 
+(*
   let reqs = [
 (* 220 messages... *)
       "USER anonymous";
@@ -297,49 +381,85 @@
     ]
   in
 
-  let buf = Buffer.create 100 in
-  List.iter (fun s -> Printf.bprintf buf "%s\r\n" s) reqs;
-  let request = Buffer.contents buf in
+*)
 
+  let dirname =  Filename.dirname url.Url.full_file in
+  let basename = Filename.basename url.Url.full_file in
   let server, port = url.Url.server, url.Url.port in
 (*    lprintf "async_ip ...\n"; *)
   Ip.async_ip server (fun ip ->
 (*        lprintf "IP done %s:%d\n" (Ip.to_string ip) port; *)
       let token = create_token unlimited_connection_manager in
-      let sock = TcpBufferedSocket.connect token "http client connecting"
-          (Ip.to_inet_addr ip)
-        port (fun _ e ->
-            ()
-        )
+      let sock = TcpBufferedSocket.connect token "ftp client check size"
+          (Ip.to_inet_addr ip) port (fun _ e -> ())
       in
-      TcpBufferedSocket.write_string sock request;
+(*      write_reqs sock reqs; *)
       TcpBufferedSocket.set_reader sock (fun sock nread ->
           let b = TcpBufferedSocket.buf sock in
+          if !verbose then
+             AnyEndian.dump_hex (String.sub b.buf b.pos b.len);
           let rec iter i =
             if i < b.len then
               if b.buf.[b.pos + i] = '\n' then begin
-                  let slen = if i > 0 && b.buf.[b.pos + i - 1] = '\r' then
-                      i - 1
-                    else i in
+                  let slen = if i > 0 && b.buf.[b.pos + i - 1] = '\r' 
+                    then i - 1
+                    else i 
+                  in
+
                   let line = String.sub b.buf b.pos slen in
-                  lprintf "FTP LINE [%s]\n" line;
+                  if !verbose then lprintf_nl "CS LINE [%s]" line;
                   buf_used b (i+1);
-                  if slen > 4 && String.sub line 0 4 = "213 "
-                  then begin
+                  if slen > 3 then begin
+                    match (String.sub line 0 4) with
+                    | "220-" -> iter 0
+                    | "220 " ->
+                      let reqs = [Printf.sprintf "USER %s" (get_user url)] in
+                      write_reqs sock reqs;
+                    | "331 " -> 
+                      let reqs = [Printf.sprintf "PASS %s" (get_pass url)] in
+                      write_reqs sock reqs;
+                    | "230 " ->
+                      let reqs = ["SYST"] in
+                      write_reqs sock reqs;
+                    | "215 " ->
+                      let reqs = ["PWD"] in
+                      write_reqs sock reqs;
+                    | "257 " ->
+                      let reqs = ["TYPE I"] in
+                      write_reqs sock reqs;
+                    | "200 " ->
+                      let reqs = [Printf.sprintf "CWD %s" dirname] in
+                      write_reqs sock reqs;
+                    | "250 " -> 
+                      let reqs = [Printf.sprintf "SIZE %s" basename] in
+                      write_reqs sock reqs;
+                    | "213 " ->
                       let result_size =
                         Int64.of_string (String.sub line 4 (slen - 4))
                       in
-                      lprintf "SIZE: [%Ld]\n" result_size;
+                      if !verbose then lprintf_nl "FOUND SIZE %s: [%Ld]" 
basename result_size;
+                      close sock Closed_by_user;  (* Disconnect so 
connect_client connects *)
                       start_download_file result_size;
-                      close sock Closed_by_user
-                    end else
-                  iter 0
-                end else
+                    | "530 " ->
+                      let reason = String.sub line 4 (slen - 4) in
+                      if not (retry_530 reason) then begin
+                        pause_for_cause file "530";
+                      end;
+                      close sock Closed_by_user;
+                    | "550 " ->
+                      pause_for_cause file "550";
+                      close sock Closed_by_user;
+                    | _ -> 
+                      if !verbose then lprintf_nl "Unexpected line %s" line;
+                      iter 0;
+                  end else iter 0 
+              end
+            else
                 iter (i+1)
           in
           iter 0
       );
-      set_rtimeout sock 15.;
+      set_rtimeout sock 30.;
       TcpBufferedSocket.set_closer sock (fun _ _ -> ()
 (*        lprintf "Connection closed nread:%b\n" !nread; *)
       )
@@ -359,10 +479,12 @@
       (fun sock event ->
         match event with
           BASIC_EVENT (RTIMEOUT|LTIMEOUT) ->
+            if (c.client_failed_attempts < 15) then
+              c.client_reconnect <- true;
+            c.client_failed_attempts <- c.client_failed_attempts + 1;
             disconnect_client c Closed_for_timeout
         | BASIC_EVENT (CLOSED s) ->
             disconnect_client c s
-
         | CONNECTED ->
           f sock
         | _ -> ()
Index: mldonkey/src/networks/fileTP/fileTPGlobals.ml
diff -u mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.25 
mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.26
--- mldonkey/src/networks/fileTP/fileTPGlobals.ml:1.25  Thu May 25 19:47:25 2006
+++ mldonkey/src/networks/fileTP/fileTPGlobals.ml       Tue May 30 10:54:14 2006
@@ -98,6 +98,15 @@
 let clients_by_uid = Hashtbl.create 127
 let protos_by_name = Hashtbl.create 13
 
+
+let _ =
+Heap.add_memstat "FileTPGlobals" (fun level buf ->
+      Printf.bprintf buf "  current_files: %d\n" (List.length !current_files);
+      Printf.bprintf buf "  file_by_uid: %d\n" (Hashtbl.length files_by_uid);
+      Printf.bprintf buf "  clients_by_uid: %d\n" (Hashtbl.length 
clients_by_uid);
+      Printf.bprintf buf "  protos_by_name: %d\n" (Hashtbl.length 
protos_by_name);
+  )
+
 let find_proto (name : string) =
   (Hashtbl.find protos_by_name name : tp_proto)
 
@@ -107,25 +116,26 @@
 
 ****************************************************************)
 
+(*
 let min_range_size = megabyte
+*)
+let min_range_size file = 
+  if !!chunk_size = 0 
+    then (file_size file) 
+    else Int64.of_int !!chunk_size
 
 let set_file_size file size =
-  if file_size file = zero && size <> zero then begin
-      let file_chunk_size =
-        max megabyte (
-          1L ++ size // (max 5L (1L ++ size // (megabytes 5)))
-        )
-      in
+  if file_size file = 0L && size <> 0L then begin
       file.file_file.impl_file_size <- size;
+      let file_chunk_size = min_range_size file in
       let file_temp = Unix32.filename (file_fd file) in
       let kernel = CommonSwarming.create_swarmer file_temp size in
-      let swarmer = CommonSwarming.create kernel (as_file file)
-          file_chunk_size in
+      let swarmer = CommonSwarming.create kernel (as_file file) 
file_chunk_size in
       file.file_swarmer <- Some swarmer;
       CommonSwarming.set_verified swarmer (fun _ _ ->
           file_must_update (as_file file);
       );
-      file_must_update (as_file file)
+      file_must_update (as_file file);
     end
 
 let new_file file_id file_name file_size =
@@ -185,6 +195,8 @@
           client_in_queues = [];
           client_connected_for = None;
           client_proto = proto;
+          client_software = "";
+          client_failed_attempts = 0;
         } and impl = {
           dummy_client_impl with
           impl_client_val = c;
@@ -261,6 +273,10 @@
 let set_client_disconnected client =
   CommonClient.set_client_disconnected (as_client client)
 
+let client_remove c =
+  let key = (c.client_hostname, c.client_port) in
+  Hashtbl.remove clients_by_uid key;
+  CommonClient.client_remove (as_client c)
 
 let remove_file file =
   Hashtbl.remove files_by_uid file.file_id;
@@ -285,4 +301,3 @@
     end;
   !ft_client_name
 
-let file_chunk_size = 307200
Index: mldonkey/src/networks/fileTP/fileTPHTTP.ml
diff -u mldonkey/src/networks/fileTP/fileTPHTTP.ml:1.23 
mldonkey/src/networks/fileTP/fileTPHTTP.ml:1.24
--- mldonkey/src/networks/fileTP/fileTPHTTP.ml:1.23     Fri May 19 23:43:54 2006
+++ mldonkey/src/networks/fileTP/fileTPHTTP.ml  Tue May 30 10:54:14 2006
@@ -84,6 +84,11 @@
   Printf.bprintf buf "Referer: %s\r\n" c.client_referer;
   Printf.bprintf buf "Range: bytes=%s\r\n" range;
   Printf.bprintf buf "Connection: Keep-Alive\r\n";
+  if url.Url.user <> "" then begin
+    let userpass = Printf.sprintf "%s:%s" url.Url.user url.Url.passwd in
+    let encoded = Base64.encode userpass in
+    Printf.bprintf buf "Authorization: Basic %s\r\n" encoded
+  end;
   Printf.bprintf buf "\r\n";
   let s = Buffer.contents buf in
   if !verbose_msg_clients then
@@ -99,6 +104,23 @@
 (*                                                                       *)
 (*************************************************************************)
 
+
+let parse_line header = 
+  let endline_pos = String.index header '\n' in
+  let http, code =
+    match String2.split (String.sub header 0 endline_pos) ' ' with
+    | http :: code :: ok :: _ ->
+      let code = int_of_string code in
+      if not (String2.starts_with (String.lowercase http) "http") 
+        then failwith "Not in http protocol"; 
+      http, code
+    | _ -> 
+      failwith "Not a HTTP header line"
+    in
+  http, code
+
+
+
 let rec client_parse_header c gconn sock header =
   if !verbose_msg_clients then
     lprintf_nl "CLIENT PARSE HEADER";
@@ -120,17 +142,7 @@
     let file = d.download_file in
     let size = file_size file in
 
-    let endline_pos = String.index header '\n' in
-    let http, code =
-      match String2.split (String.sub header 0 endline_pos
-        ) ' ' with
-      | http :: code :: ok :: _ ->
-          let code = int_of_string code in
-          if not (String2.starts_with (String.lowercase http) "http") then
-            failwith "Not in http protocol";
-          http, code
-      | _ -> failwith "Not a HTTP header line"
-    in
+    let http, code = parse_line header in
     if !verbose_msg_clients then
       lprintf_nl "GOOD HEADER FROM CONNECTED CLIENT\n";
 
@@ -161,8 +173,10 @@
           end;
       end;
 
-    if  code < 200 || code > 299 then
+    if code < 200 || code > 299 then begin
+      pause_for_cause file (Printf.sprintf "%d" code);
       failwith "Bad HTTP code";
+    end;
 
     let start_pos, end_pos =
       try
@@ -235,6 +249,13 @@
             (String.escaped header)
     );
 
+    (try
+        let (server,_) = List.assoc "server" headers in
+        c.client_software <- server;
+        client_must_update (as_client c);
+      with _ -> ()
+    );
+
     set_client_state c (Connected_downloading (file_num file));
     let counter_pos = ref start_pos in
 (* Send the next request *)
@@ -253,36 +274,34 @@
           (Int64.of_int b.len) in
 
         let to_read_int = Int64.to_int to_read in
-(*
-        if !verbose then lprintf "CHUNK: %s\n"
-          (String.escaped (String.sub b.buf b.pos to_read_int)); *)
-        let swarmer = match file.file_swarmer with
-            None -> assert false | Some sw -> sw
-        in
-(*        List.iter (fun (_,_,r) -> CommonSwarming.free_range r)
-        d.download_ranges; *)
-
-        let old_downloaded =
-          CommonSwarming.downloaded swarmer in
 
         begin
           try
             match d.download_uploader with
               None -> assert false
             | Some up ->
-                CommonSwarming.received up
-                  !counter_pos b.buf b.pos to_read_int;
+    
+            let swarmer = CommonSwarming.uploader_swarmer up in
+
+            let old_downloaded = CommonSwarming.downloaded swarmer in
+
+            CommonSwarming.received up !counter_pos b.buf b.pos to_read_int;
+            let new_downloaded = CommonSwarming.downloaded swarmer in
+
+            c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- 
old_downloaded);
+            client_must_update (as_client c);
+
+            if new_downloaded = file_size file then
+              download_finished file;
+
           with e ->
               lprintf_nl "Exception %s in CommonSwarming.received"
                 (Printexc2.to_string e)
         end;
+
         c.client_reconnect <- true;
 (*          List.iter (fun (_,_,r) ->
               CommonSwarming.alloc_range r) d.download_ranges; *)
-        let new_downloaded =
-          CommonSwarming.downloaded swarmer in
-
-        c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- 
old_downloaded);
 
         (match d.download_ranges with
             [] -> lprintf_nl "EMPTY Ranges!"
@@ -297,8 +316,6 @@
               ()
         );
 
-        if new_downloaded = file_size file then
-          download_finished file;
 (*
 lprintf "READ %Ld\n" (new_downloaded -- old_downloaded);
 lprintf "READ: buf_used %d\n" to_read_int;
@@ -316,7 +333,10 @@
 (*                CommonSwarming.free_range r; *)
                 d.download_ranges <- tail;
 (* If we have no more range to receive, disconnect *)
-                if d.download_ranges = [] then raise Exit;
+                if d.download_ranges = [] then begin
+                  lprintf_nl "No more ranges";
+                  raise Exit;
+                end;
                 gconn.gconn_handler <- HttpHeader (client_parse_header c);
           end)
 
@@ -344,7 +364,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-let http_check_size url start_download_file =
+let http_check_size file url start_download_file =
   let module H = Http_client in
   let r = {
       H.basic_request with
@@ -354,20 +374,24 @@
       H.req_user_agent = get_user_agent ();
     } in
 
-  H.whead r (fun headers ->
+  H.whead2 r (fun headers ->
       if !verbose then lprintf_nl "RECEIVED HEADERS";
       let content_length = ref None in
       List.iter (fun (name, content) ->
           if String.lowercase name = "content-length" then
-            try
-              content_length := Some (Int64.of_string content)
-            with _ ->
-                lprintf_nl "bad content length [%s]" content;
+        try content_length := Some (Int64.of_string content)
+        with _ -> lprintf_nl "bad content length [%s]" content;
       ) headers;
-      match !content_length with
+    (match !content_length with
         None -> failwith "Unable to start download (HEAD failed)"
-      | Some result_size ->
-          start_download_file result_size)
+    | Some result_size -> start_download_file result_size);
+  )
+  (fun c ->
+    match c with 
+     x when x < 200 || x > 299 -> 
+       pause_for_cause file (string_of_int x);
+    | _ -> ()
+  )
 
 (*************************************************************************)
 (*                                                                       *)
Index: mldonkey/src/networks/fileTP/fileTPInteractive.ml
diff -u mldonkey/src/networks/fileTP/fileTPInteractive.ml:1.38 
mldonkey/src/networks/fileTP/fileTPInteractive.ml:1.39
--- mldonkey/src/networks/fileTP/fileTPInteractive.ml:1.38      Thu May 25 
19:47:25 2006
+++ mldonkey/src/networks/fileTP/fileTPInteractive.ml   Tue May 30 10:54:14 2006
@@ -66,10 +66,22 @@
 
 module P = GuiTypes
 
-let _ =
-  file_ops.op_file_cancel <- (fun file ->
+
+let clean_stop file =
       CommonSwarming.remove_swarmer file.file_swarmer;
       file.file_swarmer <- None;
+  List.iter (fun c ->
+    c.client_downloads <- List.filter 
+      (fun cd -> cd.download_file.file_id <> file.file_id) c.client_downloads;
+    if (List.length c.client_downloads) == 0 then begin
+      FileTPClients.disconnect_client c Closed_by_user;
+      client_remove c;
+    end;
+  ) file.file_clients
+
+let _ =
+  file_ops.op_file_cancel <- (fun file ->
+      clean_stop file;
       remove_file file;
   );
   file_ops.op_file_info <- (fun file ->
@@ -107,7 +119,7 @@
           c.client_hostname c.client_port);
         P.client_num = (client_num (as_client c));
         P.client_connect_time = BasicSocket.last_time ();
-        P.client_software = "TP";
+        P.client_software = c.client_software;
         P.client_downloaded = c.client_downloaded;
       }
   );
@@ -394,11 +406,17 @@
   network.op_network_share <- (fun fullname codedname size -> ());
   network.op_network_search <- (fun ss buf -> ());
   network.op_network_download <- (fun r -> dummy_file);
-  file_ops.op_file_commit <- (fun file new_name -> ());
-  file_ops.op_file_pause <- (fun file -> ());
+  file_ops.op_file_commit <- (fun file new_name -> clean_stop file);
+  file_ops.op_file_pause <- (fun file -> 
+    List.iter (fun c ->
+      match c.client_connected_for with
+      | Some s when s.file_id = file.file_id -> 
+          FileTPClients.disconnect_client c Closed_by_user;
+      | _ -> ()
+    ) file.file_clients
+  );
   file_ops.op_file_resume <- (fun file -> ());
   file_ops.op_file_print_html <- (fun file buf -> ());
-  file_ops.op_file_print_sources_html <- (fun file buf -> ());
   network.op_network_forget_search <- (fun s -> ());
   network.op_network_connect_servers <- (fun s -> ());
   network.op_network_recover_temp <- (fun s -> ())
Index: mldonkey/src/networks/fileTP/fileTPOptions.ml
diff -u mldonkey/src/networks/fileTP/fileTPOptions.ml:1.10 
mldonkey/src/networks/fileTP/fileTPOptions.ml:1.11
--- mldonkey/src/networks/fileTP/fileTPOptions.ml:1.10  Fri May  5 22:08:01 2006
+++ mldonkey/src/networks/fileTP/fileTPOptions.ml       Tue May 30 10:54:14 2006
@@ -58,6 +58,10 @@
     "(internal option)"
     int_option 0
 
+let chunk_size = define_option fileTP_section ["chunk_size"]
+  "Chunk size (in bytes) (0 = No chunks)"
+  int_option 0
+
   (*
 let verbose_clients =
   define_option fileTP_section ["verbose_clients"]
Index: mldonkey/src/networks/fileTP/fileTPSSH.ml
diff -u mldonkey/src/networks/fileTP/fileTPSSH.ml:1.9 
mldonkey/src/networks/fileTP/fileTPSSH.ml:1.10
--- mldonkey/src/networks/fileTP/fileTPSSH.ml:1.9       Sun Apr  9 00:27:04 2006
+++ mldonkey/src/networks/fileTP/fileTPSSH.ml   Tue May 30 10:54:14 2006
@@ -104,6 +104,7 @@
               CommonSwarming.downloaded swarmer in
 
            c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- 
old_downloaded);
+            client_must_update (as_client c);
 
             if new_downloaded = file_size file then
               download_finished file;
@@ -173,7 +174,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-let ssh_check_size url start_download_file =
+let ssh_check_size file url start_download_file =
   let token = create_token unlimited_connection_manager in
   let shell, args = shell_command url.Url.server in
   lprintf "SHELL: ";
Index: mldonkey/src/networks/fileTP/fileTPTypes.ml
diff -u mldonkey/src/networks/fileTP/fileTPTypes.ml:1.10 
mldonkey/src/networks/fileTP/fileTPTypes.ml:1.11
--- mldonkey/src/networks/fileTP/fileTPTypes.ml:1.10    Sun Apr  9 00:27:04 2006
+++ mldonkey/src/networks/fileTP/fileTPTypes.ml Tue May 30 10:54:14 2006
@@ -37,8 +37,10 @@
     mutable client_sock : tcp_connection;
     mutable client_requests : download list;
     mutable client_reconnect : bool;
+    mutable client_failed_attempts : int;
     mutable client_connected_for : file option;
     mutable client_proto : tp_proto;
+    mutable client_software : string;
   }
 
 and file = {
@@ -66,8 +68,7 @@
         TcpBufferedSocket.t -> download -> unit);
     proto_set_sock_handler : (client -> TcpBufferedSocket.t -> unit);
     proto_string : string;
-    proto_check_size : Url.url ->
-       (int64 -> unit) -> unit;
+    proto_check_size : file -> Url.url -> (int64 -> unit) -> unit;
     proto_connect : TcpBufferedSocket.token ->
       client -> (TcpBufferedSocket.t -> unit) -> TcpBufferedSocket.t;
   }
Index: mldonkey/src/utils/net/http_client.ml
diff -u mldonkey/src/utils/net/http_client.ml:1.32 
mldonkey/src/utils/net/http_client.ml:1.33
--- mldonkey/src/utils/net/http_client.ml:1.32  Fri May 19 23:43:55 2006
+++ mldonkey/src/utils/net/http_client.ml       Tue May 30 10:54:14 2006
@@ -106,6 +106,10 @@
  (match r.req_referer with None -> ()
     | Some url -> 
         Printf.bprintf res "Referer: %s\r\n" (Url.to_string_no_args url));
+  if url.user <> "" then begin
+    let userpass = Printf.sprintf "%s:%s" url.user url.passwd in
+    Printf.bprintf res "Authorization: Basic %s\r\n" (Base64.encode userpass)
+  end;
   if is_real_post then begin
       let post = Buffer.create 80 in
       let rec make_post = function
@@ -201,15 +205,15 @@
   nr := true;
   read_header (parse_header headers_handler) sock nread
   
-let rec get_page r content_handler f =
-  let error = ref false in
+
+let def_ferr = (fun c -> ())
+
+let rec get_page r content_handler f ferr =
   let rec get_url level r =
   try
     let url = r.req_url in
     let level = r.req_retry in
     let request = make_full_request r in
-    
-    
     let server, port =
       match r.req_proxy with
       | None -> url.server, url.port
@@ -220,8 +224,8 @@
 (*         lprintf "IP done %s:%d\n" (Ip.to_string ip) port;*)
         let token = create_token unlimited_connection_manager in
         let sock = TcpBufferedSocket.connect token "http client connecting"
-            (try Ip.to_inet_addr ip with e -> raise Not_found)
-          port (fun sock e -> 
+        (try Ip.to_inet_addr ip with e -> raise Not_found) port
+        (fun sock e -> 
               () 
 (*              if !verbose then
                   lprintf "Event %s\n"
@@ -243,6 +247,7 @@
  *)
           )
         in
+
         let nread = ref false in
         if !verbose then 
           lprintf_nl "get_page: %s" (String.escaped request);
@@ -250,17 +255,20 @@
         TcpBufferedSocket.set_reader sock (http_reply_handler nread
             (default_headers_handler url level));
         set_rtimeout sock 5.;
+      (*
         TcpBufferedSocket.set_closer sock (fun _ _ -> ()
-(*        lprintf "Connection closed nread:%b\n" !nread; *)
+        lprintf "Connection closed nread:%b\n" !nread; 
         )
+      *)
 
     )
-  with e -> lprintf_nl "error in get_url"; raise Not_found
+  with e -> 
+    lprintf_nl "error in get_url"; 
+    raise Not_found
 
   and default_headers_handler old_url level sock ans_code headers =
     let print_headers () =
-      List.iter
-        (fun (name, value) ->
+      List.iter (fun (name, value) ->
           lprintf_nl "[%s]=[%s]" name value;
         ) headers;
     in
@@ -276,10 +284,8 @@
         let content_length = ref (-1) in
         List.iter (fun (name, content) ->
             if String.lowercase name = "content-length" then
-              try
-                content_length := int_of_string content
-              with _ -> 
-                  lprintf_nl "bad content length [%s]" content;
+            try content_length := int_of_string content
+            with _ -> lprintf_nl "bad content length [%s]" content;
         ) headers;
         let location = "Location", Url.to_string old_url in
         let content_handler = content_handler !content_length 
(location::headers) in
@@ -291,34 +297,31 @@
     | 301 | 302 | 304 ->
         if !verbose then lprintf_nl "%d: Redirect" ans_code;
   let retrynum = r.req_retry in
-        if retrynum < r.req_max_retry then
-          begin
+        if retrynum < r.req_max_retry then begin
             try
               let url = ref "" in
-              List.iter
-                (fun (name, content) ->
+            List.iter (fun (name, content) ->
                   if String.lowercase name = "location" then
                     url := content;
                 ) headers;
-              if !verbose then
-                print_headers ();
+            if !verbose then print_headers ();
               let url =
                 if String2.check_prefix !url "." then url := String2.after 
!url 1;
-                if String.length !url > 0 && !url.[0] <> '/' then
-                  !url
-                else
-                  Printf.sprintf "http://%s%s%s";
+              if String.length !url > 0 && !url.[0] <> '/' 
+                then !url
+                else Printf.sprintf "http://%s%s%s";
                     old_url.Url.server
                     (if old_url.Url.port = 80 then "" else Printf.sprintf 
":%d" old_url.Url.port)
                     !url
               in
+
               if !verbose then lprintf_nl "Redirected to %s" url;
               r.req_url <- (Url.of_string url);
               let r = { r with
       req_url = Url.of_string url;
-      req_retry = retrynum+1 }
-        in
-        get_page r content_handler f
+              req_retry = retrynum+1 
+            } in
+            get_page r content_handler f ferr
             
             with e ->
                 lprintf_nl "error understanding redirect response %d" ans_code;
@@ -326,44 +329,43 @@
                 raise Not_found
                 
           end
-        else 
+        else begin
           lprintf_nl "more than %d redirections, aborting." r.req_max_retry;
           raise Not_found
+        end
           
     | 404 ->
         lprintf_nl "404: Not found for: %s" (Url.to_string_no_args r.req_url);
         close sock (Closed_for_error "bad reply");
+        ferr ans_code;
         raise Not_found
 
     | 502 | 503 | 504 ->
         if !verbose then lprintf_nl "%d: Unavailable" ans_code;
   let retrynum = r.req_retry in
-        if retrynum < r.req_max_retry then
-          begin
-            if !verbose then
-              print_headers ();
+        if retrynum < r.req_max_retry then begin
+          if !verbose then print_headers ();
       let seconds = (retrynum+1)*10 in
               lprintf_nl "retry %d/%d in %d seconds for %s"
           (retrynum+1) r.req_max_retry seconds (Url.to_string_no_args 
r.req_url);
-      let r = { r with req_retry = retrynum+1 } in
-        add_timer (float(seconds)) (fun t -> get_page r content_handler f)
+          let r = { r with 
+            req_retry = retrynum+1 
+          } in
+          add_timer (float(seconds)) (fun t -> get_page r content_handler f 
ferr)
     end
-        else 
+        else begin
           lprintf_nl "more than %d retries, aborting." r.req_max_retry;
           raise Not_found
+        end
           
     | _ ->
         lprintf_nl "%d: bad reply for: %s"
           ans_code (Url.to_string_no_args r.req_url);
         close sock (Closed_for_error "bad reply");
+        ferr ans_code;
         raise Not_found
   in
-  get_url 0 r;
-  if !error = true then begin
-      lprintf_nl "failed!";
-      raise Not_found
-    end
-  
+  get_url 0 r
   
 let wget r f = 
   
@@ -421,13 +423,12 @@
         lprintf_nl "Exception %s in loading downloaded file %s" 
(Printexc2.to_string e) filename;
         Sys.remove filename;
         raise Not_found
-  )
+  ) def_ferr
   with e -> 
     lprintf_nl "Exception %s in wget" (Printexc2.to_string e); 
     raise Not_found
 
-let whead r f = 
-  
+let whead2 r f ferr = 
   get_page r
     (fun maxlen headers ->
       (try f headers with _ -> ());
@@ -435,6 +436,9 @@
         close sock Closed_by_user
     )
   (fun _ ->  ())
+  ferr
+
+let whead r f = whead2 r f def_ferr
 
 let wget_string r f progress =
     
@@ -460,7 +464,7 @@
         end)
   (fun _ ->  
       f (Buffer.contents file_buf)
-  )
+  ) def_ferr
 
 
 let split_header header =
Index: mldonkey/src/utils/net/http_client.mli
diff -u mldonkey/src/utils/net/http_client.mli:1.7 
mldonkey/src/utils/net/http_client.mli:1.8
--- mldonkey/src/utils/net/http_client.mli:1.7  Mon May 15 17:45:35 2006
+++ mldonkey/src/utils/net/http_client.mli      Tue May 30 10:54:14 2006
@@ -51,9 +51,10 @@
 
 val basic_request : request
   
-val get_page : request -> content_handler -> (unit -> unit) -> unit
+val get_page : request -> content_handler -> (unit -> unit) -> (int -> unit) 
-> unit
 val wget : request -> (string -> unit) -> unit
 val whead : request -> ( (string * string) list -> unit) -> unit
+val whead2 : request -> ( (string * string) list -> unit) -> (int -> unit) -> 
unit
 
 val wget_string : request -> (string -> unit) ->
   (int -> int -> unit) -> unit




reply via email to

[Prev in Thread] Current Thread [Next in Thread]