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