19 |
|
|
20 |
open Printf2 |
open Printf2 |
21 |
open Md4 |
open Md4 |
22 |
|
open Int64ops |
23 |
open CommonClient |
open CommonClient |
24 |
open Options |
open Options |
25 |
open CommonTypes |
open CommonTypes |
31 |
(* TYPES *) |
(* TYPES *) |
32 |
(* *) |
(* *) |
33 |
(*************************************************************************) |
(*************************************************************************) |
34 |
|
|
35 |
type 'a file_impl = { |
type 'a file_impl = { |
36 |
mutable impl_file_update : int; |
mutable impl_file_update : int; |
37 |
mutable impl_file_state : file_state; |
mutable impl_file_state : file_state; |
56 |
|
|
57 |
and 'a file_ops = { |
and 'a file_ops = { |
58 |
mutable op_file_network : network; |
mutable op_file_network : network; |
59 |
|
|
60 |
(* This method is called just before the file is moved to the incomming |
(* This method is called just before the file is moved to the incomming |
61 |
section, and thus, before it is shared. *) |
section, and thus, before it is shared. *) |
62 |
mutable op_file_commit : ('a -> string -> unit); |
mutable op_file_commit : ('a -> string -> unit); |
63 |
|
|
64 |
(* This method is called when the name under which the file should be saved |
(* This method is called when the name under which the file should be saved |
65 |
has been changed. The method should not perform the move, just know that |
has been changed. The method should not perform the move, just know that |
66 |
it will happen soon. *) |
it will happen soon. *) |
90 |
(* as_file... *) |
(* as_file... *) |
91 |
(* *) |
(* *) |
92 |
(*************************************************************************) |
(*************************************************************************) |
93 |
|
|
94 |
let as_file (file : 'a file_impl) = |
let as_file (file : 'a file_impl) = |
95 |
let (file : file) = Obj.magic file in |
let (file : file) = Obj.magic file in |
96 |
file |
file |
97 |
|
|
98 |
let as_file_impl (file : file) = |
let as_file_impl (file : file) = |
99 |
let (file : 'a file_impl) = Obj.magic file in |
let (file : 'a file_impl) = Obj.magic file in |
100 |
file |
file |
101 |
|
|
102 |
let file_num file = |
let file_num file = |
103 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
104 |
impl.impl_file_num |
impl.impl_file_num |
122 |
impl_file_comment = ""; |
impl_file_comment = ""; |
123 |
impl_file_probable_name = None; |
impl_file_probable_name = None; |
124 |
} |
} |
125 |
|
|
126 |
let dummy_file = as_file dummy_file_impl |
let dummy_file = as_file dummy_file_impl |
127 |
|
|
128 |
(*************************************************************************) |
(*************************************************************************) |
129 |
(* *) |
(* *) |
140 |
|
|
141 |
let file_counter = ref 0 |
let file_counter = ref 0 |
142 |
let files_by_num = H.create 1027 |
let files_by_num = H.create 1027 |
|
|
|
143 |
|
|
144 |
(*************************************************************************) |
(*************************************************************************) |
145 |
(* *) |
(* *) |
147 |
(* *) |
(* *) |
148 |
(*************************************************************************) |
(*************************************************************************) |
149 |
|
|
150 |
let ni n m = |
let ni n m = |
151 |
let s = Printf.sprintf "File.%s not implemented by %s" |
let s = Printf.sprintf "File.%s not implemented by %s" |
152 |
m n.network_name in |
m n.network_name in |
153 |
lprintf_nl "%s" s; |
lprintf_nl "%s" s; |
154 |
s |
s |
155 |
|
|
156 |
let fni n m = failwith (ni n m) |
let fni n m = failwith (ni n m) |
157 |
let ni_ok n m = ignore (ni n m) |
let ni_ok n m = ignore (ni n m) |
158 |
|
|
177 |
H.add files_by_num (as_file impl); |
H.add files_by_num (as_file impl); |
178 |
file_must_update (as_file impl); |
file_must_update (as_file impl); |
179 |
end |
end |
180 |
|
|
|
|
|
181 |
let update_file_state impl state = |
let update_file_state impl state = |
182 |
impl.impl_file_state <- state; |
impl.impl_file_state <- state; |
183 |
file_must_update (as_file impl) |
file_must_update (as_file impl) |
224 |
file.impl_file_ops.op_file_resume file.impl_file_val |
file.impl_file_ops.op_file_resume file.impl_file_val |
225 |
| _ -> () |
| _ -> () |
226 |
|
|
227 |
let set_file_state file state = |
let set_file_state file state = |
228 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
229 |
update_file_state impl state |
update_file_state impl state |
230 |
|
|
231 |
let set_file_comment file comment = |
let set_file_comment file comment = |
232 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
233 |
impl.impl_file_comment <- comment |
impl.impl_file_comment <- comment |
234 |
|
|
240 |
let file = as_file_impl file in |
let file = as_file_impl file in |
241 |
file.impl_file_best_name |
file.impl_file_best_name |
242 |
|
|
243 |
let set_file_best_name file name = |
let set_file_best_name file name = |
244 |
let file = as_file_impl file in |
let file = as_file_impl file in |
245 |
let name = String2.replace name '/' "::" in |
let name = String2.replace name '/' "::" in |
246 |
file.impl_file_best_name <- name |
file.impl_file_best_name <- name |
249 |
let file = as_file_impl file in |
let file = as_file_impl file in |
250 |
file.impl_file_ops.op_file_set_format file.impl_file_val format |
file.impl_file_ops.op_file_set_format file.impl_file_val format |
251 |
|
|
|
|
|
252 |
let file_check (file : file) = |
let file_check (file : file) = |
253 |
let file = as_file_impl file in |
let file = as_file_impl file in |
254 |
file.impl_file_ops.op_file_check file.impl_file_val |
file.impl_file_ops.op_file_check file.impl_file_val |
255 |
|
|
|
|
|
256 |
let file_recover (file : file) = |
let file_recover (file : file) = |
257 |
let file = as_file_impl file in |
let file = as_file_impl file in |
258 |
file.impl_file_ops.op_file_recover file.impl_file_val |
file.impl_file_ops.op_file_recover file.impl_file_val |
274 |
try impl.impl_file_ops.op_file_active_sources impl.impl_file_val with _ -> [] |
try impl.impl_file_ops.op_file_active_sources impl.impl_file_val with _ -> [] |
275 |
|
|
276 |
(* Default for networks that don't implement it *) |
(* Default for networks that don't implement it *) |
277 |
let default_file_print_sources_html file buf = |
let default_file_print_sources_html file buf = |
278 |
let cfile = as_file file in |
let cfile = as_file file in |
279 |
let allsources = ref (file_all_sources cfile) in |
let allsources = ref (file_all_sources cfile) in |
280 |
if List.length !allsources > 0 then begin |
if List.length !allsources > 0 then begin |
281 |
|
|
282 |
html_mods_table_header buf "sourcesTable" "sources al" [ |
html_mods_table_header buf "sourcesTable" "sources al" [ |
283 |
( "1", "srh br ac", "Client number", "Num" ) ; |
( "1", "srh br ac", "Client number", "Num" ) ; |
284 |
( "0", "srh br", "Client Name", "Name" ) ; |
( "0", "srh br", "Client Name", "Name" ) ; |
285 |
( "0", "srh br", "IP address", "IP address" ) ; |
( "0", "srh br", "IP address", "IP address" ) ; |
286 |
( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; |
( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; |
287 |
( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ; ]; |
( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ; ]; |
288 |
|
|
289 |
html_mods_cntr_init (); |
html_mods_cntr_init (); |
317 |
|
|
318 |
let file_print_sources_html (file : file) buf = |
let file_print_sources_html (file : file) buf = |
319 |
let file = as_file_impl file in |
let file = as_file_impl file in |
320 |
try file.impl_file_ops.op_file_print_sources_html file.impl_file_val buf with _ -> |
try file.impl_file_ops.op_file_print_sources_html file.impl_file_val buf with _ -> |
321 |
default_file_print_sources_html file buf |
default_file_print_sources_html file buf |
322 |
|
|
323 |
let file_print_html file buf = |
let file_print_html file buf = |
324 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
325 |
impl.impl_file_ops.op_file_print_html impl.impl_file_val buf |
impl.impl_file_ops.op_file_print_html impl.impl_file_val buf |
326 |
|
|
327 |
|
let file_find num = |
|
let file_find num = |
|
328 |
H.find files_by_num (as_file { |
H.find files_by_num (as_file { |
329 |
dummy_file_impl with impl_file_num = num |
dummy_file_impl with impl_file_num = num |
330 |
}) |
}) |
331 |
|
|
332 |
let file_state file = |
let file_state file = |
333 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
334 |
impl.impl_file_state |
impl.impl_file_state |
335 |
|
|
336 |
let file_add_source (file : file) c = |
let file_add_source (file : file) c = |
337 |
client_must_update c; |
client_must_update c; |
338 |
CommonEvent.add_event (File_add_source_event (file,c)) |
CommonEvent.add_event (File_add_source_event (file,c)) |
339 |
|
|
340 |
let file_remove_source (file : file) c = |
let file_remove_source (file : file) c = |
341 |
CommonEvent.add_event (File_remove_source_event (file,c)) |
CommonEvent.add_event (File_remove_source_event (file,c)) |
342 |
|
|
344 |
[x] -> x |
[x] -> x |
345 |
| _ :: l -> last l |
| _ :: l -> last l |
346 |
| _ -> (Int64.zero, 0) |
| _ -> (Int64.zero, 0) |
347 |
|
|
348 |
let sample_timer () = |
let sample_timer () = |
349 |
let trimto list length = |
let trimto list length = |
350 |
let (list, _) = List2.cut length list in |
let (list, _) = List2.cut length list in |
354 |
H.iter (fun file -> |
H.iter (fun file -> |
355 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
356 |
impl.impl_file_last_received <- |
impl.impl_file_last_received <- |
357 |
trimto ((impl.impl_file_received, time) :: |
trimto ((impl.impl_file_received, time) :: |
358 |
impl.impl_file_last_received) |
impl.impl_file_last_received) |
359 |
!!CommonOptions.download_sample_size; |
!!CommonOptions.download_sample_size; |
360 |
match impl.impl_file_last_received with |
match impl.impl_file_last_received with |
376 |
in |
in |
377 |
impl.impl_file_last_rate <- rate; |
impl.impl_file_last_rate <- rate; |
378 |
rate |
rate |
379 |
|
|
380 |
let add_file_downloaded file n = |
let add_file_downloaded file n = |
381 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
382 |
impl.impl_file_downloaded <- Int64.add impl.impl_file_downloaded n; |
impl.impl_file_downloaded <- Int64.add impl.impl_file_downloaded n; |
384 |
if Int64.compare n Int64.zero > 0 then |
if Int64.compare n Int64.zero > 0 then |
385 |
impl.impl_file_received <- Int64.add impl.impl_file_received n; |
impl.impl_file_received <- Int64.add impl.impl_file_received n; |
386 |
file_must_update_downloaded (as_file impl) |
file_must_update_downloaded (as_file impl) |
387 |
|
|
388 |
let file_size file = |
let file_size file = |
389 |
(as_file_impl file).impl_file_size |
(as_file_impl file).impl_file_size |
390 |
|
|
391 |
let file_disk_name file = |
let file_disk_name file = |
392 |
Unix32.filename (as_file_impl file).impl_file_fd |
Unix32.filename (as_file_impl file).impl_file_fd |
393 |
|
|
394 |
let file_fd file = |
let file_fd file = |
395 |
(as_file_impl file).impl_file_fd |
(as_file_impl file).impl_file_fd |
396 |
|
|
401 |
let orig_fd = file_fd file in |
let orig_fd = file_fd file in |
402 |
if orig_fd != Unix32.bad_fd then |
if orig_fd != Unix32.bad_fd then |
403 |
Unix32.rename orig_fd filename |
Unix32.rename orig_fd filename |
404 |
|
|
405 |
let file_downloaded file = (as_file_impl file).impl_file_downloaded |
let file_downloaded file = (as_file_impl file).impl_file_downloaded |
406 |
|
|
407 |
let file_network file = |
let file_network file = |
408 |
(as_file_impl file).impl_file_ops.op_file_network |
(as_file_impl file).impl_file_ops.op_file_network |
409 |
|
|
410 |
let file_priority file = |
let file_priority file = |
411 |
(as_file_impl file).impl_file_priority |
(as_file_impl file).impl_file_priority |
412 |
|
|
413 |
let set_file_priority file p = |
let set_file_priority file p = |
414 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
415 |
if impl.impl_file_priority <> p then begin |
if impl.impl_file_priority <> p then begin |
416 |
impl.impl_file_priority <- p; |
impl.impl_file_priority <- p; |
417 |
impl.impl_file_ops.op_file_set_priority impl.impl_file_val p; |
impl.impl_file_ops.op_file_set_priority impl.impl_file_val p; |
418 |
file_must_update file |
file_must_update file |
419 |
end |
end |
420 |
|
|
435 |
|
|
436 |
module G = GuiTypes |
module G = GuiTypes |
437 |
|
|
438 |
let file_downloaders file o cnt = |
let file_downloaders file o cnt = |
439 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
440 |
|
|
441 |
let srcs = file_active_sources file in |
let srcs = file_active_sources file in |
|
|
|
442 |
let counter = ref cnt in |
let counter = ref cnt in |
443 |
List.iter (fun c -> |
List.iter (fun c -> |
444 |
match (client_state c) with |
match (client_state c) with |
445 |
Connected_downloading _ -> |
Connected_downloading _ -> |
446 |
(begin |
(begin |
447 |
if use_html_mods o then begin |
if use_html_mods o then begin |
448 |
if (client_dprint_html c o file (if !counter mod 2 == 0 then "dl-1" else "dl-2";)) |
if (client_dprint_html c o file (if !counter mod 2 == 0 then "dl-1" else "dl-2";)) |
449 |
then incr counter; |
then incr counter; |
450 |
end |
end |
462 |
(* file_print *) |
(* file_print *) |
463 |
(* *) |
(* *) |
464 |
(*************************************************************************) |
(*************************************************************************) |
465 |
|
|
466 |
(* Use span for Opera DOM compatibility *) |
(* Use span for Opera DOM compatibility *) |
467 |
let colored_chunks chunks = |
let colored_chunks chunks = |
468 |
let ostr = ref "" in |
let ostr = ref "" in |
488 |
nextbit 99; |
nextbit 99; |
489 |
!ostr |
!ostr |
490 |
|
|
491 |
let file_print file o = |
let file_print file o = |
492 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
493 |
let info = file_info file in |
let info = file_info file in |
494 |
let n = impl.impl_file_ops.op_file_network in |
let n = impl.impl_file_ops.op_file_network in |
495 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
496 |
let srcs = file_all_sources file in |
let srcs = file_all_sources file in |
497 |
let active_srcs = file_active_sources file in |
let active_srcs = file_active_sources file in |
498 |
|
|
|
|
|
499 |
if use_html_mods o then begin |
if use_html_mods o then begin |
500 |
|
|
501 |
html_mods_table_header buf "sourcesInfo" "sourcesInfo" [ |
html_mods_table_header buf "sourcesInfo" "sourcesInfo" [ |
502 |
( "0", "srh br", "File Info", "Info" ) ; |
( "0", "srh br", "File Info", "Info" ) ; |
503 |
( "0", "srh", "Value", "Value" ) ]; |
( "0", "srh", "Value", "Value" ) ]; |
504 |
|
|
505 |
Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; |
Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; |
506 |
html_mods_td buf [ |
html_mods_td buf [ |
507 |
("File number/Network", "sr br", "[#] Network"); |
("File number/Network", "sr br", "[#] Network"); |
508 |
("", "sr", Printf.sprintf "[%d] %s" (file_num file) n.network_name) ]; |
("", "sr", Printf.sprintf "[%d] %s" (file_num file) n.network_name) ]; |
509 |
|
|
510 |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-2\\\"\\>"; |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-2\\\"\\>"; |
511 |
html_mods_td buf [ |
html_mods_td buf [ |
512 |
("Downloaded/Total size", "sr br", "DLed/Size"); |
("Downloaded/Total size", "sr br", "DLed/Size"); |
513 |
("", "sr", Printf.sprintf "%s bytes of %s bytes" |
("", "sr", Printf.sprintf "%s bytes of %s bytes" |
514 |
(Int64.to_string info.G.file_downloaded) (Int64.to_string info.G.file_size) ) ]; |
(Int64.to_string info.G.file_downloaded) (Int64.to_string info.G.file_size) ) ]; |
515 |
|
|
516 |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>"; |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>"; |
517 |
html_mods_td buf [ |
html_mods_td buf [ |
518 |
("File priority", "sr br", "Priority"); |
("File priority", "sr br", "Priority"); |
519 |
("", "sr", Printf.sprintf "%d" (file_priority file)) ]; |
("", "sr", Printf.sprintf "%d" (file_priority file)) ]; |
520 |
|
|
521 |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-2\\\"\\>"; |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-2\\\"\\>"; |
522 |
html_mods_td buf [ |
html_mods_td buf [ |
523 |
("Number of file sources", "sr br", "Sources"); |
("Number of file sources", "sr br", "Sources"); |
524 |
("", "sr", Printf.sprintf "%d" (List.length srcs)) ]; |
("", "sr", Printf.sprintf "%d" (List.length srcs)) ]; |
525 |
|
|
526 |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>"; |
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-1\\\"\\>"; |
527 |
let tt = ref "0=Missing, 1=Partial, 2=Complete, 3=Verified" in |
let tt = ref "0=Missing, 1=Partial, 2=Complete, 3=Verified" in |
528 |
html_mods_td buf [ |
html_mods_td buf [ |
529 |
(!tt, "sr br", "Chunks"); |
(!tt, "sr br", "Chunks"); |
530 |
(!tt, "sr", info.G.file_chunks) ]; |
(!tt, "sr", info.G.file_chunks) ]; |
531 |
|
|
|
|
|
532 |
file_print_html file buf; |
file_print_html file buf; |
533 |
|
|
534 |
Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"; |
Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"; |
535 |
Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\<br\\>"; |
Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\<br\\>"; |
536 |
|
|
537 |
end else |
end else |
538 |
begin |
begin |
539 |
Printf.bprintf buf "[%-s %5d]\n%s\n%s\nTotal %10s\nPartial %10s\npriority %d\n" |
Printf.bprintf buf "[%-s %5d]\n%s\n%s\nTotal %10s\nPartial %10s\npriority %d\n" |
540 |
n.network_name |
n.network_name |
541 |
(file_num file) |
(file_num file) |
542 |
(String2.shorten 80 (file_best_name file)) |
(String2.shorten 80 (file_best_name file)) |
543 |
(string_of_uids info.G.file_uids) |
(string_of_uids info.G.file_uids) |
544 |
(Int64.to_string info.G.file_size) |
(Int64.to_string info.G.file_size) |
545 |
(Int64.to_string info.G.file_downloaded) |
(Int64.to_string info.G.file_downloaded) |
546 |
(file_priority file); |
(file_priority file); |
551 |
Printf.bprintf buf "Probable name: %s\n" filename); |
Printf.bprintf buf "Probable name: %s\n" filename); |
552 |
List.iter (fun (name,_) -> Printf.bprintf buf " (%s)\n" name) info.G.file_names |
List.iter (fun (name,_) -> Printf.bprintf buf " (%s)\n" name) info.G.file_names |
553 |
end; |
end; |
554 |
|
|
555 |
(try |
(try |
556 |
|
|
557 |
if !!print_all_sources then begin |
if !!print_all_sources then begin |
569 |
end |
end |
570 |
|
|
571 |
with _ -> ()) |
with _ -> ()) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
572 |
|
|
573 |
(*************************************************************************) |
(*************************************************************************) |
574 |
(* *) |
(* *) |
575 |
(* add_segment (internal) *) |
(* add_segment (internal) *) |
576 |
(* *) |
(* *) |
577 |
(*************************************************************************) |
(*************************************************************************) |
578 |
open Int64ops |
|
|
|
|
579 |
let add_segment begin_pos end_pos segments = |
let add_segment begin_pos end_pos segments = |
580 |
(* lprintf "Adding segment %Ld - %Ld\n" begin_pos end_pos; *) |
(* lprintf "Adding segment %Ld - %Ld\n" begin_pos end_pos; *) |
581 |
match segments with |
match segments with |
592 |
(* recover_bytes *) |
(* recover_bytes *) |
593 |
(* *) |
(* *) |
594 |
(*************************************************************************) |
(*************************************************************************) |
595 |
|
|
596 |
let recover_bytes file = |
let recover_bytes file = |
597 |
let size = file_size file in |
let size = file_size file in |
598 |
let fd = file_fd file in |
let fd = file_fd file in |
601 |
let s = String.create len in |
let s = String.create len in |
602 |
|
|
603 |
let rec iter_file_out file_pos segments = |
let rec iter_file_out file_pos segments = |
604 |
|
|
605 |
(* lprintf "iter_file_out pos = %Ld\n" file_pos; *) |
(* lprintf "iter_file_out pos = %Ld\n" file_pos; *) |
606 |
if file_pos = size then segments else |
if file_pos = size then segments else |
607 |
|
|
614 |
then |
then |
615 |
iter_string_out (file_pos++max64) 0 max segments |
iter_string_out (file_pos++max64) 0 max segments |
616 |
else segments |
else segments |
617 |
|
|
618 |
and iter_file_in file_pos begin_pos segments = |
and iter_file_in file_pos begin_pos segments = |
619 |
(* lprintf "iter_file_in file_pos = %Ld begin_pos = %Ld\n" file_pos begin_pos; *) |
(* lprintf "iter_file_in file_pos = %Ld begin_pos = %Ld\n" file_pos begin_pos; *) |
620 |
|
|
621 |
if file_pos = size then |
if file_pos = size then |
622 |
if begin_pos <> size then |
if begin_pos <> size then |
623 |
add_segment begin_pos size segments |
add_segment begin_pos size segments |
624 |
else segments |
else segments |
625 |
else |
else |
626 |
|
|
627 |
let max64 = min len64 (size -- file_pos) in |
let max64 = min len64 (size -- file_pos) in |
628 |
let max = Int64.to_int max64 in |
let max = Int64.to_int max64 in |
629 |
if try |
if try |
636 |
if begin_pos < file_pos then |
if begin_pos < file_pos then |
637 |
add_segment begin_pos file_pos segments |
add_segment begin_pos file_pos segments |
638 |
else segments |
else segments |
639 |
|
|
640 |
and iter_string_out file_pos pos max segments = |
and iter_string_out file_pos pos max segments = |
641 |
|
|
642 |
(* lprintf "iter_string_out file_pos = %Ld pos = %d len = %d\n" |
(* lprintf "iter_string_out file_pos = %Ld pos = %d len = %d\n" |
643 |
file_pos pos max; |
file_pos pos max; |
644 |
|
|
645 |
iter_string_out_ file_pos pos max segments |
iter_string_out_ file_pos pos max segments |
646 |
|
|
647 |
and iter_string_out_ file_pos pos max segments = *) |
and iter_string_out_ file_pos pos max segments = *) |
648 |
if pos = max then |
if pos = max then |
649 |
iter_file_out file_pos segments |
iter_file_out file_pos segments |
654 |
let begin_pos = file_pos -- (Int64.of_int (max - pos)) in |
let begin_pos = file_pos -- (Int64.of_int (max - pos)) in |
655 |
(* lprintf " Downloaded byte at %Ld\n" begin_pos; *) |
(* lprintf " Downloaded byte at %Ld\n" begin_pos; *) |
656 |
iter_string_in file_pos (pos+1) max begin_pos segments |
iter_string_in file_pos (pos+1) max begin_pos segments |
657 |
|
|
658 |
and iter_string_in file_pos pos max begin_pos segments = |
and iter_string_in file_pos pos max begin_pos segments = |
659 |
|
|
660 |
(* |
(* |
661 |
lprintf "iter_string_in file_pos = %Ld pos = %d len = %d begin_pos = %Ld\n" |
lprintf "iter_string_in file_pos = %Ld pos = %d len = %d begin_pos = %Ld\n" |
662 |
file_pos pos max begin_pos; |
file_pos pos max begin_pos; |
663 |
|
|
664 |
iter_string_in_ file_pos pos max begin_pos segments |
iter_string_in_ file_pos pos max begin_pos segments |
665 |
|
|
666 |
and iter_string_in_ file_pos pos max begin_pos segments = *) |
and iter_string_in_ file_pos pos max begin_pos segments = *) |
667 |
|
|
668 |
if pos = max then |
if pos = max then |
669 |
iter_file_in file_pos begin_pos segments |
iter_file_in file_pos begin_pos segments |
670 |
else |
else |
675 |
(add_segment begin_pos end_pos segments) |
(add_segment begin_pos end_pos segments) |
676 |
else |
else |
677 |
iter_string_in file_pos (pos+1) max begin_pos segments |
iter_string_in file_pos (pos+1) max begin_pos segments |
678 |
|
|
679 |
in |
in |
680 |
let segments = List.rev (iter_file_out zero []) in |
let segments = List.rev (iter_file_out zero []) in |
681 |
(* |
(* |
693 |
(*************************************************************************) |
(*************************************************************************) |
694 |
|
|
695 |
let files_ops = ref [] |
let files_ops = ref [] |
696 |
|
|
697 |
let new_file_ops network = |
let new_file_ops network = |
698 |
let f = |
let f = |
699 |
{ |
{ |
700 |
op_file_network = network; |
op_file_network = network; |
769 |
(* MAIN *) |
(* MAIN *) |
770 |
(* *) |
(* *) |
771 |
(*************************************************************************) |
(*************************************************************************) |
772 |
|
|
773 |
let _ = |
let _ = |
774 |
Heap.add_memstat "CommonFile" (fun level buf -> |
Heap.add_memstat "CommonFile" (fun level buf -> |
775 |
let counter = ref 0 in |
let counter = ref 0 in |
776 |
H.iter (fun _ -> incr counter) files_by_num; |
H.iter (fun _ -> incr counter) files_by_num; |
789 |
lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s); |
lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s); |
790 |
AnyEndian.dump_sub s pos len; |
AnyEndian.dump_sub s pos len; |
791 |
*) |
*) |
792 |
|
|
793 |
if !!CommonOptions.buffer_writes then |
if !!CommonOptions.buffer_writes then |
794 |
Unix32.buffered_write_copy (file_fd file) offset s pos len |
Unix32.buffered_write_copy (file_fd file) offset s pos len |
795 |
else |
else |
796 |
Unix32.write (file_fd file) offset s pos len |
Unix32.write (file_fd file) offset s pos len |
797 |
|
|
798 |
let file_verify file key begin_pos end_pos = |
let file_verify file key begin_pos end_pos = |
799 |
Unix32.flush_fd (file_fd file); |
Unix32.flush_fd (file_fd file); |
800 |
if !verbose_md4 then begin |
if !verbose_md4 then begin |
804 |
try |
try |
805 |
let computed = match key with |
let computed = match key with |
806 |
| Ed2k md4 -> |
| Ed2k md4 -> |
807 |
let result = Md4.digest_subfile (file_fd file) |
let result = Md4.digest_subfile (file_fd file) |
808 |
begin_pos (end_pos -- begin_pos) in |
begin_pos (end_pos -- begin_pos) in |
809 |
Ed2k result |
Ed2k result |
810 |
| Sha1 sha1 -> |
| Sha1 sha1 -> |
811 |
let result = Sha1.digest_subfile (file_fd file) |
let result = Sha1.digest_subfile (file_fd file) |
812 |
begin_pos (end_pos -- begin_pos) in |
begin_pos (end_pos -- begin_pos) in |
813 |
Sha1 result |
Sha1 result |
814 |
| TigerTree ttr -> |
| TigerTree ttr -> |
815 |
let result = TigerTree.digest_subfile (file_fd file) |
let result = TigerTree.digest_subfile (file_fd file) |
816 |
begin_pos (end_pos -- begin_pos) in |
begin_pos (end_pos -- begin_pos) in |
817 |
TigerTree result |
TigerTree result |
818 |
| _ -> |
| _ -> |
836 |
let file_copy file1 file2 pos1 pos2 size = |
let file_copy file1 file2 pos1 pos2 size = |
837 |
Unix32.copy_chunk (file_fd file1) (file_fd file2) |
Unix32.copy_chunk (file_fd file1) (file_fd file2) |
838 |
pos1 pos2 (Int64.to_int size) |
pos1 pos2 (Int64.to_int size) |
839 |
|
|
840 |
let propose_filename file = |
let propose_filename file = |
841 |
(* lprintf "propose_filename...\n"; *) |
(* lprintf "propose_filename...\n"; *) |
842 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |