[Mldonkey-commits] mldonkey distrib/ChangeLog src/utils/cdk/arg2.m...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       07/02/19 21:35:48

Modified files:
        distrib        : ChangeLog 
        src/utils/cdk  : arg2.ml arg2.mli 
        tools          : mld_hash.ml 

Log message:
        patch #5754

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1188&r2=1.1189
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/arg2.ml?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/arg2.mli?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/tools/mld_hash.ml?cvsroot=mldonkey&r1=1.8&r2=1.9

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1188
retrieving revision 1.1189
diff -u -b -r1.1188 -r1.1189
--- distrib/ChangeLog   19 Feb 2007 21:20:38 -0000      1.1188
+++ distrib/ChangeLog   19 Feb 2007 21:35:48 -0000      1.1189
@@ -15,6 +15,11 @@
 =========
 
 2007/02/19
+5754: mld_hash: Compute AICH hashes (thx to pango)
+- parameter hash takes new option: aich to compute eMule AICH hashes
+- new parameter partial_zone: Display hashing of zones (subparts of chunks)
+- new parameter check_keep, keep files after checking functions (-check) for 
later testing
+- parameter check, option filesize is now Int64 and in bytes
 5752: Fix core hanging on ARM CPUs
 5750: EDK: New option upload_compression_ext_exclude (thx to pango)
 - space-separated list of file extensions which are not compressed when 
uploaded

Index: src/utils/cdk/arg2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/arg2.ml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/utils/cdk/arg2.ml       19 Aug 2004 07:56:55 -0000      1.5
+++ src/utils/cdk/arg2.ml       19 Feb 2007 21:35:48 -0000      1.6
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arg2.ml,v 1.5 2004/08/19 07:56:55 mldonkey Exp $ *)
+(* $Id: arg2.ml,v 1.6 2007/02/19 21:35:48 spiralvoice Exp $ *)
 
 type spec =
   | Unit of (unit -> unit)     (* Call the function with unit argument *)
@@ -19,6 +19,7 @@
   | Clear of bool ref          (* Set the reference to false *)
   | String of (string -> unit) (* Call the function with a string argument *)
   | Int of (int -> unit)       (* Call the function with an int argument *)
+  | Int64 of (int64 -> unit)       (* Call the function with an int argument *)
   | Float of (float -> unit)   (* Call the function with a float argument *)
   | Rest of (string -> unit)   (* Stop interpreting keywords and call the
                                   function with each remaining argument *)
@@ -106,6 +107,12 @@
                   with Failure "int_of_string" -> stop (Wrong (s, arg, "an 
integer"))
                 end;
                 incr current;
+            | Int64 f when !current + 1 < l ->
+                let arg = argv.(!current+1) in
+                begin try f (Int64.of_string arg)
+                  with Failure "int64_of_string" -> stop (Wrong (s, arg, "an 
integer64"))
+                end;
+                incr current;
             | Float f when !current + 1 < l ->
                 let arg = argv.(!current+1) in
                 begin try f (float_of_string arg);
@@ -150,6 +157,12 @@
                     with Failure "int_of_string" -> stop (Wrong (s, arg, "an 
integer"))
                   end;
                   incr current;
+              | Int64 f when !current + 1 < l ->
+                  let arg = argv.(!current+1) in
+                  begin try f (Int64.of_string arg)
+                    with Failure "int64_of_string" -> stop (Wrong (s, arg, "an 
integer64"))
+                  end;
+                  incr current;
               | Float f when !current + 1 < l ->
                   let arg = argv.(!current+1) in
                   begin try f (float_of_string arg);
@@ -230,6 +243,12 @@
                   with Failure "int_of_string" -> stop (Wrong (s, arg, "an 
integer"))
                 end;
                 incr current;
+            | Int64 f when !current + 1 < l ->
+                let arg = argv.(!current+1) in
+                begin try f (Int64.of_string arg)
+                  with Failure "int64_of_string" -> stop (Wrong (s, arg, "an 
integer64"))
+                end;
+                incr current;
             | Float f when !current + 1 < l ->
                 let arg = argv.(!current+1) in
                 begin try f (float_of_string arg);

Index: src/utils/cdk/arg2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/arg2.mli,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/utils/cdk/arg2.mli      19 Aug 2004 07:56:55 -0000      1.5
+++ src/utils/cdk/arg2.mli      19 Feb 2007 21:35:48 -0000      1.6
@@ -11,7 +11,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: arg2.mli,v 1.5 2004/08/19 07:56:55 mldonkey Exp $ *)
+(* $Id: arg2.mli,v 1.6 2007/02/19 21:35:48 spiralvoice Exp $ *)
 
 (** Parsing of command line arguments.
 
@@ -44,6 +44,7 @@
   | Clear of bool ref          (** Set the reference to false *)
   | String of (string -> unit) (** Call the function with a string argument *)
   | Int of (int -> unit)       (** Call the function with an int argument *)
+  | Int64 of (int64 -> unit)       (** Call the function with an int argument 
*)
   | Float of (float -> unit)   (** Call the function with a float argument *)
   | Rest of (string -> unit)   (** Stop interpreting keywords and call the 
                                    function with each remaining argument *)

Index: tools/mld_hash.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/tools/mld_hash.ml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- tools/mld_hash.ml   31 May 2006 20:02:14 -0000      1.8
+++ tools/mld_hash.ml   19 Feb 2007 21:35:48 -0000      1.9
@@ -26,7 +26,6 @@
 let _s x = _s "Mld_hash" x
 let _b x = _b "Mld_hash" x  
 
-let block_size = 9728000L
 let zero = Int64.zero
 let one = Int64.one
 let (++) = Int64.add
@@ -34,7 +33,12 @@
 let ( ** ) x y = Int64.mul x y
 let ( // ) x y = Int64.div x y
 
+let edk_block_size = 9728000L
+let edk_zone_size = 180L ** 1024L
 let tiger_block_size = Int64.of_int (1024 * 1024)
+let partial = ref false
+let partial_zone = ref false
+let keep_file_after_check = ref false
 
 (*************************************************************************)
 (*                                                                       *)
@@ -86,7 +90,7 @@
 (*                                                                       *)
 (*************************************************************************)
 
-let bitprint_file fd file_size partial =
+let bitprint_file fd file_size =
   lprintf "Calculating SHA1\n";
   let sha1 = Sha1.digest_subfile fd zero file_size in
   lprintf "Calculating TigerTree\n";
@@ -95,7 +99,7 @@
   let file_size = Unix32.getsize64 fd in
   let nchunks = Int64.to_int (Int64.pred file_size // tiger_block_size) + 1 in
   let chunks = 
-    let chunks = Array.create nchunks tiger in
+    let chunks = Array.make nchunks tiger in
     for i = 0 to nchunks - 1 do
       let begin_pos = tiger_block_size ** (Int64.of_int i) in
       let end_pos = begin_pos ++ tiger_block_size in
@@ -116,10 +120,10 @@
 (*                                                                       *)
 (*************************************************************************)
   
-let bitprint_filename filename partial =
+let bitprint_filename filename =
   let fd = Unix32.create_ro filename in
   let file_size = Unix32.getsize64 fd in
-  let (sha1, tiger2) = bitprint_file fd file_size partial in
+  let (sha1, tiger2) = bitprint_file fd file_size in
   lprintf "urn:bitprint:%s.%s\n" (Sha1.to_string sha1) (TigerTree.to_string 
tiger2);
   ()
 
@@ -130,22 +134,23 @@
 (*                                                                       *)
 (*************************************************************************)
 
-let ed2k_hash_file fd file_size partial =
+let ed2k_hash_file fd file_size =
   (* See: DonkeyGlobals *)
-  let nchunks = Int64.to_int (file_size // block_size) + 1 in
-  let nchunk_hashes = Int64.to_int (file_size // block_size) in
+  let nchunks = Int64.to_int (file_size // edk_block_size) + 1 in
+  let nchunk_hashes = Int64.to_int (file_size // edk_block_size) in
   let nchunk_hashes = if nchunk_hashes <> 0 then nchunk_hashes + 1 else 
nchunk_hashes in
   let md4 = if nchunk_hashes = 0 then
       Md4.digest_subfile fd zero file_size        
     else
     let chunks = String.create (nchunks*16) in
     for i = 0 to nchunks - 1 do
-      let begin_pos = block_size ** (Int64.of_int i) in
-      let end_pos = begin_pos ++ block_size in
+      let begin_pos = edk_block_size ** (Int64.of_int i) in
+      let end_pos = begin_pos ++ edk_block_size in
       let end_pos = min end_pos file_size in
       let len = end_pos -- begin_pos in
       let md4 = Md4.digest_subfile fd begin_pos len in
-      if !partial then lprintf "  Partial %4d/%4d : %s\n" i nchunks 
(Md4.to_string md4);
+      if !partial then lprintf "  Partial %4d/%4d (%Ld - %Ld): %s\n"
+                         i nchunks begin_pos end_pos (Md4.to_string md4);
       let md4 = Md4.direct_to_string md4 in
       String.blit md4 0 chunks (i*16) 16;
     done;
@@ -155,6 +160,88 @@
 
 (*************************************************************************)
 (*                                                                       *)
+(*                         ed2k_hash_filename                            *)
+(*                                                                       *)
+(*************************************************************************)
+  
+let ed2k_hash_filename filename = 
+  lprintf "Calculating ed2k of %s\n" filename;
+  let fd = Unix32.create_ro filename in
+  let file_size = Unix32.getsize64 fd in
+  let md4 = ed2k_hash_file fd file_size in
+  lprintf "ed2k://|file|%s|%Ld|%s|/\n" 
+    (Url.encode (Filename.basename filename))
+    file_size
+    (Md4.to_string md4)
+
+(*************************************************************************)
+(*                                                                       *)
+(*                         aich_hash_file                                *)
+(*                                                                       *)
+(*************************************************************************)
+
+type side = Left | Right
+
+let aich_hash side nchunks f_hashchunk =
+  let combine_sha1 hash1 hash2 =
+    Sha1.string (Sha1.direct_to_string hash1 ^ Sha1.direct_to_string hash2)
+  in
+  let build_tree n =
+    let rec aux side n next_leaf cont =
+      if n = 1L then cont (f_hashchunk side next_leaf) (next_leaf ++ 1L)
+      else
+        let p, q = n // 2L, Int64.rem n 2L in
+        aux Left (if q = 0L || side = Right then p else p ++ 1L) next_leaf
+         (fun left_hash next_leaf ->
+            aux Right (if q = 0L || side = Left then p else p ++ 1L) next_leaf
+              (fun right_hash next_leaf ->
+                 cont (combine_sha1 left_hash right_hash) next_leaf)) in
+    aux side n 0L (fun root_hash number_of_leaves -> root_hash)
+  in
+  build_tree nchunks
+
+let aich_hash_chunk side fd offset len =
+  let nzones = (Int64.pred len // edk_zone_size) ++ 1L in
+  let compute_sha1_zone side nzone =
+    let begin_pos = offset ++ edk_zone_size ** nzone in
+    let end_pos = offset ++ (min (edk_zone_size ** (nzone ++ 1L)) len) in
+    let len = end_pos -- begin_pos in
+    if !partial_zone then
+      lprintf_nl "compute SHA1 of zone %Ld/%Ld (%Ld - %Ld) len %Ld"
+        nzone nzones begin_pos end_pos len;
+    Sha1.digest_subfile fd begin_pos len
+  in
+  aich_hash side nzones compute_sha1_zone
+
+let aich_hash_file fd file_size =
+  let nchunks = (Int64.pred file_size // edk_block_size) ++ 1L in
+  let compute_sha1_chunk side nchunk =
+    let begin_pos = edk_block_size ** nchunk in
+    let end_pos = min (begin_pos ++ edk_block_size) file_size in
+    let len = end_pos -- begin_pos in
+    if !partial then
+      lprintf_nl "compute SHA1 of chunk %Ld/%Ld (%Ld - %Ld) len %Ld"
+        nchunk nchunks begin_pos end_pos len;
+    aich_hash_chunk side fd begin_pos len
+  in
+  aich_hash Left nchunks compute_sha1_chunk
+
+(*************************************************************************)
+(*                                                                       *)
+(*                         aich_hash_filename                            *)
+(*                                                                       *)
+(*************************************************************************)
+  
+let aich_hash_filename filename = 
+  lprintf "Calculating AICH of %s\n" filename;
+  let fd = Unix32.create_ro filename in
+  let file_size = Unix32.getsize64 fd in
+  let aich = aich_hash_file fd file_size in
+  lprintf "AICH of %s = %s\n" 
+    (Url.encode (Filename.basename filename)) (Sha1.to_string aich)
+
+(*************************************************************************)
+(*                                                                       *)
 (*                         sha1_hash_file                                *)
 (*                                                                       *)
 (*************************************************************************)
@@ -169,33 +256,17 @@
     let end_pos = min end_pos file_size in
     let len = end_pos -- begin_pos in
     let md4 = Sha1.digest_subfile fd begin_pos len in
-    lprintf "  Partial %4d/%4d (%Ld-%Ld) : %s\n" i nchunks begin_pos end_pos
+    if !partial then lprintf "  Partial %4d/%4d (%Ld-%Ld) : %s\n" i nchunks 
begin_pos end_pos
       (Sha1.to_string md4);
   done
 
 (*************************************************************************)
 (*                                                                       *)
-(*                         ed2k_hash_filename                            *)
-(*                                                                       *)
-(*************************************************************************)
-  
-let ed2k_hash_filename filename partial = 
-  lprintf "Calculating ed2k of %s\n" filename;
-  let fd = Unix32.create_ro filename in
-  let file_size = Unix32.getsize64 fd in
-  let md4 = ed2k_hash_file fd file_size partial in
-  lprintf "ed2k://|file|%s|%Ld|%s|/\n" 
-    (Url.encode (Filename.basename filename))
-    file_size
-    (Md4.to_string md4)
-
-(*************************************************************************)
-(*                                                                       *)
 (*                         sig2dat_hash_filename                         *)
 (*                                                                       *)
 (*************************************************************************)
   
-let sig2dat_hash_filename filename partial =
+let sig2dat_hash_filename filename =
   lprintf "Calculating sig2dat of %s\n" filename;
   let fd = Unix32.create_ro filename in
   let file_size = Unix32.getsize64 fd in
@@ -215,8 +286,8 @@
 (*                                                                       *)
 (*************************************************************************)
   
-let check_external_functions size = 
-  let partial = ref true in
+let check_external_functions file_size = 
+  partial := true;
   let test_string_len = 43676 in
   let dummy_string = "bonjourhello1" in
   
@@ -248,9 +319,7 @@
         * (string -> int64 -> Unix32.t) ) list) = 
     [
       "diskfile", create_diskfile, create_diskfile;
-      
       "sparsefile", create_sparsefile, create_diskfile;
-            
       "multifile", create_multifile, create_multifile;
     
     ] in
@@ -270,7 +339,6 @@
   
   
   let test_string_len64 = Int64.of_int test_string_len in
-  let file_size = (Int64.of_int size) ** 1024L in
   let rec iter pos waves =
     if pos < file_size then
       let end_pos = min file_size (pos ++ test_string_len64) in
@@ -284,7 +352,7 @@
   let waves = iter zero [] in
   lprintf "\n";
   List.iter (fun (name,f,f') ->
-      let filename = Printf.sprintf "test.%s.%d" name size in
+      let filename = Printf.sprintf "test.%s.%Ld" name file_size in
       try
         lprintf "Creating file %s\n" filename;
         let file = f filename file_size in
@@ -305,29 +373,32 @@
         ) waves;
         
         lprintf "Computing ed2k hash\n";
-        let md4 = ed2k_hash_file file file_size partial in
-        lprintf "ed2k://|file|%s|%Ld|%s|\n" 
-          (Url.encode filename) file_size (Md4.to_string md4);
+        let md4 = ed2k_hash_file file file_size in
+        let aich = aich_hash_file file file_size in
+        lprintf "ed2k://|file|%s|%Ld|%s|h=%s|/\n" 
+          (Url.encode filename) file_size (Md4.to_string md4) (Sha1.to_string 
aich);
         
         lprintf "Computing bitprint hash\n";
-        let (sha1, tiger2) = bitprint_file file file_size partial in
+        let (sha1, tiger2) = bitprint_file file file_size in
         lprintf "urn:bitprint:%s.%s\n" (Sha1.to_string sha1) 
(TigerTree.to_string tiger2);
         
   Unix32.close file;
+
+        if not !keep_file_after_check then begin
         lprintf (_b "Renaming...\n");
         Unix32.rename file (filename ^ ".final");
-
         lprintf (_b "Removing %s\n") filename;
-        Unix32.remove file;
+          (try Unix32.remove file with _ -> ());
         let file = f' (filename ^ ".final") file_size in
   Unix32.close file;
         Unix32.remove file;
+        end;
   (try Sys.remove "zero_chunk" with _ -> ());
         
         lprintf "done\n"
       with e ->
-          lprintf (_b "Exception %s in check_external_functions %s.%d KB\n")
-            (Printexc2.to_string e) name size)
+          lprintf (_b "Exception %s in check_external_functions %s.%Ld\n")
+            (Printexc2.to_string e) name file_size)
   file_types
 
 let max_diff_size = 30000000L
@@ -403,7 +474,6 @@
 let chunk_size = ref zero
   
 let _ =
-(*  set_strings_file "mlnet_strings"; *)
   MlUnix.set_signal  Sys.sigint
     (Sys.Signal_handle (fun _ -> lprintf_nl "Received SIGINT, stopping 
mld_hash...";
         exit 0));
@@ -412,26 +482,30 @@
     (Sys.Signal_handle (fun _ -> lprintf_nl "Received SIGTERM, stopping 
mld_hash...";
         exit 0));
 
-  let partial = ref false in
   Arg2.parse2 [
     "-diff_chunk", Arg2.Array (4, diff_chunk), 
     "<filename1> <filename2> <begin_pos> <end_pos> : compute diff between the 
two files";
-    "-hash", Arg2.String ( (:=) hash), _s " <hash> : Set hash type you want to 
compute (ed2k, sig2dat, bp)";
+    "-hash", Arg2.String ( (:=) hash), _s " <hash> : Set hash type you want to 
compute (ed2k, aich, sha1, sig2dat, bp)";
     "-sha1", Arg2.String (fun size ->
         hash := "sha1";
         chunk_size := Int64.of_string size;
     ), " <chunk_size> : Set hash type to sha1 and chunk_size to <chunk_size>";
     "-partial", Arg2.Unit (fun _ -> partial := true), _s ": enable display of 
partial hash values";
-    "-check", Arg2.Int check_external_functions, _s " <nth size>: check C file 
functions";
+    "-partial_zone", Arg2.Unit (fun _ -> partial_zone := true), _s ": enable 
display of zone AICH hash values";
+    "-check_keep", Arg2.Unit (fun _ -> keep_file_after_check := true), _s ": 
keep files after checking functions";
+    "-check", Arg2.Int64 check_external_functions, _s " <size of testfile in 
bytes>: check C file functions";
   ] (fun filename ->
       match !hash with
-      | "ed2k" -> ed2k_hash_filename filename partial
+      | "ed2k" | "edk" -> ed2k_hash_filename filename
+      | "aich" -> aich_hash_filename filename
+      | "emule" -> ed2k_hash_filename filename; aich_hash_filename filename
       | "sha1" -> sha1_hash_filename !chunk_size filename
-      | "sig2dat" -> sig2dat_hash_filename filename partial
-      | "bp" -> bitprint_filename filename partial
+      | "sig2dat" -> sig2dat_hash_filename filename
+      | "bp" -> bitprint_filename filename
       | _ -> 
-          ed2k_hash_filename filename partial;
-          sig2dat_hash_filename filename partial;
-          bitprint_filename filename partial
+          ed2k_hash_filename filename;
+         aich_hash_filename filename;
+          sig2dat_hash_filename filename;
+          bitprint_filename filename
   ) (_s " <filenames> : compute hashes of filenames");
   exit 0