From 934b3a272cde602b24b67848aaee082ed3b07cd8 Mon Sep 17 00:00:00 2001
From: spiralvoice <spiralvoice>
Date: Tue, 25 Oct 2011 18:00:54 +0000
Subject: [PATCH] patch #7645

---
 distrib/ChangeLog                            |  1 +
 src/networks/direct_connect/dcGlobals.ml     |  2 +-
 src/networks/direct_connect/dcInteractive.ml | 14 ++++++++++++--
 src/networks/direct_connect/dcShared.ml      | 20 +++++++++-----------
 4 files changed, 23 insertions(+), 14 deletions(-)

diff --git a/distrib/ChangeLog b/distrib/ChangeLog
index 0309b4a9..7f63f726 100644
--- a/distrib/ChangeLog
+++ b/distrib/ChangeLog
@@ -15,6 +15,7 @@ ChangeLog
 =========
 
 2011/10/25
+7645: DC: show hashing progress in dcinfo (ygrek)
 7644: Fix broken target release.utils.static
 7642: Update GNU config.guess and config.sub to version 2011/10
 7641: DC: fix ownership for downloads by non-admin users (ygrek)
diff --git a/src/networks/direct_connect/dcGlobals.ml b/src/networks/direct_connect/dcGlobals.ml
index bcc7e65e..21d20f54 100644
--- a/src/networks/direct_connect/dcGlobals.ml
+++ b/src/networks/direct_connect/dcGlobals.ml
@@ -95,7 +95,7 @@ let users_by_name = Hashtbl.create 113
 let current_files = ref ([]: file list) 
 let dc_files_by_unchecked_hash : (string , file) Hashtbl.t = Hashtbl.create 47
 let dc_files_by_key = Hashtbl.create 47
-let dc_tiger_computing = ref false
+let dc_tiger_computing = ref (None : dc_shared_file option)
 let dc_get_nchunks size = Int64.to_int (size // CommonUploads.tiger_block_size) + 1
 let dc_shared_files_by_fullname : (string , dc_shared_file) Hashtbl.t = Hashtbl.create 30
 let dc_shared_files_by_codedname : (string , dc_shared_file) Hashtbl.t = Hashtbl.create 30
diff --git a/src/networks/direct_connect/dcInteractive.ml b/src/networks/direct_connect/dcInteractive.ml
index 59cfb73f..260d5e24 100644
--- a/src/networks/direct_connect/dcInteractive.ml
+++ b/src/networks/direct_connect/dcInteractive.ml
@@ -1145,6 +1145,15 @@ msgWindow.location.reload();
     html_mods_cntr_init ();
     if use_html_mods o then dc_info_html_header buf;
     let nservers = List.length !connected_servers in
+    let hashed =
+      [ Printf.sprintf "%d files" (Hashtbl.length dc_shared_files_by_hash) ] @
+      match !dc_files_to_hash with [] -> [] | l -> [ Printf.sprintf "%d queued" (List.length l) ] @
+      match !dc_tiger_computing with
+      | Some dcsh when dcsh.dc_shared_size > 0L ->
+        let progress = Int64.to_float dcsh.dc_shared_pos /. Int64.to_float dcsh.dc_shared_size *. 100. in
+        [ Printf.sprintf "hashing: %s (%3.0f%%)" (Filename.basename dcsh.dc_shared_fullname) progress ]
+      | _ -> []
+    in
     let list = [
       ("Hub supports", (DcProtocol.Supports.create_supports_string (HubSupports mldonkey_dc_hub_supports)) );
       ("Client supports", (DcProtocol.Supports.create_supports_string (ClientSupports mldonkey_dc_client_supports)) );
@@ -1153,8 +1162,9 @@ msgWindow.location.reload();
       ("Connected servers", (if nservers > 0 then string_of_int nservers else ""));
       ("  Server list:", empty_string ); ]      
       @ server_list @ [
-      ("Hubs", (Printf.sprintf "Normal:%d  Vipped:%d  Opped:%d" norm_hubs reg_hubs opped_hubs) ); ]
-    in  
+      ("Hubs", (Printf.sprintf "Normal:%d  Vipped:%d  Opped:%d" norm_hubs reg_hubs opped_hubs) );
+      ("Hashed", String.concat ", " hashed);
+    ] in
     let counter = ref 0 in
     List.iter (fun (info,data) -> 
       dc_info_print info data line o;
diff --git a/src/networks/direct_connect/dcShared.ml b/src/networks/direct_connect/dcShared.ml
index df676379..a5b87856 100644
--- a/src/networks/direct_connect/dcShared.ml
+++ b/src/networks/direct_connect/dcShared.ml
@@ -258,16 +258,15 @@ let find_dir_exn name =
 (* Compute (at most) one TigerTree chunk from unhashed shared files *)
 let dc_check_hashed_files () =
   let module M = CommonHasher in
-  if not !dc_tiger_computing then begin
-    (match !dc_files_to_hash with
-    | [] -> ()
-    | dcsh :: files ->
-        (try
+    match !dc_tiger_computing, !dc_files_to_hash with
+    | _, [] | Some _, _ -> ()
+    | None, dcsh :: files ->
+      try
           if not (Sys.file_exists dcsh.dc_shared_fullname) then raise Not_found;
           if Unix32.getsize dcsh.dc_shared_fullname <> dcsh.dc_shared_size then
             raise (Wrong_file_size ((Unix32.getsize dcsh.dc_shared_fullname), dcsh.dc_shared_size));
 
-          dc_tiger_computing := true;
+          dc_tiger_computing := Some dcsh;
           let end_pos = dcsh.dc_shared_pos ++ CommonUploads.tiger_block_size in
           let end_pos = min end_pos dcsh.dc_shared_size in
           let len = end_pos -- dcsh.dc_shared_pos in
@@ -298,7 +297,7 @@ let dc_check_hashed_files () =
                   DcComplexOptions.dc_saved_shared_files =:= dcsh :: !!DcComplexOptions.dc_saved_shared_files;
                 end
               end;
-              dc_tiger_computing := false
+              dc_tiger_computing := None
           )
         with
         | Wrong_file_size (real,computed) ->
@@ -308,11 +307,10 @@ let dc_check_hashed_files () =
             computed real dcsh.dc_shared_fullname
         | e ->
             dc_files_to_hash := files;
-            dc_tiger_computing := false;
+            dc_tiger_computing := None;
             if !verbose_upload || !verbose_unexpected_messages then
               lprintf_nl "Exception %s prevents sharing of %s"
-                (Printexc2.to_string e) dcsh.dc_shared_fullname ) )
-  end
+                (Printexc2.to_string e) dcsh.dc_shared_fullname
 
 let dc_updatesharesize () =
   let dc_sharesize = ref Int64.zero in
@@ -320,7 +318,7 @@ let dc_updatesharesize () =
     dc_sharesize := !dc_sharesize ++ dcsh.dc_shared_size) dc_shared_files_by_codedname;
   !dc_sharesize
 
-let _ = 
+let () =
   network.op_network_share <- (fun fullname codedname size -> (* this is called once/60s with all shared files *)
     (* file path in DC network should use '/' as separator, convert local path accordingly *)
     let codedname =
-- 
2.11.4.GIT