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" (DcProtocol.utf_to_dc 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" (DcProtocol.utf_to_dc 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 root =
  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" (Xml.escape Autoconf.current_version);
  83   let rec iter ntabs node =
  84     buf_tabs buf ntabs;
  85     Printf.bprintf buf "<Directory Name=\"%s\">\r\n" (Xml.escape node.shared_dirname);
  86     List.iter (fun dcsh ->
  87       buf_tabs buf (ntabs + 1);
  88       let fname = Filename2.basename dcsh.dc_shared_codedname in
  89       Printf.bprintf buf "<File Name=\"%s\" Size=\"%Ld\" TTH=\"%s\"/>\r\n" (Xml.escape fname)
  90         dcsh.dc_shared_size (Xml.escape dcsh.dc_shared_tiger_root)
  91     ) node.shared_files;
  92     List.iter (fun (_, node) -> iter (ntabs+1) node) node.shared_dirs;
  93     buf_tabs buf ntabs;
  94     Printf.bprintf buf "</Directory>\r\n"
  95   in
  96   if root.shared_dirname = "" then
  97     List.iter (fun (_,node) -> iter 0 node) root.shared_dirs
  98   else
  99     iter 0 root;
 100   Printf.bprintf buf "</FileListing>\r\n";
 101   buf
 102
 103 let file_to_che3_to_string filename =
 104   let buf = Buffer.create 8192 in
 105   let file_fd = Unix32.create_ro filename in
 106   let flen = Unix32.getsize64 file_fd in
 107   let slen = 4096 in
 108   (try
 109     let rec read pos =
 110       let rlen = int64_min_int (flen -- pos) slen in
 111       let npos = Int64.add pos (Int64.of_int rlen) in
 112       let str = String.create slen in
 113       Unix32.read file_fd pos str 0 rlen;
 114       Buffer.add_string buf str;
 115       if npos < flen then read npos
 116     in
 117     read Int64.zero;
 118     Unix32.close file_fd;
 119     Che3.decompress (Buffer.contents buf)
 120   with e ->
 121     if !verbose_unexpected_messages then
 122       lprintf_nl "Exception (%s) in (file_to_che3_to_string)" (Printexc2.to_string e);
 123     raise e )
 124
 125 (* Compress string to Che3 and write to file *)
 126 let string_to_che3_to_file str filename =
 127   (try
 128     let s = Che3.compress str in
 129     let wlen = 4096 in
 130     (*let str = String.create slen in*)
 131     let slen = String.length s in
 132     let file_fd = Unix32.create_rw filename in
 133     let rec write pos =
 134       let len =
 135         if (pos + wlen) > slen then slen-pos
 136         else wlen
 137       in
 138       let npos = pos + len in
 139       Unix32.write file_fd (Int64.of_int pos) s pos len;
 140       if npos < slen then write npos
 141     in
 142     write 0;
 143     Unix32.close file_fd;
 144     ()
 145   with e ->
 146     if !verbose_unexpected_messages then
 147       lprintf_nl "Exception (%s) in (string_to_che3_to_file)" (Printexc2.to_string e) )
 148
 149 (* Open bz2 file and return opened data in buffer *)
 150 let file_to_bz2_to_buffer filename =
 151   let buf = Buffer.create 8192 in
 152   let ic = Bzip2.open_in filename in
 153   (try
 154     (*let rec getchar () =
 155       ignore (Bzip2.input_char ic);
 156       incr count;
 157       getchar ()
 158     in getchar ();*)
 159     let rec decompress () =
 160       let str = String.create 4096 in
 161       let n = Bzip2.input ic str 0 (String.length str) in
 162       if n = 0 then ()
 163       else begin
 164         (*let ss = (String.sub str 0 n) in*)
 165         Buffer.add_string buf (String.sub str 0 n);
 166         (*lprintf_nl "(%s)" ss;*)
 167         decompress ()
 168       end
 169     in
 170     decompress ();
 171     Bzip2.close_in ic;
 172     (*lprintf_nl "Size of bz2 buffer: %d" (Buffer.length buf);*)
 173     buf
 174   with
 175   | e ->
 176     if !verbose_unexpected_messages then
 177       lprintf_nl "Exception (%s) in (file_to_bz2_to_buffer)" (Printexc2.to_string e);
 178     Bzip2.close_in ic;
 179     raise e )
 180
 181 (* Compress buffer to bz2 and save to file *)
 182 let buffer_to_bz2_to_file buf filename =
 183   (try
 184     let slen = 4096 in
 185     (*let str = String.create slen in*)
 186     let blen = Buffer.length buf in
 187     let oc = Bzip2.open_out filename in
 188     let rec compress pos =
 189       let len =
 190         if (pos + slen) > blen then blen-pos
 191         else slen
 192       in
 193       let npos = pos + len in
 194       let str = Buffer.sub buf pos len in
 195       Bzip2.output oc str 0 len;
 196       if npos < blen then compress npos
 197     in compress 0;
 198     Bzip2.close_out oc;
 199     ()
 200   with e ->
 201     if !verbose_unexpected_messages then
 202       lprintf_nl "Exception (%s) in (buffer_to_bz2_to_file)" (Printexc2.to_string e) )
 203
 204 (* Create xml and mylist filelist *)
 205 let create_filelist () =
 206   buffer_to_bz2_to_file (make_xml_mylist dc_shared_tree) (Filename.concat directconnect_directory mylistxmlbz2);
 207   if !verbose_upload then lprintf_nl "Created mylist.xml file";
 208   string_to_che3_to_file (make_mylist () ) (Filename.concat directconnect_directory mylist);
 209   if !verbose_upload then lprintf_nl "Created mylist file";
 210   ()
 211
 212 let find_dir_exn name =
 213   let path = String2.split_simplify name '/' in
 214   let rec follow path node =
 215     match path with
 216     | [] -> node
 217     | x::xs -> follow xs (List.assoc x node.shared_dirs)
 218   in
 219   follow path dc_shared_tree
 220
 221 (*let dc_share_file dcsh = ()*)
 222 (*  let magic =
 223     match Magic.M.magic_fileinfo dcsh.dc_shared_fullname false with
 224       None -> None
 225     | Some magic -> Some (HashMagic.merge files_magic magic)
 226   in *)
 227   (*let fd = Unix32.create_ro dcsh.dc_shared_fullname in
 228   let info, index = CommonUploads.new_info dcsh.dc_shared_fullname dcsh.dc_shared_size in *)
 229 (*
 230   let rec impl = {
 231     impl_shared_update = 1;
 232     impl_shared_fullname = dcsh.dc_shared_fullname;
 233     impl_shared_codedname = dcsh.dc_shared_codedname;
 234     impl_shared_size = dcsh.dc_shared_size;
 235     impl_shared_id = Md4.null;
 236     impl_shared_num = 0;
 237     impl_shared_uploaded = Int64.zero;
 238     impl_shared_ops = shared_ops;
 239     impl_shared_val = 0;
 240     impl_shared_requests = 0;
 241     impl_shared_magic = magic;
 242   }
 243   and sh = {
 244     shared_info = index;
 245     shared_codedname = dcsh.dc_shared_codedname;
 246     shared_fd = fd;
 247     shared_format = CommonMultimedia.get_info dcsh.dc_shared_fullname;
 248     shared_impl = impl;
 249     shared_uids_wanted = [];
 250   } in
 251   update_shared_num impl *)
 252   (*Hashtbl.add shareds_by_id info.shared_id sh;*)
 253   (*List.iter (fun uid -> add_by_uid uid sh) info.shared_uids;*)
 254   (*SharedFilesIndex.add sh.shared_info;*)
 255 (*  add_shared_file shared_tree sh (String2.split dcsh.dc_shared_codedname '/');
 256   shared_counter := !shared_counter ++ dcsh.dc_shared_size *)
 257
 258 (* Compute (at most) one TigerTree chunk from unhashed shared files *)
 259 let dc_check_hashed_files () =
 260   let module M = CommonHasher in
 261   if not !dc_tiger_computing then begin
 262     (match !dc_files_to_hash with
 263     | [] -> ()
 264     | dcsh :: files ->
 265         (try
 266           if not (Sys.file_exists dcsh.dc_shared_fullname) then raise Not_found;
 267           if Unix32.getsize dcsh.dc_shared_fullname <> dcsh.dc_shared_size then
 268             raise (Wrong_file_size ((Unix32.getsize dcsh.dc_shared_fullname), dcsh.dc_shared_size));
 269
 270           dc_tiger_computing := true;
 271           let end_pos = dcsh.dc_shared_pos ++ CommonUploads.tiger_block_size in
 272           let end_pos = min end_pos dcsh.dc_shared_size in
 273           let len = end_pos -- dcsh.dc_shared_pos in
 274           (*lprintf_nl "Hashing chunk %d: %Ld-%Ld (%Ld) of %s"
 275             dcsh.dc_shared_chunks dcsh.dc_shared_pos end_pos len dcsh.dc_shared_fullname;*)
 276
 277           M.compute_tiger dcsh.dc_shared_fullname dcsh.dc_shared_pos len
 278             (fun job ->
 279               if job.M.job_error then begin
 280                 lprintf_nl "Error prevent hashing/sharing %s" dcsh.dc_shared_fullname;
 281                 dc_files_to_hash := files;
 282               end else begin
 283                 let new_tiger = job.M.job_result in
 284                 (*lprintf_nl "  (%s)" (TigerTree.to_string new_tiger);*)
 285                 dcsh.dc_shared_tiger_list <- new_tiger :: dcsh.dc_shared_tiger_list;
 286                 dcsh.dc_shared_pos <- end_pos;
 287                 dcsh.dc_shared_chunks <- dcsh.dc_shared_chunks + 1;
 288
 289                 if dcsh.dc_shared_chunks = dc_get_nchunks dcsh.dc_shared_size then begin
 290                   let array = Array.of_list (List.rev dcsh.dc_shared_tiger_list) in
 291                   let root = TigerTree.to_string (CommonUploads.tiger_of_array array) in
 292                   (*dcsh.dc_shared_tiger_array <- array;*)
 293                   dcsh.dc_shared_tiger_list <- [];
 294                   dcsh.dc_shared_tiger_root <- root;
 295                   (*if !verbose_upload then*) lprintf_nl "New shared file (%s) (%s)" root dcsh.dc_shared_fullname;
 296                   dc_files_to_hash := files;
 297                   Hashtbl.add dc_shared_files_by_hash root dcsh;
 298                   DcComplexOptions.dc_saved_shared_files =:= dcsh :: !!DcComplexOptions.dc_saved_shared_files;
 299                 end
 300               end;
 301               dc_tiger_computing := false
 302           )
 303         with
 304         | Wrong_file_size (real,computed) ->
 305             dc_files_to_hash := files;
 306             if !verbose_upload || !verbose_unexpected_messages then
 307               lprintf_nl "Computed filesize %Ld does not match physical filesize %Ld, %s not shared"
 308             computed real dcsh.dc_shared_fullname
 309         | e ->
 310             dc_files_to_hash := files;
 311             dc_tiger_computing := false;
 312             if !verbose_upload || !verbose_unexpected_messages then
 313               lprintf_nl "Exception %s prevents sharing of %s"
 314                 (Printexc2.to_string e) dcsh.dc_shared_fullname ) )
 315   end
 316
 317 let dc_updatesharesize () =
 318   let dc_sharesize = ref Int64.zero in
 319   Hashtbl.iter (fun _ dcsh ->
 320     dc_sharesize := !dc_sharesize ++ dcsh.dc_shared_size) dc_shared_files_by_codedname;
 321   !dc_sharesize
 322
 323 let _ =
 324   network.op_network_share <- (fun fullname codedname size -> (* this is called once/60s with all shared files *)
 325     (try
 326       let dcsh = Hashtbl.find dc_shared_files_by_fullname fullname in
 327       if (dcsh.dc_shared_size = size) then begin            (* if size is correct... *)
 328         if dcsh.dc_shared_codedname <> codedname then begin (* if codedname is different *)
 329           (*lprintf_nl "  Changing codedname (%s) to (%s)" dcsh.dc_shared_codedname codedname;*)
 330           let old_cname = dcsh.dc_shared_codedname in
 331           Hashtbl.remove dc_shared_files_by_codedname old_cname;
 332           dcsh.dc_shared_codedname <- codedname;
 333           Hashtbl.add dc_shared_files_by_codedname codedname dcsh;
 334           if !verbose_upload then lprintf_nl "Changed codedname from (%s) to (%s)" old_cname codedname;
 335         end
 336       end else raise Not_found                              (* create new shared *)
 337     with _ ->
 338       (* if file is moved it is recalculated *)
 339       let dcsh = {
 340         dc_shared_fullname = fullname;
 341         dc_shared_codedname = codedname;
 342         dc_shared_searchname = String.lowercase (List.nth (String2.splitn codedname '/' 1) 1);
 343         dc_shared_size = size;
 344         dc_shared_tiger_root = empty_string;
 345         (*dc_shared_tiger_array = [||];*)
 346         dc_shared_tiger_list = [];
 347         dc_shared_pos = Int64.zero;
 348         dc_shared_chunks = 0;
 349       } in
 350       (*lprintf_nl "New shared file (%s)" codedname;*)
 351       Hashtbl.add dc_shared_files_by_fullname fullname dcsh;
 352       Hashtbl.add dc_shared_files_by_codedname codedname dcsh;
 353       dc_add_shared_file dc_shared_tree dcsh (String2.split codedname '/');
 354       dc_files_to_hash := dcsh :: !dc_files_to_hash;
 355       ()
 356     );
 357     (*ignore (CommonUploads.add_shared fullname codedname size)*)
 358   )