src/networks/direct_connect/dcShared.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19 open Int64ops
  20 open Printf2
  21 open Md4
  22
  23 open CommonFile
  24 open CommonOptions
  25 open CommonResult
  26 open BasicSocket
  27 open CommonGlobals
  28 open CommonTypes
  29 open CommonComplexOptions
  30 open Options
  31 open CommonTypes
  32 open CommonShared
  33 open CommonUploads
  34 open CommonNetwork
  35
  36 open DcTypes
  37 open DcOptions
  38 open DcComplexOptions
  39 open DcGlobals
  40
  41 let log_prefix = "[dcSh]"
  42
  43 let lprintf_nl fmt =
  44   lprintf_nl2 log_prefix fmt
  45
  46 (* Share files tabs *)
  47 let rec buf_tabs buf n =
  48   if n > 0 then begin
  49     Buffer.add_char buf '\t';
  50     buf_tabs buf (n-1)
  51   end
  52
  53 (* Create list of shared files *)
  54 let make_mylist () =
  55   let buf = Buffer.create 1000 in
  56   let rec iter ntabs node =
  57     let dirname = node.shared_dirname in
  58     let ntabs =
  59       if dirname = "" then ntabs else begin
  60         buf_tabs buf ntabs;
  61         let dir = dirname in
  62         Printf.bprintf buf "%s\r\n" dir;
  63         ntabs+1
  64       end
  65     in
  66     List.iter (fun dcsh ->
  67       buf_tabs buf ntabs;
  68       let fname = Filename2.basename dcsh.dc_shared_codedname in
  69       Printf.bprintf buf "%s|%Ld\r\n" fname dcsh.dc_shared_size
  70     ) node.shared_files;
  71     List.iter (fun (_, node) ->
  72         iter ntabs node
  73     ) node.shared_dirs
  74   in
  75   iter 0 dc_shared_tree;
  76   Buffer.contents buf
  77
  78 (* Create mylist of shared files in xml-format *)
  79 let make_xml_mylist () =
  80   let buf = Buffer.create 1000 in
  81   Printf.bprintf buf "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"yes\"?>\r\n";
  82   Printf.bprintf buf "<FileListing Version=\"1\" CID=\"1,0,2,3,4,5,6\" Base=\"/\" Generator=\"MLDC-%s\">\r\n" Autoconf.current_version;
  83   let rec iter ntabs node =
  84     let dirname = node.shared_dirname in
  85     let ntabs =
  86       if dirname = "" then ntabs else begin
  87         buf_tabs buf ntabs;
  88         let dir = dirname in
  89         (* Escape some special XML characters that may appear in the dirname *)
  90         let dir = Str.global_replace (Str.regexp "'") "&apos;" dir in
  91         let dir = Str.global_replace (Str.regexp "&") "&amp;" dir in
  92         Printf.bprintf buf "<Directory Name=\"%s\">\r\n" dir;
  93         ntabs+1
  94       end
  95     in
  96     List.iter (fun dcsh ->
  97       buf_tabs buf ntabs;
  98       let fname = Filename2.basename dcsh.dc_shared_codedname in
  99       (* Escape some special XML characters that may appear in the filename *)
 100       let fname = Str.global_replace (Str.regexp "'") "&apos;" fname in
 101       let fname = Str.global_replace (Str.regexp "&") "&amp;" fname in
 102       Printf.bprintf buf "<File Name=\"%s\" Size=\"%Ld\" TTH=\"%s\"/>\r\n" fname
 103         dcsh.dc_shared_size dcsh.dc_shared_tiger_root
 104     ) node.shared_files;
 105     List.iter (fun (_, node) ->
 106         iter ntabs node;
 107         buf_tabs buf ntabs;
 108         Printf.bprintf buf "</Directory>\r\n"
 109     ) node.shared_dirs
 110   in
 111   iter 0 dc_shared_tree;
 112   Printf.bprintf buf "</FileListing>";
 113   buf
 114
 115 let file_to_che3_to_string filename =
 116   let buf = Buffer.create 8192 in
 117   let file_fd = Unix32.create_ro filename in
 118   let flen = Unix32.getsize64 file_fd in
 119   let slen = 4096 in
 120   (try
 121     let rec read pos =
 122       let rlen =
 123         let rem = Int64.sub flen pos in (* *)
 124         if rem > Int64.of_int slen then slen else Int64.to_int rem
 125       in
 126       let npos = Int64.add pos (Int64.of_int rlen) in
 127       let str = String.create slen in
 128       Unix32.read file_fd pos str 0 rlen;
 129       Buffer.add_string buf str;
 130       if npos < flen then read npos
 131     in
 132     read Int64.zero;
 133     Unix32.close file_fd;
 134     Che3.decompress (Buffer.contents buf)
 135   with e ->
 136     if !verbose_unexpected_messages then
 137       lprintf_nl "Exception (%s) in (file_to_che3_to_string)" (Printexc2.to_string e);
 138     raise e )
 139
 140 (* Compress string to Che3 and write to file *)
 141 let string_to_che3_to_file str filename =
 142   (try
 143     let s = Che3.compress (Charset.convert Charset.UTF_8 Charset.CP1252 str) in
 144     let wlen = 4096 in
 145     (*let str = String.create slen in*)
 146     let slen = String.length s in
 147     let file_fd = Unix32.create_rw filename in
 148     let rec write pos =
 149       let len =
 150         if (pos + wlen) > slen then slen-pos
 151         else wlen
 152       in
 153       let npos = pos + len in
 154       Unix32.write file_fd (Int64.of_int pos) s pos len;
 155       if npos < slen then write npos
 156     in
 157     write 0;
 158     Unix32.close file_fd;
 159     ()
 160   with e ->
 161     if !verbose_unexpected_messages then
 162       lprintf_nl "Exception (%s) in (string_to_che3_to_file)" (Printexc2.to_string e) )
 163
 164 (* Open bz2 file and return opened data in buffer *)
 165 let file_to_bz2_to_buffer filename =
 166   let buf = Buffer.create 8192 in
 167   let ic = Bzip2.open_in filename in
 168   (try
 169     (*let rec getchar () =
 170       ignore (Bzip2.input_char ic);
 171       incr count;
 172       getchar ()
 173     in getchar ();*)
 174     let rec decompress () =
 175       let str = String.create 4096 in
 176       let n = Bzip2.input ic str 0 (String.length str) in
 177       if n = 0 then ()
 178       else begin
 179         (*let ss = (String.sub str 0 n) in*)
 180         Buffer.add_string buf (String.sub str 0 n);
 181         (*lprintf_nl "(%s)" ss;*)
 182         decompress ()
 183       end
 184     in
 185     decompress ();
 186     Bzip2.close_in ic;
 187     (*lprintf_nl "Size of bz2 buffer: %d" (Buffer.length buf);*)
 188     buf
 189   with
 190   | e ->
 191     if !verbose_unexpected_messages then
 192       lprintf_nl "Exception (%s) in (file_to_bz2_to_buffer)" (Printexc2.to_string e);
 193     Bzip2.close_in ic;
 194     raise e )
 195
 196 (* Compress buffer to bz2 and save to file *)
 197 let buffer_to_bz2_to_file buf filename =
 198   (try
 199     let slen = 4096 in
 200     (*let str = String.create slen in*)
 201     let blen = Buffer.length buf in
 202     let oc = Bzip2.open_out filename in
 203     let rec compress pos =
 204       let len =
 205         if (pos + slen) > blen then blen-pos
 206         else slen
 207       in
 208       let npos = pos + len in
 209       let str = Buffer.sub buf pos len in
 210       Bzip2.output oc str 0 len;
 211       if npos < blen then compress npos
 212     in compress 0;
 213     Bzip2.close_out oc;
 214     ()
 215   with e ->
 216     if !verbose_unexpected_messages then
 217       lprintf_nl "Exception (%s) in (buffer_to_bz2_to_file)" (Printexc2.to_string e) )
 218
 219 (* Create xml and mylist filelist *)
 220 let create_filelist () =
 221   buffer_to_bz2_to_file (make_xml_mylist () ) (Filename.concat directconnect_directory mylistxmlbz2);
 222   if !verbose_upload then lprintf_nl "Created mylist.xml file";
 223   string_to_che3_to_file (make_mylist () ) (Filename.concat directconnect_directory mylist);
 224   if !verbose_upload then lprintf_nl "Created mylist file";
 225   ()
 226
 227 (*let dc_share_file dcsh = ()*)
 228 (*  let magic =
 229     match Magic.M.magic_fileinfo dcsh.dc_shared_fullname false with
 230       None -> None
 231     | Some magic -> Some (HashMagic.merge files_magic magic)
 232   in *)
 233   (*let fd = Unix32.create_ro dcsh.dc_shared_fullname in
 234   let info, index = CommonUploads.new_info dcsh.dc_shared_fullname dcsh.dc_shared_size in *)
 235 (*
 236   let rec impl = {
 237     impl_shared_update = 1;
 238     impl_shared_fullname = dcsh.dc_shared_fullname;
 239     impl_shared_codedname = dcsh.dc_shared_codedname;
 240     impl_shared_size = dcsh.dc_shared_size;
 241     impl_shared_id = Md4.null;
 242     impl_shared_num = 0;
 243     impl_shared_uploaded = Int64.zero;
 244     impl_shared_ops = shared_ops;
 245     impl_shared_val = 0;
 246     impl_shared_requests = 0;
 247     impl_shared_magic = magic;
 248   }
 249   and sh = {
 250     shared_info = index;
 251     shared_codedname = dcsh.dc_shared_codedname;
 252     shared_fd = fd;
 253     shared_format = CommonMultimedia.get_info dcsh.dc_shared_fullname;
 254     shared_impl = impl;
 255     shared_uids_wanted = [];
 256   } in
 257   update_shared_num impl *)
 258   (*Hashtbl.add shareds_by_id info.shared_id sh;*)
 259   (*List.iter (fun uid -> add_by_uid uid sh) info.shared_uids;*)
 260   (*SharedFilesIndex.add sh.shared_info;*)
 261 (*  add_shared_file shared_tree sh (String2.split dcsh.dc_shared_codedname '/');
 262   shared_counter := !shared_counter ++ dcsh.dc_shared_size *)
 263
 264 (* Compute (at most) one TigerTree chunk from unhashed shared files *)
 265 let dc_check_hashed_files () =
 266   let module M = CommonHasher in
 267   if not !dc_tiger_computing then begin
 268     (match !dc_files_to_hash with
 269     | [] -> ()
 270     | dcsh :: files ->
 271         (try
 272           if not (Sys.file_exists dcsh.dc_shared_fullname) then raise Not_found;
 273           if Unix32.getsize dcsh.dc_shared_fullname <> dcsh.dc_shared_size then
 274             raise (Wrong_file_size ((Unix32.getsize dcsh.dc_shared_fullname), dcsh.dc_shared_size));
 275
 276           dc_tiger_computing := true;
 277           let end_pos = dcsh.dc_shared_pos ++ CommonUploads.tiger_block_size in
 278           let end_pos = min end_pos dcsh.dc_shared_size in
 279           let len = end_pos -- dcsh.dc_shared_pos in
 280           (*lprintf_nl "Hashing chunk %d: %Ld-%Ld (%Ld) of %s"
 281             dcsh.dc_shared_chunks dcsh.dc_shared_pos end_pos len dcsh.dc_shared_fullname;*)
 282
 283           M.compute_tiger dcsh.dc_shared_fullname dcsh.dc_shared_pos len
 284             (fun job ->
 285               if job.M.job_error then begin
 286                 lprintf_nl "Error prevent hashing/sharing %s" dcsh.dc_shared_fullname;
 287                 dc_files_to_hash := files;
 288               end else begin
 289                 let new_tiger = job.M.job_result in
 290                 (*lprintf_nl "  (%s)" (TigerTree.to_string new_tiger);*)
 291                 dcsh.dc_shared_tiger_list <- new_tiger :: dcsh.dc_shared_tiger_list;
 292                 dcsh.dc_shared_pos <- end_pos;
 293                 dcsh.dc_shared_chunks <- dcsh.dc_shared_chunks + 1;
 294
 295                 if dcsh.dc_shared_chunks = dc_get_nchunks dcsh.dc_shared_size then begin
 296                   let array = Array.of_list (List.rev dcsh.dc_shared_tiger_list) in
 297                   let root = TigerTree.to_string (CommonUploads.tiger_of_array array) in
 298                   (*dcsh.dc_shared_tiger_array <- array;*)
 299                   dcsh.dc_shared_tiger_list <- [];
 300                   dcsh.dc_shared_tiger_root <- root;
 301                   (*if !verbose_upload then*) lprintf_nl "New shared file (%s) (%s)" root dcsh.dc_shared_fullname;
 302                   dc_files_to_hash := files;
 303                   Hashtbl.add dc_shared_files_by_hash root dcsh;
 304                   DcComplexOptions.dc_saved_shared_files =:= dcsh :: !!DcComplexOptions.dc_saved_shared_files;
 305                 end
 306               end;
 307               dc_tiger_computing := false
 308           )
 309         with
 310         | Wrong_file_size (real,computed) ->
 311             dc_files_to_hash := files;
 312             if !verbose_upload || !verbose_unexpected_messages then
 313               lprintf_nl "Computed filesize %Ld does not match physical filesize %Ld, %s not shared"
 314             computed real dcsh.dc_shared_fullname
 315         | e ->
 316             dc_files_to_hash := files;
 317             dc_tiger_computing := false;
 318             if !verbose_upload || !verbose_unexpected_messages then
 319               lprintf_nl "Exception %s prevents sharing of %s"
 320                 (Printexc2.to_string e) dcsh.dc_shared_fullname ) )
 321   end
 322
 323 let dc_updatesharesize () =
 324   let dc_sharesize = ref Int64.zero in
 325   Hashtbl.iter (fun _ dcsh ->
 326     dc_sharesize := !dc_sharesize ++ dcsh.dc_shared_size) dc_shared_files_by_codedname;
 327   !dc_sharesize
 328
 329 let _ =
 330   network.op_network_share <- (fun fullname codedname size -> (* this is called once/60s with all shared files *)
 331     (try
 332       let dcsh = Hashtbl.find dc_shared_files_by_fullname fullname in
 333       if (dcsh.dc_shared_size = size) then begin            (* if size is correct... *)
 334         if dcsh.dc_shared_codedname <> codedname then begin (* if codedname is different *)
 335           (*lprintf_nl "  Changing codedname (%s) to (%s)" dcsh.dc_shared_codedname codedname;*)
 336           let old_cname = dcsh.dc_shared_codedname in
 337           Hashtbl.remove dc_shared_files_by_codedname old_cname;
 338           dcsh.dc_shared_codedname <- codedname;
 339           Hashtbl.add dc_shared_files_by_codedname codedname dcsh;
 340           if !verbose_upload then lprintf_nl "Changed codedname from (%s) to (%s)" old_cname codedname;
 341         end
 342       end else raise Not_found                              (* create new shared *)
 343     with _ ->
 344       (* if file is moved it is recalculated *)
 345       let dcsh = {
 346         dc_shared_fullname = fullname;
 347         dc_shared_codedname = codedname;
 348         dc_shared_searchname = String.lowercase (List.nth (String2.splitn codedname '/' 1) 1);
 349         dc_shared_size = size;
 350         dc_shared_tiger_root = empty_string;
 351         (*dc_shared_tiger_array = [||];*)
 352         dc_shared_tiger_list = [];
 353         dc_shared_pos = Int64.zero;
 354         dc_shared_chunks = 0;
 355       } in
 356       (*lprintf_nl "New shared file (%s)" codedname;*)
 357       Hashtbl.add dc_shared_files_by_fullname fullname dcsh;
 358       Hashtbl.add dc_shared_files_by_codedname codedname dcsh;
 359       dc_add_shared_file dc_shared_tree dcsh (String2.split codedname '/');
 360       dc_files_to_hash := dcsh :: !dc_files_to_hash;
 361       ()
 362     );
 363     (*ignore (CommonUploads.add_shared fullname codedname size)*)
 364   )