DC: fix performance problem when creating filelist
[mldonkey.git] / src / networks / direct_connect / dcShared.ml
blob0bcb5a727026d561c0f4f98bbe1e2aa7bd3562e0
1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
2 (*
3 This file is part of mldonkey.
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.
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.
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
19 open Int64ops
20 open Printf2
21 open Md4
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
36 open DcTypes
37 open DcOptions
38 open DcComplexOptions
39 open DcGlobals
41 let log_prefix = "[dcSh]"
43 let lprintf_nl fmt =
44 lprintf_nl2 log_prefix fmt
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
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
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
75 iter 0 dc_shared_tree;
76 Buffer.contents buf
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
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
105 iter 0 dc_shared_tree;
106 Printf.bprintf buf "</FileListing>";
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
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
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 )
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
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
151 write 0;
152 Unix32.close file_fd;
154 with e ->
155 if !verbose_unexpected_messages then
156 lprintf_nl "Exception (%s) in (string_to_che3_to_file)" (Printexc2.to_string e) )
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 ()
179 decompress ();
180 Bzip2.close_in ic;
181 (*lprintf_nl "Size of bz2 buffer: %d" (Buffer.length 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 )
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
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;
209 with e ->
210 if !verbose_unexpected_messages then
211 lprintf_nl "Exception (%s) in (buffer_to_bz2_to_file)" (Printexc2.to_string e) )
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";
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 *)
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;
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 *)
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));
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;*)
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;
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;
300 end;
301 dc_tiger_computing := false
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 ) )
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
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;
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;
357 (*ignore (CommonUploads.add_shared fullname codedname size)*)