[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co... |
|
Date: |
Mon, 31 Jan 2011 17:17:07 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Changes by: spiralvoice <spiralvoice> 11/01/31 17:17:07
Modified files:
distrib : ChangeLog
src/daemon/common: commonFile.ml commonSwarming.ml
src/daemon/driver: driverCommands.ml
src/networks/bittorrent: bTInteractive.ml
src/utils/lib : unix32.ml unix32.mli
Log message:
patch #7448
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1513&r2=1.1514
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.ml?cvsroot=mldonkey&r1=1.81&r2=1.82
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonSwarming.ml?cvsroot=mldonkey&r1=1.66&r2=1.67
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.261&r2=1.262
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.164&r2=1.165
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/unix32.ml?cvsroot=mldonkey&r1=1.75&r2=1.76
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/unix32.mli?cvsroot=mldonkey&r1=1.26&r2=1.27
Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1513
retrieving revision 1.1514
diff -u -b -r1.1513 -r1.1514
--- distrib/ChangeLog 25 Jan 2011 19:35:47 -0000 1.1513
+++ distrib/ChangeLog 31 Jan 2011 17:17:04 -0000 1.1514
@@ -14,6 +14,11 @@
ChangeLog
=========
+2011/01/31
+7448: BT: support for partial download (jave, pango & ygrek)
+- partial files are not committed, location in temp dir is shown so that users
+ can easily locate downloaded subfiles
+
2011/01/23
7442: BT: DHT support (ygrek)
- new options BT-dht_port, BT-use_trackers, BT-dht_bootstrap_nodes
Index: src/daemon/common/commonFile.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -b -r1.81 -r1.82
--- src/daemon/common/commonFile.ml 19 Dec 2010 10:04:58 -0000 1.81
+++ src/daemon/common/commonFile.ml 31 Jan 2011 17:17:04 -0000 1.82
@@ -700,6 +700,23 @@
let buf = o.conn_buf in
let srcs = file_all_sources file in
+ let chunks_counts chunks =
+ let tc = VerificationBitmap.length chunks in
+ let c0 = ref 0 in
+ let c1 = ref 0 in
+ let c2 = ref 0 in
+ let c3 = ref 0 in
+
+ VerificationBitmap.iteri (fun _ c ->
+ match c with
+ | VerificationBitmap.State_missing -> incr c0
+ | VerificationBitmap.State_partial -> incr c1
+ | VerificationBitmap.State_complete -> incr c2
+ | VerificationBitmap.State_verified -> incr c3
+ ) chunks;
+ Printf.sprintf "%d = %d + %d + %d + %d" tc !c0 !c1 !c2 !c3
+ in
+
if use_html_mods o then begin
html_mods_cntr_init ();
@@ -807,35 +824,21 @@
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>"
(html_mods_cntr ());
- (match info.G.file_chunks with
+ begin match info.G.file_chunks with
| None -> ()
| Some chunks ->
- let tt = "0=Missing, 1=Partial, 2=Complete, 3=Verified" in
- let tc = VerificationBitmap.length chunks in
- let c0 = ref 0 in
- let c1 = ref 0 in
- let c2 = ref 0 in
- let c3 = ref 0 in
-
- VerificationBitmap.iteri (fun _ c ->
- match c with
- | VerificationBitmap.State_missing -> incr c0
- | VerificationBitmap.State_partial -> incr c1
- | VerificationBitmap.State_complete -> incr c2
- | VerificationBitmap.State_verified -> incr c3
- ) chunks;
-
- let header = Printf.sprintf "%d (%d+%d+%d+%d): " tc !c0 !c1 !c2 !c3 in
+ let tt = "Total = Missing + Partial + Complete + Verified" in
+ let summary = chunks_counts chunks in
html_mods_td buf [
(tt, "sr br", "Chunks");
(tt, "sr",
- header ^ if !!html_vd_chunk_graph then
+ summary ^ if !!html_vd_chunk_graph then
colored_chunks chunks
else
VerificationBitmap.to_string chunks
) ]
- );
+ end;
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>"
(html_mods_cntr ());
html_mods_td buf [
@@ -874,10 +877,9 @@
(match file_group file with
Some group -> Printf.sprintf "%s" group.group_name
| None -> "private");
- Printf.bprintf buf "Chunks: [%-s]\n"
(match info.G.file_chunks with
- | None -> ""
- | Some chunks -> VerificationBitmap.to_string chunks);
+ | None -> ()
+ | Some chunks -> Printf.bprintf buf "Chunks: %s\n" (chunks_counts
chunks));
(match impl.impl_file_probable_name with
None -> ()
| Some filename ->
Index: src/daemon/common/commonSwarming.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSwarming.ml,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -b -r1.66 -r1.67
--- src/daemon/common/commonSwarming.ml 3 Feb 2008 23:09:19 -0000 1.66
+++ src/daemon/common/commonSwarming.ml 31 Jan 2011 17:17:04 -0000 1.67
@@ -143,6 +143,9 @@
mutable s_strategy : swarming_strategy;
mutable s_verified_bitmap : VerificationBitmap.t;
+ mutable s_priorities_bitmap : string;
+ mutable s_priorities_intervals : (int64 * int) list;
+ (* beginning, priority *)
mutable s_disk_allocated : Bitv.t;
mutable s_availability : int array;
mutable s_nuploading : int array;
@@ -579,6 +582,8 @@
s_networks = [];
s_strategy = AdvancedStrategy;
s_verified_bitmap = VB.create 0 VB.State_missing;
+ s_priorities_bitmap = "";
+ s_priorities_intervals = [(zero, 1)];
s_disk_allocated = Bitv.create 0 false;
s_blocks = [||];
s_block_pos = [||];
@@ -586,10 +591,93 @@
s_nuploading = [||];
}
+let insert_prio_interval intervals last_end (new_start,new_end,new_prio) =
+ assert (new_start < new_end);
+ assert (new_end <= last_end);
+ let rec insert_end prev_prio = function
+ | [] -> if new_end = last_end then [] else if new_prio <> prev_prio then
[new_end, prev_prio] else []
+ | (pos,prio as this) :: tail ->
+ match Int64.compare pos new_end with
+ | -1 -> insert_end prio tail (* eat it *)
+ | 1 ->
+ if new_prio <> prev_prio then
+ (new_end, prev_prio) :: this :: tail
+ else
+ this :: tail
+ | 0 ->
+ assert (prio <> prev_prio);
+ if new_prio <> prio then this :: tail else tail
+ | _ -> assert false
+ in
+ let rec insert prev_prio = function (* not tail rec ! *)
+ | [] ->
+ if new_prio <> prev_prio then
+ (new_start, new_prio) :: insert_end prev_prio []
+ else
+ insert_end prev_prio []
+ | (pos, prio as this) :: tail ->
+ match Int64.compare pos new_start with
+ | -1 -> this :: insert prio tail (* leave current and continue searching
*)
+ | 1 ->
+ if new_prio <> prev_prio then
+ (new_start, new_prio) :: insert_end prev_prio (this::tail) (* mark
new interval and search interval end *)
+ else
+ insert_end prev_prio (this::tail) (* start of new interval gets
merged with previous interval *)
+ | 0 ->
+ assert (prio <> prev_prio); (* invariant *)
+ if new_prio <> prev_prio then
+ (new_start, new_prio) :: insert_end prio tail
+ else
+ insert_end prio tail
+ | _ -> assert false
+ in
+ insert (-1) intervals
+
+let rec validate_intervals limit = function
+ | (p1,prio1)::((p2,prio2)::_ as tail) when prio1 <> prio2 && p1 < p2 ->
validate_intervals limit tail
+ | [p,_] when p < limit -> true
+ | _ -> false
+
+let priority_zero = Char.chr 0
+
+let swarmer_recompute_priorities_bitmap s =
+ String.fill s.s_priorities_bitmap 0
+ (String.length s.s_priorities_bitmap) priority_zero;
+ let mark interval_begin interval_end priority =
+ if interval_end > interval_begin && s.s_size >= interval_end &&
interval_begin >= 0L then
+ if priority = 0 then
+ () (* do not mark - zero blocks will not overwrite boundaries of
non-zero blocks *)
+ else
+ begin
+ let i_begin = compute_block_num s interval_begin in
+ let i_end = compute_block_num s (Int64.pred interval_end) in
+ let priochar = Char.chr (max 0 (min priority 255)) in
+ (* String.fill s.s_priorities_bitmap i_begin (i_end - i_begin + 1)
priochar *)
+ for i = i_begin to i_end do
+ s.s_priorities_bitmap.[i] <- priochar
+ done
+ end
+ else
+ lprintf_nl "WARNING: recompute_priorities %Ld %Ld %Ld" interval_begin
interval_end s.s_size
+ in
+ let rec loop = function
+ | (i_begin, priority) :: ((i_end,_) :: _ as tail) -> mark i_begin i_end
priority; loop tail
+ | [i_begin, priority] -> mark i_begin s.s_size priority
+ | [] -> lprintf_nl "WARNING: recompute_priorities []"
+ in
+ loop s.s_priorities_intervals
+
+(* Intervals with fixed byte positions are needed to recompute priorities
bitmap
+ after merge, cause priobitmap depends on block size *)
+let swarmer_set_interval s (p1,p2,prio as new_interval) =
+ if !verbose then
+ lprintf_nl "swarmer_set_interval %S %Ld (%Ld,%Ld,%u)" s.s_filename
s.s_size p1 p2 prio;
+ s.s_priorities_intervals <- insert_prio_interval s.s_priorities_intervals
s.s_size new_interval;
+ swarmer_recompute_priorities_bitmap s
+
(** if a swarmer is already associated with that [file_name], return it;
Otherwise create a new one with default values, that will be fixed
by the first frontend association *)
-
let create_swarmer file_name file_size =
try
HS.find swarmers_by_name
@@ -619,6 +707,8 @@
s_strategy = AdvancedStrategy;
s_verified_bitmap = VB.create nblocks VB.State_missing;
+ s_priorities_bitmap = String.make nblocks priority_zero;
+ s_priorities_intervals = [(zero, 1)]; (* JAVE init all prios to 1, thus
all chunks will be downloaded as usual *)
s_disk_allocated = Bitv.create ndiskblocks false;
s_blocks = Array.create nblocks EmptyBlock ;
s_block_pos = Array.create nblocks zero;
@@ -627,6 +717,7 @@
(* s_last_seen = Array.create nblocks 0; *)
}
in
+ swarmer_recompute_priorities_bitmap s;
HS.add swarmers_by_name s;
s
@@ -749,6 +840,7 @@
s.s_blocks <- Array.create nblocks EmptyBlock;
s.s_verified_bitmap <- VB.create nblocks VB.State_missing;
+ s.s_priorities_bitmap <- String.make nblocks priority_zero;
s.s_block_pos <- Array.create nblocks zero;
s.s_availability <- Array.create nblocks 0; (* not preserved ? *)
s.s_nuploading <- Array.create nblocks 0; (* not preserved ? *)
@@ -783,7 +875,9 @@
iter (i+1) tail
in
- iter 0 blocks
+ iter 0 blocks;
+ swarmer_recompute_priorities_bitmap s
+
(** Associate a(n additional) frontend to a swarmer *)
@@ -1950,7 +2044,7 @@
up.up_npartial <- n-1;
let t = up.up_t in
let s = t.t_s in
- (* priority bitmap <> 0 here ? *)
+ if s.s_priorities_bitmap.[b] = priority_zero then iter_partial up else
let chunk = t.t_chunk_of_block.(b) in
match s.s_blocks.(b) with
| CompleteBlock | VerifiedBlock ->
@@ -1976,7 +2070,7 @@
up.up_ncomplete <- n-1;
let t = up.up_t in
let s = t.t_s in
- (* priority bitmap <> 0 here ? *)
+ if s.s_priorities_bitmap.[b] = priority_zero then iter_complete up else
let chunk = t.t_chunk_of_block.(b) in
match s.s_blocks.(b) with
| CompleteBlock | VerifiedBlock ->
@@ -2124,8 +2218,10 @@
else acc) 0 t.t_blocks_of_chunk.(chunk)) (t.t_num, i))
) 0 s.s_networks) i in
+(*
let preview_beginning = 9000000L in
let preview_end = (s.s_size ** 98L) // 100L in
+*)
(* sources_per_chunk was initially for edonkey only *)
let data_per_source = 9728000L // (Int64.of_int !!sources_per_chunk) in
@@ -2145,9 +2241,7 @@
{
choice_num = n;
choice_block = b;
- choice_user_priority = (* priority bitmap here instead ? *)
- if block_begin < preview_beginning then 3 else
- if block_end > preview_end then 2 else 1;
+ choice_user_priority = Char.code s.s_priorities_bitmap.[b];
choice_remaining = remaining;
choice_preallocated = is_fully_preallocated t block_begin
block_end;
choice_unselected_remaining = unselected_remaining;
@@ -2296,7 +2390,8 @@
Array2.subarray_fold_lefti (fun
((current_chunk_num, current_chunk_blocks_indexes,
best_choices, specimen) as acc) n b ->
- if not (should_download_block s b) then acc
+ if s.s_priorities_bitmap.[b] = priority_zero ||
+ not (should_download_block s b) then acc
else
let chunk_num = t.t_chunk_of_block.(b) in
if chunk_num = current_chunk_num then
@@ -2361,7 +2456,8 @@
if probably_buggy then begin
lprintf_nl "Probably buggy choice (%d):" chunk;
Array2.subarray_fold_lefti (fun () n b ->
- if should_download_block s b then
+ if s.s_priorities_bitmap.[b] <> priority_zero &&
+ should_download_block s b then
let this_choice = create_choice n b in
if List.mem n blocks then lprintf "** "
else if List.exists (List.mem n) best_choices then
@@ -2640,7 +2736,8 @@
let block = up.up_complete_blocks.(i) in
if not (List.exists (fun b -> b.up_block.block_num = block
) up.up_blocks) then
- if should_download_block s block then (* priority bitmap <> 0 here
? *)
+ if s.s_priorities_bitmap.[block] <> priority_zero &&
+ should_download_block s block then
let partial_found = match s.s_blocks.(block) with
| EmptyBlock -> true
| CompleteBlock | VerifiedBlock -> false
@@ -2977,7 +3074,7 @@
| List [v1;v2] | SmallList [v1;v2] ->
(value_to_int64 v1, value_to_int64 v2)
| _ ->
- failwith "Options: Not an int32 pair"
+ failwith "Options: Not an int64 pair"
(*************************************************************************)
(* *)
@@ -3240,6 +3337,13 @@
module SwarmerOption = struct
+ let value_to_priority_interval v =
+ match v with
+ | List [v1;p] | SmallList [v1;p] ->
+ (value_to_int64 v1, value_to_int p)
+ | _ ->
+ failwith "Options: Not a priority interval"
+
let value_to_swarmer v =
match v with
| Module assocs ->
@@ -3266,6 +3370,16 @@
List.iter (fun bsize ->
split_blocks s bsize
) block_sizes;
+ let intervals =
+ try
+ get_value "file_priorities_intervals" (value_to_list
value_to_priority_interval)
+ with Not_found -> [(zero, 1)]
+ in
+ if validate_intervals s.s_size intervals then
+ s.s_priorities_intervals <- intervals
+ else
+ lprintf_nl "Failed to validate priority intervals, using default.
File %s" file_name;
+ swarmer_recompute_priorities_bitmap s;
s
| _ -> assert false
@@ -3278,6 +3392,10 @@
(Bitv.to_string s.s_disk_allocated));
("file_chunk_sizes", list_to_value int64_to_value
(List.map (fun t -> t.t_chunk_size) s.s_networks));
+ ("file_priorities_intervals", List
+ (List.map
+ (fun (i_begin, priority) -> SmallList [int64_to_value i_begin;
int_to_value priority])
+ s.s_priorities_intervals));
("file_download_random", bool_to_value
(match s.s_strategy with
| AdvancedStrategy -> true
@@ -3428,6 +3546,24 @@
Printf.bprintf buf " Storage: %d bytes\n" !storage;
)
+(* functions for priority bitmask *)
+
+let file_swarmer f =
+ HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f }
+
+(*
+(** set the priority bitmask for each chunk in a file *)
+let set_swarmer_chunk_priorities f priobitmap =
+ let s = file_swarmer f in
+ if String.length priobitmap = VB.length s.s_verified_bitmap then
+ s.s_priorities_bitmap <- priobitmap
+*)
+
+(** get the priority bitmask for a file (do not mutate the string directly,
use swarmer_set_interval) *)
+let get_swarmer_block_priorities s = s.s_priorities_bitmap
+let get_swarmer_block_verified s = s.s_verified_bitmap
+let get_swarmer_priorities_intervals s = s.s_priorities_intervals
+
(* using compute_block_num outside of swarming code is probably
broken, networks supports are aware of chunks, not blocks
maybe other block-related functions should be censored in the same
@@ -3435,4 +3571,4 @@
tag block numbers are chunk numbers so they're not inadvertedly
mistaken for each other ?
*)
-let compute_block_num = ()
+(* let compute_block_num = () *)
Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.261
retrieving revision 1.262
diff -u -b -r1.261 -r1.262
--- src/daemon/driver/driverCommands.ml 19 Dec 2010 10:31:21 -0000 1.261
+++ src/daemon/driver/driverCommands.ml 31 Jan 2011 17:17:04 -0000 1.262
@@ -50,6 +50,8 @@
open Gettext
open Autoconf
+module VB = VerificationBitmap
+
let log_prefix = "[dCmd]"
let lprintf_nl fmt =
@@ -3205,11 +3207,12 @@
\\<td nowrap class=\\\"fbig\\\"\\>\\<a
onclick=\\\"javascript:window.location.href='files'\\\"\\>Display all
files\\</a\\>\\</td\\>
\\<td nowrap class=\\\"fbig\\\"\\>\\<a
onClick=\\\"javascript:parent.fstatus.location.href='submit?q=verify_chunks+%d'\\\"\\>Verify
chunks\\</a\\>\\</td\\>
\\<td nowrap class=\\\"fbig\\\"\\>\\<a
onClick=\\\"javascript:window.location.href='preview_download?q=%d'\\\"\\>Preview\\</a\\>\\</td\\>
+ \\<td nowrap class=\\\"fbig\\\"\\>\\<a
onClick=\\\"javascript:window.location.href='submit?q=debug_get_download_prio+%d'\\\"\\>Debug\\</a\\>\\</td\\>
\\<td nowrap class=\\\"fbig pr\\\"\\>\\<a
onclick=\\\"javascript:window.location.reload()\\\"\\>Reload\\</a\\>\\</td\\>
\\<td class=downloaded width=100%%\\>\\</td\\>
\\</tr\\>\\</table\\>
\\</td\\>\\</tr\\>
- \\<tr\\>\\<td\\>" num num
+ \\<tr\\>\\<td\\>" num num num
else begin
Printf.bprintf buf "\\<a href=\\\"files\\\"\\>Display all
files\\</a\\> ";
Printf.bprintf buf "\\<a
href=\\\"submit?q=verify_chunks+%d\\\"\\>Verify chunks\\</a\\> " num;
@@ -3867,6 +3870,96 @@
register_commands "Driver/Xpert"
[
+(*
+ "debug_set_download_prio", Arg_two
+ (fun arg priostring o ->
+ let num = int_of_string arg in
+ let file = file_find num in
+ CommonSwarming.set_swarmer_chunk_priorities file priostring;
+ "set prio"
+
+ ), ":\t\t\t\t\tset block download priorities for a file. 0=never
download, >0=download largest prio first";
+*)
+
+ "debug_get_download_prio", Arg_one
+ (fun arg o ->
+ let buf = o.conn_buf in
+ let pr fmt = Printf.bprintf buf fmt in
+ let num = int_of_string arg in
+ let file = file_find num in
+ let swarmer = CommonSwarming.file_swarmer file in
+ let prio = CommonSwarming.get_swarmer_block_priorities swarmer in
+ let downloaded = CommonSwarming.get_swarmer_block_verified swarmer
in
+ pr "\\<code\\>";
+ pr "priorities: ";
+ String.iter (fun c ->
+ let c = max 0 (min 9 (Char.code c)) in
+ let c = Char.chr (c + Char.code '0') in
+ Buffer.add_char buf c) prio;
+ pr "\n";
+ pr "downloaded: %s\n" (VB.to_string downloaded);
+
+ Unix32.subfile_tree_map (file_fd file)
+ begin fun fname start length current_length ->
+ let stop = if length <> 0L then (start ++ length -- 1L) else
start in
+ let blockstart = try CommonSwarming.compute_block_num swarmer
start with _ -> 0 in
+ let blockend = try CommonSwarming.compute_block_num swarmer stop
with _ -> 0 in
+ pr "sf:%5Ld ef:%5Ld l:%Ld cl:%Ld > sc:%5d ec:%5d filename:%-30s
\n"
+ start
+ stop
+ length
+ current_length
+ blockstart
+ blockend
+ fname;
+ (*make a chunk downloaded status string for a subfile*)
+ (try
+ for i = blockstart to blockend do
+ Buffer.add_char buf (VB.state_to_char (VB.get downloaded i));
+ done;
+ pr "\n";
+ with _ -> ())
+ end;
+ pr "\\</code\\>";
+ "";
+ ), ":\t\t\t\t\tget file block priorities for a file, and show subfile
completion status";
+
+ "debug_set_subfile_prio", Arg_multiple
+ (fun args o ->
+ let buf = o.conn_buf in
+ match args with
+ | filenum :: priochar :: subfilestart :: q ->
+ let filenum = int_of_string filenum in
+ let priochar = int_of_string priochar in
+ let subfilestart = int_of_string subfilestart in
+ let subfileend =
+ match q with
+ | subfileend :: _ -> int_of_string subfileend
+ | _ -> subfilestart in
+ let file = file_find filenum in
+ let swarmer = CommonSwarming.file_swarmer file in
+(*
+ let priostring =
+ CommonSwarming.get_swarmer_chunk_priorities file in
+*)
+ let subfile1 = Unix32.find_file_index (file_fd file) subfilestart
in
+ let subfile2 = Unix32.find_file_index (file_fd file) subfileend in
+ let subfile_pos = function (_,y,_) -> y in
+ let subfile_len = function (_,_,y) -> y in
+ let start = subfile_pos subfile1 in
+ let stop =
+ subfile_pos subfile2 ++ subfile_len subfile2
+(* -- if subfile_len subfile2 > 0L then 1L else 0L *)
+ in
+ Printf.bprintf buf "file %s\nstart %Ld stop %Ld prio %u\n"
+ swarmer.CommonSwarming.s_filename start stop priochar;
+ CommonSwarming.swarmer_set_interval swarmer (start,stop,priochar);
+ (* show file *)
+ execute_command !CommonNetwork.network_commands o "vd"
[string_of_int filenum];
+ ""
+ | _ -> bad_number_of_args "" ""
+ ), "debug_set_subfile_prio <download id> <prio> <1st subfile> <optional
last subfile>";
+
"reload_messages", Arg_none (fun o ->
CommonMessages.load_message_file ();
"\\<script
type=\\\"text/javascript\\\"\\>top.window.location.reload();\\</script\\>"
Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.164
retrieving revision 1.165
diff -u -b -r1.164 -r1.165
--- src/networks/bittorrent/bTInteractive.ml 23 Jan 2011 15:20:26 -0000
1.164
+++ src/networks/bittorrent/bTInteractive.ml 31 Jan 2011 17:17:06 -0000
1.165
@@ -209,8 +209,69 @@
let re = Str.regexp_case_fold
"\\(https?://[a-zA-Z0-9_.!~*'();/?:@&=+$,%-]+\\)" in
fun s -> Str.global_replace re "\\<a href=\\\"\\1\\\"\\>\\1\\</a\\>" s
+(** Get swarming info for subfiles (priorities and progress)
+ @return empty list if no swarmer *)
+let get_subfiles file =
+ match try Some (CommonSwarming.file_swarmer (as_file file)) with _ -> None
with
+ | None -> []
+ | Some swarmer ->
+ match CommonSwarming.get_swarmer_priorities_intervals swarmer with
+ | [] -> []
+ | ((_,prio)::_ as l) ->
+ let intervals = ref l in
+ let prio = ref prio in
+ let rec count_intervals_till bytes =
+ let rec loop acc_prio = function
+ | (i_start,i_prio) :: tail when i_start < bytes ->
+ prio := i_prio;
+ loop (min acc_prio i_prio) tail
+ | ((i_start,i_prio) :: _ as l) when i_start = bytes ->
+ prio := i_prio;
+ intervals := l;
+ acc_prio
+ | l -> intervals := l; acc_prio
+ in
+ loop !prio !intervals
+ in
+ let downloaded = CommonSwarming.get_swarmer_block_verified swarmer in
+ let r = ref [] in
+ Unix32.subfile_tree_map (file_fd file)
+ begin fun fname start length current_length ->
+ let prio = count_intervals_till (start ++ length) in
+(* let (blockstart,blockend) = CommonSwarming.blocks_of_ *)
+ let stop = if length <> 0L then (start ++ length -- 1L) else start in
+ let blockstart = try CommonSwarming.compute_block_num swarmer start with
_ -> 0 in
+ let blockend = try CommonSwarming.compute_block_num swarmer stop with _
-> 0 in
+ let ok = ref 0 in
+ for i = blockstart to blockend do
+ if VB.State_verified = VB.get downloaded i then incr ok;
+ done;
+ let progress = float !ok /. float (blockend - blockstart + 1) in
+ r := (fname, length, prio, progress) :: !r
+ end;
+ List.rev !r
+
+
let op_file_print file o =
+ let subfiles =
+ let subfiles = ref (get_subfiles file) in
+ List.map begin fun (name,size,magic) ->
+ let magic = match magic with None -> "" | Some m -> Printf.sprintf " / %s"
m in
+ match !subfiles with
+ | [] -> (name,size,magic,"",None)
+ | (i_name,i_size,i_prio,progress)::t ->
+(*
+ lprintf_nl "%S = %S %Ld = %Ld | priority %d" name i_name size i_size
i_prio;
+*)
+ subfiles := t;
+ let progress = Printf.sprintf ", %.0f%%" (100. *. progress) in
+ if name = i_name && size = i_size then (* sanity check *)
+ (name,size,magic,progress,Some i_prio)
+ else
+ (name,size,magic,progress,None)
+ end file.file_files
+ in
let buf = o.conn_buf in
if use_html_mods o then
begin
@@ -338,17 +399,33 @@
end;
(* -- End bad -- *)
+ let extra =
+ match List.fold_left (fun acc subfile ->
+ match acc, subfile with
+ | (Some false|None),(_,_,_,_,Some prio) when prio > 0 -> Some true
+ | None,(_,_,_,_,Some 0) -> Some false
+ | None,(_,_,_,_,None) -> None
+ | acc,_ -> acc) None subfiles
+ with
+ | None -> ""
+ | Some dl ->
+ Printf.sprintf ", \\<a title=\\\"toggle all files\\\"
href=\\\"submit?q=debug_set_subfile_prio+%d+%d+%d+%d\\\"\\>%s\\</a\\>"
+ (file_num file) (if dl then 0 else 1) 0 (List.length subfiles - 1)
+ (if dl then "unselect all" else "select all")
+ in
+ emit (_s"Full path"^extra) ~desc:(_s"Full path to the download")
(file_disk_name file);
+
let cntr = ref 0 in
- List.iter (fun (filename, size, magic) ->
- let fs = Printf.sprintf "File %d" !cntr in
- let magic_string =
- match magic with
+ List.iter (fun (filename, size, magic, progress, prio) ->
+ Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr
());
+ let fs = Printf.sprintf (_b"File %d") !cntr in
+ let extra = match prio with
| None -> ""
- | Some m -> Printf.sprintf " / %s" m;
+ | Some prio -> Printf.sprintf ", \\<a title=\\\"toggle file\\\"
href=\\\"submit?q=debug_set_subfile_prio+%d+%d+%d\\\"\\>priority %d\\</a\\>"
(file_num file) (if prio = 0 then 1 else 0) !cntr prio
in
- emit fs (Printf.sprintf "%s (%Ld bytes)%s" filename size magic_string);
+ emit (fs^extra) ~desc:fs (Printf.sprintf "%s (%Ld bytes%s)%s" filename
size progress magic);
incr cntr;
- ) file.file_files
+ ) subfiles
end (* use_html_mods *)
else begin
@@ -370,17 +447,14 @@
if s <> "" then Printf.bprintf buf "Creation date: %s\n" s;
if file.file_modified_by <> "" then Printf.bprintf buf "Modified by %s\n"
file.file_modified_by;
if file.file_encoding <> "" then Printf.bprintf buf "Encoding: %s\n"
file.file_encoding;
+ Printf.bprintf buf (_b"Full path: %s\n") (file_disk_name file);
if file.file_files <> [] then Printf.bprintf buf "Subfiles: %d\n"
(List.length file.file_files);
let cntr = ref 0 in
- List.iter (fun (filename, size, magic) ->
+ List.iter (fun (filename, size, magic, progress, prio) ->
incr cntr;
- let magic_string =
- match magic with
- None -> ""
- | Some m -> Printf.sprintf " / %s" m;
- in
- Printf.bprintf buf "File %d: %s (%Ld bytes)%s\n" !cntr filename size
magic_string
- ) file.file_files
+ let prio = match prio with Some n -> Printf.sprintf ", priority %d" n |
None -> "" in
+ Printf.bprintf buf "File %d%s: %s (%Ld bytes%s)%s\n" !cntr prio filename
size progress magic
+ ) subfiles
end
let op_file_print_sources file o =
Index: src/utils/lib/unix32.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.ml,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -b -r1.75 -r1.76
--- src/utils/lib/unix32.ml 15 Aug 2010 15:05:18 -0000 1.75
+++ src/utils/lib/unix32.ml 31 Jan 2011 17:17:07 -0000 1.76
@@ -454,6 +454,14 @@
find_file
(if file_pos < pos then tree1 else tree2) file_pos
+ let rec subfile_tree_map indent tree f=
+ match tree with
+ | Leaf file ->
+ f file.filename file.pos file.len file.current_len
+ | Node (pos, tree1, tree2) ->
+ subfile_tree_map (indent ^ " ") tree1 f;
+ subfile_tree_map (indent ^ " ") tree2 f
+
let rec print_tree indent tree =
match tree with
Leaf file -> lprintf_nl "%s - %s (%Ld,%Ld)"
@@ -1657,6 +1665,28 @@
()
*)
end
+
+(* subfile tree map function*)
+let subfile_tree_map t f =
+ match t.file_kind with
+ | MultiFile t -> MultiFile.subfile_tree_map "" t.MultiFile.tree f; ()
+ | _ -> ()
+
+
+let find_file t chunk_begin =
+ match t.file_kind with
+ | MultiFile t ->
+ let (sf, tail) = (MultiFile.find_file t chunk_begin) in
+ (sf.MultiFile.filename, sf.MultiFile.pos , sf.MultiFile.len)
+ | _ -> ("unimplemeted" , 0L, 0L)
+
+let find_file_index t index =
+ match t.file_kind with
+ | MultiFile t ->
+ let sf = List.nth t.MultiFile.files index in
+ (sf.MultiFile.filename, sf.MultiFile.pos , sf.MultiFile.len)
+ | _ -> ("unimplemeted" , 0L, 0L)
+
type t = file
(*
Index: src/utils/lib/unix32.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.mli,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -b -r1.26 -r1.27
--- src/utils/lib/unix32.mli 3 Jul 2007 14:13:44 -0000 1.26
+++ src/utils/lib/unix32.mli 31 Jan 2011 17:17:07 -0000 1.27
@@ -105,3 +105,6 @@
val percentused : string -> int option
val percentfree : string -> int option
val filesystem : string -> string
+val subfile_tree_map : t -> (string -> int64 -> int64 -> int64-> unit) ->
unit
+val find_file : t -> int64 -> (string * int64 * int64)
+val find_file_index : t -> int -> (string * int64 * int64)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...,
mldonkey-commits <=