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 () =
  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     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         Printf.bprintf buf "<Directory Name=\"%s\">\r\n" (Xml.escape dir);
  90         ntabs+1
  91       end
  92     in
  93     List.iter (fun dcsh ->
  94       buf_tabs buf ntabs;
  95       let fname = Filename2.basename dcsh.dc_shared_codedname in
  96       Printf.bprintf buf "<File Name=\"%s\" Size=\"%Ld\" TTH=\"%s\"/>\r\n" (Xml.escape fname)
  97         dcsh.dc_shared_size (Xml.escape dcsh.dc_shared_tiger_root)
  98     ) node.shared_files;
  99     List.iter (fun (_, node) ->
 100         iter ntabs node;
 101         buf_tabs buf ntabs;
 102         Printf.bprintf buf "</Directory>\r\n"
 103     ) node.shared_dirs
 104   in
 105   iter 0 dc_shared_tree;
 106   Printf.bprintf buf "</FileListing>";
 107   buf
 108
 109 let file_to_che3_to_string filename =
 110   let buf = Buffer.create 8192 in
 111   let file_fd = Unix32.create_ro filename in
 112   let flen = Unix32.getsize64 file_fd in
 113   let slen = 4096 in
 114   (try
 115     let rec read pos =
 116       let rlen =
 117         let rem = Int64.sub flen pos in (* *)
 118         if rem > Int64.of_int slen then slen else Int64.to_int rem
 119       in
 120       let npos = Int64.add pos (Int64.of_int rlen) in
 121       let str = String.create slen in
 122       Unix32.read file_fd pos str 0 rlen;
 123       Buffer.add_string buf str;
 124       if npos < flen then read npos
 125     in
 126     read Int64.zero;
 127     Unix32.close file_fd;
 128     Che3.decompress (Buffer.contents buf)
 129   with e ->
 130     if !verbose_unexpected_messages then
 131       lprintf_nl "Exception (%s) in (file_to_che3_to_string)" (Printexc2.to_string e);
 132     raise e )
 133
 134 (* Compress string to Che3 and write to file *)
 135 let string_to_che3_to_file str filename =
 136   (try
 137     let s = Che3.compress str in
 138     let wlen = 4096 in
 139     (*let str = String.create slen in*)
 140     let slen = String.length s in
 141     let file_fd = Unix32.create_rw filename in
 142     let rec write pos =
 143       let len =
 144         if (pos + wlen) > slen then slen-pos
 145         else wlen
 146       in
 147       let npos = pos + len in
 148       Unix32.write file_fd (Int64.of_int pos) s pos len;
 149       if npos < slen then write npos
 150     in
 151     write 0;
 152     Unix32.close file_fd;
 153     ()
 154   with e ->
 155     if !verbose_unexpected_messages then
 156       lprintf_nl "Exception (%s) in (string_to_che3_to_file)" (Printexc2.to_string e) )
 157
 158 (* Open bz2 file and return opened data in buffer *)
 159 let file_to_bz2_to_buffer filename =
 160   let buf = Buffer.create 8192 in
 161   let ic = Bzip2.open_in filename in
 162   (try
 163     (*let rec getchar () =
 164       ignore (Bzip2.input_char ic);
 165       incr count;
 166       getchar ()
 167     in getchar ();*)
 168     let rec decompress () =
 169       let str = String.create 4096 in
 170       let n = Bzip2.input ic str 0 (String.length str) in
 171       if n = 0 then ()
 172       else begin
 173         (*let ss = (String.sub str 0 n) in*)
 174         Buffer.add_string buf (String.sub str 0 n);
 175         (*lprintf_nl "(%s)" ss;*)
 176         decompress ()
 177       end
 178     in
 179     decompress ();
 180     Bzip2.close_in ic;
 181     (*lprintf_nl "Size of bz2 buffer: %d" (Buffer.length buf);*)
 182     buf
 183   with
 184   | e ->
 185     if !verbose_unexpected_messages then
 186       lprintf_nl "Exception (%s) in (file_to_bz2_to_buffer)" (Printexc2.to_string e);
 187     Bzip2.close_in ic;
 188     raise e )
 189
 190 (* Compress buffer to bz2 and save to file *)
 191 let buffer_to_bz2_to_file buf filename =
 192   (try
 193     let slen = 4096 in
 194     (*let str = String.create slen in*)
 195     let blen = Buffer.length buf in
 196     let oc = Bzip2.open_out filename in
 197     let rec compress pos =
 198       let len =
 199         if (pos + slen) > blen then blen-pos
 200         else slen
 201       in
 202       let npos = pos + len in
 203       let str = Buffer.sub buf pos len in
 204       Bzip2.output oc str 0 len;
 205       if npos < blen then compress npos
 206     in compress 0;
 207     Bzip2.close_out oc;
 208     ()
 209   with e ->
 210     if !verbose_unexpected_messages then
 211       lprintf_nl "Exception (%s) in (buffer_to_bz2_to_file)" (Printexc2.to_string e) )
 212
 213 (* Create xml and mylist filelist *)
 214 let create_filelist () =
 215   buffer_to_bz2_to_file (make_xml_mylist () ) (Filename.concat directconnect_directory mylistxmlbz2);
 216   if !verbose_upload then lprintf_nl "Created mylist.xml file";
 217   string_to_che3_to_file (make_mylist () ) (Filename.concat directconnect_directory mylist);
 218   if !verbose_upload then lprintf_nl "Created mylist file";
 219   ()
 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   )