summaryrefslogtreecommitdiffstats
path: root/net-p2p
diff options
context:
space:
mode:
authorlioux <lioux@FreeBSD.org>2006-05-15 21:26:15 +0000
committerlioux <lioux@FreeBSD.org>2006-05-15 21:26:15 +0000
commit7d71ab2c94fdf0f521ece77eea3254735034c626 (patch)
tree3f658263ce6083181139719e60198e4ccca8e905 /net-p2p
parent10eeac65ba1da9e881b9cf4f58080f98c1cf3486 (diff)
downloadFreeBSD-ports-7d71ab2c94fdf0f521ece77eea3254735034c626.zip
FreeBSD-ports-7d71ab2c94fdf0f521ece77eea3254735034c626.tar.gz
o Update WIP swarming patch to revision n
o Save memory by using only 2 integers instead of 4 to record IPv4 addresses o Bump PORTREVISION
Diffstat (limited to 'net-p2p')
-rw-r--r--net-p2p/mldonkey-devel/Makefile3
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__daemon__common__commonSwarming.ml2325
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__daemon__driver__driverMain.ml13
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTClients.ml47
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTComplexOptions.ml20
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTGlobals.ml15
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTInteractive.ml25
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyClient.ml38
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyComplexOptions.ml20
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyGlobals.ml2
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyInteractive.ml27
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyOneFile.ml29
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyShare.ml29
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__fasttrack__fasttrackGlobals.ml2
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPClients.ml13
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPComplexOptions.ml20
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPGlobals.ml2
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPInteractive.ml16
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaClients.ml12
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaComplexOptions.ml20
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaGlobals.ml2
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaInteractive.ml16
-rw-r--r--net-p2p/mldonkey-devel/files/patch-src__utils__net__ip.ml203
23 files changed, 2272 insertions, 627 deletions
diff --git a/net-p2p/mldonkey-devel/Makefile b/net-p2p/mldonkey-devel/Makefile
index a7a6291..2638496 100644
--- a/net-p2p/mldonkey-devel/Makefile
+++ b/net-p2p/mldonkey-devel/Makefile
@@ -7,7 +7,7 @@
PORTNAME= mldonkey
PORTVERSION= 2.7.5
-PORTREVISION= 2
+PORTREVISION= 3
CATEGORIES+= net-p2p
MASTER_SITES= ${MASTER_SITE_SOURCEFORGE_EXTENDED} \
${MASTER_SITE_SAVANNAH}
@@ -140,6 +140,7 @@ post-patch:
src/networks/donkey/donkeyServers.ml
@${REINPLACE_CMD} -E \
-e 's|http://www.gruk.org/server.met.gz|http://www.jd2k.com/server.met|' \
+ -e 's|http://www.bluetack.co.uk/config/antip2p.txt|http://www.bluetack.co.uk/config/level1.gz|' \
${WRKSRC}/${file}
.endfor
diff --git a/net-p2p/mldonkey-devel/files/patch-src__daemon__common__commonSwarming.ml b/net-p2p/mldonkey-devel/files/patch-src__daemon__common__commonSwarming.ml
index d02ff34..bcb5802 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__daemon__common__commonSwarming.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__daemon__common__commonSwarming.ml
@@ -1,10 +1,16 @@
--- ./src/daemon/common/commonSwarming.ml.orig Mon Apr 10 14:06:20 2006
-+++ ./src/daemon/common/commonSwarming.ml Sun May 7 06:39:10 2006
-@@ -17,6 +17,26 @@
++++ ./src/daemon/common/commonSwarming.ml Mon May 15 13:03:12 2006
+@@ -17,6 +17,32 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
-+(* OVERALL SCHEMA
++(*
++ The jobs of swarmers are :
++ * select what data to ask from each uploader
++ * merge data coming from uploaders, potentially from different
++ networks, into a single Unix32 backend.
++
++ OVERALL SCHEMA
+
+Each network frontend can have a different (fixed) chunk size
+t1 +--------+--------+--------+--------+--------+--------+-------- chunks
@@ -27,7 +33,7 @@
open Int64ops
open Options
open Printf2
-@@ -25,7 +45,6 @@
+@@ -25,7 +51,6 @@
let check_swarming = false
@@ -35,7 +41,7 @@
let debug_all = false
open CommonTypes
-@@ -37,11 +56,8 @@
+@@ -37,11 +62,8 @@
exception VerifierNotReady
@@ -49,7 +55,7 @@
| AvailableBitv of Bitv.t
type verification =
-@@ -54,18 +70,17 @@
+@@ -54,18 +76,17 @@
let exit_on_error = ref false
(* prints a new logline with date, module and starts newline *)
@@ -74,7 +80,7 @@
open CommonFile
open CommonTypes
open CommonClient
-@@ -93,6 +108,8 @@
+@@ -93,6 +114,8 @@
*)
@@ -83,7 +89,7 @@
type chunk = {
chunk_uid : uid_type;
chunk_size : int64;
-@@ -102,20 +119,27 @@
+@@ -102,20 +125,27 @@
(* glossary:
network frontend use "chunks" of data,
swarmer use "blocks" of data *)
@@ -116,7 +122,7 @@
(* mapping from network chunks to swarmer blocks *)
mutable t_blocks_of_chunk : int list array;
-@@ -124,12 +148,12 @@
+@@ -124,13 +154,12 @@
}
and swarmer = {
@@ -124,15 +130,16 @@
- mutable s_filename : string;
+ s_num : int;
+ s_filename : string;
++ s_size : int64;
mutable s_networks : t list; (** list of frontends, primary at head
t.t_s = s <=> t in s.s_networks *)
- mutable s_size : int64;
-+ s_size : int64;
- mutable s_range_size : int64;
+- mutable s_range_size : int64;
mutable s_strategy : strategy;
-@@ -156,20 +180,21 @@
+ mutable s_verified_bitmap : string;
+@@ -156,20 +185,21 @@
mutable block_end : Int64.t;
mutable block_ranges : range; (** [range] of the double-linked
list of ranges associated to the
@@ -161,16 +168,29 @@
}
and uploader = {
-@@ -178,7 +203,7 @@
+@@ -178,26 +208,33 @@
mutable up_declared : bool;
- mutable up_chunks : chunks;
+ mutable up_intervals : intervals;
mutable up_complete_blocks : int array; (** block numbers *)
- mutable up_ncomplete : int;
-
-@@ -193,11 +218,14 @@
+- mutable up_ncomplete : int;
++ mutable up_ncomplete : int; (** number of blocks not yet handled,
++ at the beginning of
++ up_complete_blocks *)
+
+ mutable up_partial_blocks : (int * int64 * int64) array; (** block
+ number,
+ begin_pos,
+ end_pos
+ *)
+- mutable up_npartial : int;
++ mutable up_npartial : int; (** number of blocks not yet handled,
++ at the beginning of
++ up_partial_blocks *)
+
+ mutable up_block : block option;
mutable up_block_begin : int64;
mutable up_block_end : int64;
@@ -187,7 +207,7 @@
[block]'s [block_ranges] reference the first (smallest offsets) of
the [range]s associated with it.
-@@ -216,12 +244,59 @@
+@@ -216,12 +253,64 @@
overlap, and are sorted in increasing offsets order:
b.block_begin <= b.block_ranges.block_begin ... <=
@@ -201,7 +221,7 @@
+(* range owners are only used thru uploaders.up_ranges. blocks could be
+ saved in [uploaders]' [up_ranges] along range, but would
+ need uploading when the swarmer is splitted.
-+
+
+ Removing [range] from [up_ranges] and [range_nuploading] from
+ [range] could be good too, because they're not correctly updated
+ when the swarmer is splitted. Again, getting rid of them is a
@@ -232,56 +252,63 @@
+ hence t_ncomplete_chunks >= t_nverified_chunks
+
+ All chunks are [t_chunk_size] bytes in size, and first start at
-+ offset 0. This is assumed in [associate], [verify_chunk], maybe more.
++ offset 0. This is assumed in [create], [associate], [verify_chunk],
++ [duplicate_chunks], maybe more.
+*)
+
+(* uploaders invariants ?
-+ At first, I supposed
-+ up_ncomplete = Array.length up_complete_blocks
-+ up.up_npartial = Array.length up_partial_blocks
-+ if so, since Array.length complexity is O(1), why keep them ?
-
-+ => see permute_and_return, they're used to simulate to removal of
-+ elements without array reallocation
++ uploader block numbers are stored in reverse order in
++ up_complete_blocks and up_partial_blocks (first blocks at the end
++ of arrays), then array is processed from end to begin.
++
++ 0 <= up_ncomplete < Array.length up_complete_blocks
++ 0 <= up.up_npartial < Array.length up_partial_blocks
+
-+ So the question is now, aren't there better datastructures than
-+ arrays for the job ?
++ When a block has been selected, it's pushed out of the first
++ up_ncomplete first elements of up_complete_blocks by swapping it
++ with the #(up_ncomplete-1) element, then up_ncomplete is
++ decreased. (and similarly with s/complete/partial/ ?)
++
++ The question is now, aren't there better datastructures than
++ arrays for the job ? ;)
+*)
(*************************************************************************)
(* *)
-@@ -251,8 +326,6 @@
+@@ -251,112 +340,52 @@
let swarmer_counter = ref 0
-let has_multinet = true
-
- (*************************************************************************)
- (* *)
- (* dummy_swarmer *)
-@@ -276,10 +349,10 @@
- (** (debug) output an [uploader] to current log *)
-
- let print_uploader up =
-- lprintf_n () " interesting complete_blocks: %d\n " up.up_ncomplete;
-+ lprintf_n " interesting complete_blocks: %d\n " up.up_ncomplete;
- Array.iter (fun i -> lprintf " %d " i) up.up_complete_blocks;
- lprint_newline ();
-- lprintf_n () " interesting partial_blocks: %d\n " up.up_npartial;
-+ lprintf_n " interesting partial_blocks: %d\n " up.up_npartial;
- Array.iter (fun (i, begin_pos, end_pos) ->
- lprintf " %d[%Ld...%Ld] " i begin_pos end_pos
- ) up.up_partial_blocks;
-@@ -289,23 +362,37 @@
- associated file's [t.t_file] last seen value to the oldest of the
- remaining last seen values *)
-
-+let string_for_all p s =
-+ let l = String.length s in
+-(*************************************************************************)
+-(* *)
+-(* dummy_swarmer *)
+-(* *)
+-(*************************************************************************)
++let string_init n f =
++ let s = String.create n in
+ let rec aux i =
-+ i >= l || p s.[i] && aux (i+1) in
-+ aux 0
-+
++ if i < n then begin
++ s.[i] <- f i;
++ aux (i+1)
++ end in
++ aux 0;
++ s
+
+-let dummy_swarmer = {
+- s_num = 0;
+- s_filename = "";
+- s_networks = [];
+- s_size = zero;
+- s_range_size = zero;
+- s_strategy = AdvancedStrategy;
+- s_verified_bitmap = "";
+- s_blocks = [||];
+- s_block_pos = [||];
+- s_availability = [||];
+- s_nuploading = [||];
+- }
+let string_iter f s =
+ let l = String.length s in
+ let rec aux i =
@@ -290,7 +317,34 @@
+ aux (i+1)
+ end in
+ aux 0
-+
+
+-(** (debug) output an [uploader] to current log *)
++let string_existsi p s =
++ let l = String.length s in
++ let rec aux i =
++ i < l && (p i s.[i] || aux (i+1)) in
++ aux 0
+
+-let print_uploader up =
+- lprintf_n () " interesting complete_blocks: %d\n " up.up_ncomplete;
+- Array.iter (fun i -> lprintf " %d " i) up.up_complete_blocks;
+- lprint_newline ();
+- lprintf_n () " interesting partial_blocks: %d\n " up.up_npartial;
+- Array.iter (fun (i, begin_pos, end_pos) ->
+- lprintf " %d[%Ld...%Ld] " i begin_pos end_pos
+- ) up.up_partial_blocks;
+- lprint_newline ()
++let string_for_all p s =
++ let l = String.length s in
++ let rec aux i =
++ i >= l || p s.[i] && aux (i+1) in
++ aux 0
+
+ (** sets [t.t_last_seen] of the verified blocks to current time, and
+- associated file's [t.t_file] last seen value to the oldest of the
++ associated file's [t.t_s.s_file] last seen value to the oldest of the
+ remaining last seen values *)
+
let compute_last_seen t =
let last_seen_total = ref (BasicSocket.last_time ()) in
- for i = 0 to String.length t.t_converted_verified_bitmap - 1 do
@@ -305,74 +359,67 @@
set_file_last_seen t.t_file !last_seen_total;
t.t_last_seen
- (** if a swarmer is already associated with that [file_name], return it;
+-(** if a swarmer is already associated with that [file_name], return it;
- Otherwise create a new one with default values (including a default
- [range_size] instead of the provided value ??) *)
-
-let create_swarmer file_name file_size range_size =
-+ 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
- { dummy_swarmer with
-@@ -314,9 +401,7 @@
- with Not_found ->
- incr swarmer_counter;
-
+-
+- try
+- HS.find swarmers_by_name
+- { dummy_swarmer with
+- s_filename = file_name
+- }
+- with Not_found ->
+- incr swarmer_counter;
+-
-(* Let be VERY conservative... *)
- let range_size = edonkey_range_size in
-
-+ let range_size = edonkey_range_size in (* yuck ? *)
- let nchunks = 1 in
- let rec s = {
-
-@@ -357,6 +442,43 @@
- let b = s.s_block_pos in
- b.(i)
-
-+(** Finds the number of the block containing [chunk_pos] offset, using
-+ dichotomy. Blocks are half opened [block_begin, block_end[ *)
-+
-+(* 0 <= chunk_pos < s.s_size *)
-+let compute_block_num s chunk_pos =
-+ assert (0L <= chunk_pos && chunk_pos < s.s_size);
-+ let b = s.s_block_pos in
-+(* invariants:
-+ 0 <= min <= max <= Array.length b - 1
-+ compute_block_begin s min <= chunk_pos < compute_block_end s max *)
-+
-+ let rec iter min max =
-+ if min = max then min
-+ else (* from now on, min < max *)
-+ let medium = (min + max) / 2 in
-+ (* Euclide => 2*medium <= min + max <= 2*medium + 1 *)
-+ (* min < max => 2*min < min + max < 2*max
-+ => min <= medium < max *)
-+ if min < medium then
-+ if chunk_pos < b.(medium) then
-+ iter min (medium - 1)
-+ else
-+ iter medium max
-+ else
-+ (* min = medium < max => 2*min < min + max <= 2*min + 1
-+ <=> min < max <= min + 1
-+ <=> min + 1 = max *)
-+ if chunk_pos < b.(max) then
-+ min else max
-+ in
-+ let i = iter 0 (Array.length b - 1) in
-+ if debug_all then
-+ lprintf_nl "%Ld is block %d [%Ld-%Ld]" chunk_pos i
-+ (compute_block_begin s i) (compute_block_end s i);
-+ i
-+
-+
+- let nchunks = 1 in
+- let rec s = {
+-
+- s_num = !swarmer_counter;
+- s_filename = file_name;
+-
+- s_networks = [];
+-
+- s_size = file_size;
+- s_range_size = range_size;
+- s_strategy = AdvancedStrategy;
+-
+- s_verified_bitmap = String.make nchunks '0';
+- s_blocks = Array.create nchunks EmptyBlock ;
+- s_block_pos = Array.create nchunks zero;
+- s_availability = Array.create nchunks 0;
+- s_nuploading = Array.create nchunks 0;
+-(* s_last_seen = Array.create nchunks 0; *)
+- }
+- in
+- HS.add swarmers_by_name s;
+- s
+-
+-(** (internal) return the offset of the end of the [i]th block of
+- swarmer [s] *)
+-
+-let compute_block_end s i =
+- let b = s.s_block_pos in
+- if Array.length b = i + 1 then
+- s.s_size
+- else
+- b.(i+1)
+-
+-(** (internal) return the offset of the beginning of the [i]th block
+- of swarmer [s] *)
+-
+-let compute_block_begin s i =
+- let b = s.s_block_pos in
+- b.(i)
+-
(** (internal) return a 0 sized range at offset [pos], and assigned to
block [b] *)
-@@ -368,19 +490,40 @@
+@@ -368,19 +397,40 @@
range_end = pos;
range_block = b;
range_nuploading = 0;
@@ -418,16 +465,18 @@
(** (internal)
Find ranges that are after [cut_pos] offset, unlink them from r
-@@ -392,8 +535,6 @@
+@@ -392,9 +442,7 @@
If [cut_pos] is within one of the ranges, that range is cut in
two at [cut_pos] offset, and link each half to its side.
- What should happen to range_begin is unclear.
-
- Also, what do to if range_nuploaders is not 0 ?
+- Also, what do to if range_nuploaders is not 0 ?
++ Also, what do to if range_nuploading is not 0 ?
=> [cut_ranges_after] is being called from [split_blocks] that
does not preserve [s_nuploading] for blocks either
-@@ -417,16 +558,15 @@
+ *)
+@@ -417,34 +465,165 @@
(* "right" half *)
let split_r = { r with
range_prev = None;
@@ -443,11 +492,68 @@
if r.range_nuploading <> 0 then
- lprintf_n () "WARNING: Splitting a range currently being uploaded, don't know what to do with range_nuploaders :/\n";
-+ lprintf_n "WARNING: Splitting a range currently being uploaded, don't know what to do with range_nuploaders :/\n";
++ lprintf_n "WARNING: Splitting a range currently being uploaded, don't know what to do with range_nuploading :/\n";
split_r in
let cut_ranges = iter r in
-@@ -438,10 +578,10 @@
+ own_ranges b cut_ranges;
+ cut_ranges
+
++(** (internal) return the offset of the end of the [i]th block of
++ swarmer [s] *)
++
++let compute_block_end s i =
++ let b = s.s_block_pos in
++ if Array.length b = i + 1 then
++ s.s_size
++ else
++ b.(i+1)
++
++(** (internal) return the offset of the beginning of the [i]th block
++ of swarmer [s] *)
++
++let compute_block_begin s i =
++ let b = s.s_block_pos in
++ b.(i)
++
++(** Finds the number of the block containing [chunk_pos] offset, using
++ dichotomy. Blocks are half opened [block_begin, block_end[ *)
++
++(* 0 <= chunk_pos < s.s_size *)
++let compute_block_num s chunk_pos =
++ assert (0L <= chunk_pos && chunk_pos < s.s_size);
++ let b = s.s_block_pos in
++(* invariants:
++ 0 <= min <= max <= Array.length b - 1
++ compute_block_begin s min <= chunk_pos < compute_block_end s max *)
++
++ let rec iter min max =
++ if min = max then min
++ else (* from now on, min < max *)
++ let medium = (min + max) / 2 in
++ (* Euclide => 2*medium <= min + max <= 2*medium + 1 *)
++ (* min < max => 2*min < min + max < 2*max
++ => min <= medium < max *)
++ if min < medium then
++ if chunk_pos < b.(medium) then
++ iter min (medium - 1)
++ else
++ iter medium max
++ else
++ (* min = medium < max => 2*min < min + max <= 2*min + 1
++ <=> min < max <= min + 1
++ <=> min + 1 = max *)
++ if chunk_pos < b.(max) then
++ min else max
++ in
++ let i = iter 0 (Array.length b - 1) in
++ if debug_all then
++ lprintf_nl "%Ld is block %d [%Ld-%Ld]" chunk_pos i
++ (compute_block_begin s i) (compute_block_end s i);
++ i
++
+ (** Return true if ranges fully "cover" their block
+ ("the block is made of holes") *)
let empty_block b =
let rec iter begin_pos r =
@@ -461,7 +567,89 @@
in
iter b.block_begin b.block_ranges
-@@ -490,7 +630,7 @@
++let iter_intervals s f intervals =
++ let nchunks = Array.length s.s_blocks in
++ List.iter (fun (interval_begin, interval_end) ->
++ let interval_begin = min interval_begin s.s_size in
++ let interval_end = min interval_end s.s_size in
++(* lprintf "apply on %Ld-%Ld\n" interval_begin interval_end; *)
++ if interval_begin < interval_end then
++ let i0 = compute_block_num s interval_begin in
++ let block_begin = compute_block_begin s i0 in
++ let rec iter_blocks i block_begin interval_begin =
++(* lprintf "iter_blocks %d %Ld %Ld\n" i block_begin interval_begin; *)
++ if i < nchunks && block_begin < interval_end then
++ let block_end = compute_block_end s i in
++ let current_end = min block_end interval_end in
++
++ if debug_all then
++ lprintf_nl "Apply: %d %Ld-%Ld %Ld-%Ld"
++ i block_begin block_end interval_begin current_end;
++
++ f i block_begin block_end interval_begin current_end;
++ iter_blocks (i+1) block_end block_end
++ in
++ iter_blocks i0 block_begin interval_begin
++ ) intervals
++
++(*************************************************************************)
++(* *)
++(* Swarmers *)
++(* *)
++(*************************************************************************)
++
++let dummy_swarmer = {
++ s_num = 0;
++ s_filename = "";
++ s_size = zero;
++ s_networks = [];
++ s_strategy = AdvancedStrategy;
++ s_verified_bitmap = "";
++ s_blocks = [||];
++ s_block_pos = [||];
++ s_availability = [||];
++ s_nuploading = [||];
++ }
++
++(** 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
++ { dummy_swarmer with
++ s_filename = file_name
++ }
++ with Not_found ->
++ incr swarmer_counter;
++
++ let nblocks = 1 in
++ let rec s = {
++
++ s_num = !swarmer_counter;
++ s_filename = file_name;
++ s_size = file_size;
++
++ s_networks = [];
++
++ s_strategy = AdvancedStrategy;
++
++ s_verified_bitmap = String.make nblocks '0';
++ s_blocks = Array.create nblocks EmptyBlock ;
++ s_block_pos = Array.create nblocks zero;
++ s_availability = Array.create nblocks 0;
++ s_nuploading = Array.create nblocks 0;
++(* s_last_seen = Array.create nblocks 0; *)
++ }
++ in
++ HS.add swarmers_by_name s;
++ s
++
+ (** Split swarmer existing blocks in at [chunk_size] boundaries *)
+ let split_blocks s chunk_size =
+
+@@ -490,7 +669,7 @@
(* We need to split this block in two parts *)
s.s_block_pos.(index_s) <- chunk_end;
match s.s_blocks.(index_s) with
@@ -470,7 +658,7 @@
(* s.s_blocks.(index_s) will appear twice in the result list *)
let new_blocks = (
-@@ -501,7 +641,6 @@
+@@ -501,7 +680,6 @@
iter index_s chunk_end new_blocks
| PartialBlock b1 ->
@@ -478,7 +666,7 @@
(* split b1 in two; b2 is the part after [chunk_end] offset *)
let b2 = {
block_s = s;
-@@ -535,12 +674,8 @@
+@@ -535,12 +713,8 @@
s.s_verified_bitmap.[index_s] <- '0';
end else
s.s_blocks.(index_s) <- PartialBlock b2;
@@ -491,7 +679,7 @@
in
let blocks = iter 0 zero [] in
-@@ -554,9 +689,9 @@
+@@ -554,9 +728,9 @@
aux 0 in
if array_exist ((<>) 0) s.s_availability then
@@ -503,7 +691,7 @@
s.s_blocks <- Array.create nblocks EmptyBlock;
s.s_verified_bitmap <- String.make nblocks '0';
-@@ -571,8 +706,8 @@
+@@ -571,8 +745,8 @@
| (b, pos, c) :: tail ->
begin
match b with
@@ -514,9 +702,38 @@
end;
s.s_blocks.(i) <- b;
s.s_verified_bitmap.[i] <- c;
-@@ -613,11 +748,18 @@
+@@ -585,17 +759,15 @@
+ (** Associate a(n additional) frontend to a swarmer *)
+
+ let associate is_primary t s =
+-
+ (* a swarmer cannot be associated more than once to a network *)
+ if not (List.memq t s.s_networks) then
+ let size = file_size t.t_file in
+
+ (* what about raising an exception instead ? *)
+- assert (s.s_size = size);
+-
+- (* shouldn't just [t] be removed from the list ? *)
+- (* t.t_s.s_networks <- []; *)
+- t.t_s.s_networks <- List.filter ((!=) t) t.t_s.s_networks;
++ if s.s_size <> size then begin
++ lprintf_nl "file_size for %s does not match: swarmer %Ld / real %Ld" s.s_filename s.s_size size;
++ exit 2
++ end;
+
+ t.t_s <- s;
+ t.t_converted_verified_bitmap <- String.make t.t_nchunks '0';
+@@ -608,17 +780,23 @@
+ t.t_primary <- true;
+ s.s_networks <- t :: s.s_networks;
+ end else begin
+- t.t_primary <- false;
+- s.s_networks <- s.s_networks @ [t];
(* TODO: transfer data into swarmer instead of discarding it *)
Unix32.remove (file_fd t.t_file);
++ t.t_primary <- false;
++ s.s_networks <- s.s_networks @ [t];
end;
+
+ (match s.s_networks with
@@ -530,11 +747,12 @@
the t_chunk_of_block and t_blocks_of_chunk fields. *)
- let chunk_size = t.t_block_size in
+-
+ let chunk_size = t.t_chunk_size in
-
split_blocks s chunk_size;
-@@ -628,7 +770,7 @@
+ let nblocks = Array.length s.s_blocks in
+@@ -628,7 +806,7 @@
t.t_chunk_of_block <- Array.create nblocks 0;
t.t_blocks_of_chunk <- Array.create nchunks [];
@@ -543,7 +761,7 @@
for i = 0 to nblocks - 1 do
let block_begin = compute_block_begin s i in
let chunk = Int64.to_int (block_begin // chunk_size) in
-@@ -642,19 +784,14 @@
+@@ -642,42 +820,35 @@
add_file_downloaded t.t_file (zero -- file_downloaded t.t_file);
(* check that all frontends use the primary's file backend *)
@@ -560,6 +778,8 @@
- set_file_fd t.t_file (file_fd tt.t_file)
- | _ -> ()
- end;
+-
+- ()
+ (match s.s_networks with
+ | t :: tail when is_primary ->
+ List.iter (fun tt ->
@@ -567,11 +787,10 @@
+ ) tail
+ | tprim :: tail ->
+ set_file_fd t.t_file (file_fd tprim.t_file)
-+ | [] -> assert false);
++ | [] -> assert false)
- ()
+ (** Create a primary frontend and its swarmer *)
-@@ -663,21 +800,21 @@
let create ss file chunk_size =
let size = file_size file in
@@ -598,7 +817,7 @@
t_converted_verified_bitmap = String.make nchunks '0';
t_last_seen = Array.create nchunks 0;
-@@ -692,120 +829,59 @@
+@@ -692,120 +863,54 @@
associate true t ss;
t
@@ -655,26 +874,16 @@
- lprintf_nl () "%Ld is block %d [%Ld-%Ld]" chunk_pos i
- (compute_block_begin s i) (compute_block_end s i);
- i
-+ f with receive block number, block beginning and ending offsets,
-+ and overlapping interval beginning and ending offsets.
-
-+ If an interval starts halfway of a block, iteration starts on the
-+ next block, with interval_begin < block_begin indicating where the
-+ interval really started.
-
+-
+-
-(*************************************************************************)
-(* *)
-(* apply_intervals (internal) *)
-(* *)
-(*************************************************************************)
-+ If an interval ends halfway of a block, iteration ends on that
-+ block, with interval_end < block_end indicating where the interval
-+ really ended.
-+*)
-
+-
-let apply_intervals s f chunks =
-+let iter_intervals s f intervals =
- let nchunks = Array.length s.s_blocks in
+- let nchunks = Array.length s.s_blocks in
- let rec iter chunks =
- match chunks with
- [] -> ()
@@ -696,9 +905,14 @@
- if debug_all then
- lprintf_nl () "Apply: %d %Ld-%Ld %Ld-%Ld"
- i block_begin block_end chunk_begin current_end;
--
++ f with receive block number, block beginning and ending offsets,
++ and overlapping interval beginning and ending offsets.
+
- f i block_begin block_end chunk_begin current_end;
--
++ If an interval starts halfway of a block, iteration starts on the
++ next block, with interval_begin < block_begin indicating where the
++ interval really started.
+
- iter_blocks (i+1) block_end block_end
- in
- iter_blocks i0 block_begin chunk_begin;
@@ -706,29 +920,30 @@
- iter tail
- in
- iter chunks
--
-+ List.iter (fun (interval_begin, interval_end) ->
-+ let interval_begin = min interval_begin s.s_size in
-+ let interval_end = min interval_end s.s_size in
-+(* lprintf "apply on %Ld-%Ld\n" interval_begin interval_end; *)
-+ if interval_begin < interval_end then
-+ let i0 = compute_block_num s interval_begin in
-+ let block_begin = compute_block_begin s i0 in
-+ let rec iter_blocks i block_begin interval_begin =
-+(* lprintf "iter_blocks %d %Ld %Ld\n" i block_begin interval_begin; *)
-+ if i < nchunks && block_begin < interval_end then
-+ let block_end = compute_block_end s i in
-+ let current_end = min block_end interval_end in
-+
-+ if debug_all then
-+ lprintf_nl "Apply: %d %Ld-%Ld %Ld-%Ld"
-+ i block_begin block_end interval_begin current_end;
-+
-+ f i block_begin block_end interval_begin current_end;
-+ iter_blocks (i+1) block_end block_end
-+ in
-+ iter_blocks i0 block_begin interval_begin
-+ ) intervals
++ If an interval ends halfway of a block, iteration ends on that
++ block, with interval_end < block_end indicating where the interval
++ really ended.
++*)
+
++let check_finished t =
++ let file = t.t_file in
++ match file_state file with
++ | FileNew
++ | FileCancelled
++ | FileAborted _
++ | FileShared
++ | FileDownloaded
++ | FileQueued
++ | FilePaused ->
++ false
++ | FileDownloading ->
++ if string_existsi (fun i c -> c <> '3')
++ t.t_converted_verified_bitmap then false
++ else begin
++ if file_size file <> file_downloaded t.t_file then
++ lprintf_nl "Downloaded size differs after complete verification";
++ true
++ end
-(*************************************************************************)
-(* *)
@@ -758,7 +973,7 @@
let block_begin = compute_block_begin s i in
let block_end = compute_block_end s i in
lprintf "%Ld - %Ld [%Ld] %c " block_begin block_end
-@@ -818,7 +894,7 @@
+@@ -818,7 +923,7 @@
) s.s_networks;
match b with
@@ -767,7 +982,7 @@
lprintf " [%Ld .. %Ld] --> "
b.block_begin b.block_end;
iter b.block_ranges
-@@ -827,119 +903,70 @@
+@@ -827,266 +932,352 @@
| VerifiedBlock -> lprintf_nl2 "V"
) s.s_blocks;
@@ -926,7 +1141,8 @@
(*************************************************************************)
(* *)
-@@ -947,146 +974,245 @@
+-(* set_verified_bitmap (internal) *)
++(* swarmers verified bitmaps *)
(* *)
(*************************************************************************)
@@ -960,14 +1176,14 @@
- t.t_blocks_of_chunk.(j) then
- t.t_converted_verified_bitmap.[j] <- '0'
+ match t.t_converted_verified_bitmap.[j] with
-+ | '0' -> ()
-+ | '1' ->
-+ if List.for_all (fun i -> s.s_verified_bitmap.[i] = '0')
-+ t.t_blocks_of_chunk.(j) then
-+ t.t_converted_verified_bitmap.[j] <- '0'
-+ | '2' -> lprintf_nl "set_swarmer_bitmap_0: invalidating a block within a completed chunk?"
-+ | '3' -> lprintf_nl "set_swarmer_bitmap_0: invalidating a block within a verified chunk?"
-+ | _ -> assert false
++ | '0' -> ()
++ | '1' ->
++ if List.for_all (fun i -> s.s_verified_bitmap.[i] = '0')
++ t.t_blocks_of_chunk.(j) then
++ t.t_converted_verified_bitmap.[j] <- '0'
++ | '2' -> lprintf_nl "set_swarmer_bitmap_0: invalidating a block within a completed chunk?"
++ | '3' -> lprintf_nl "set_swarmer_bitmap_0: invalidating a block within a verified chunk?"
++ | _ -> assert false
) s.s_networks
end
@@ -975,38 +1191,44 @@
also as started. *)
-let set_bitmap_1 s i =
- if s.s_verified_bitmap.[i] = '0' then begin
-- s.s_verified_bitmap.[i] <- '1';
-- List.iter (fun t ->
+let set_swarmer_bitmap_1 s i =
+ match s.s_verified_bitmap.[i] with
-+ | '0' ->
-+ s.s_verified_bitmap.[i] <- '1';
-+ List.iter (fun t ->
- let j = t.t_chunk_of_block.(i) in
++ | '0' ->
+ s.s_verified_bitmap.[i] <- '1';
+ List.iter (fun t ->
+- let j = t.t_chunk_of_block.(i) in
- if t.t_converted_verified_bitmap.[j] = '0' then
- t.t_converted_verified_bitmap.[j] <- '1'
-- ) s.s_networks
++ let j = t.t_chunk_of_block.(i) in
++ match t.t_converted_verified_bitmap.[j] with
++ | '0' -> t.t_converted_verified_bitmap.[j] <- '1'
++ | '1' -> ()
++ | '2' -> lprintf_nl "set_bitmap1: partial block within a completed chunk?"
++ | '3' -> lprintf_nl "set_bitmap1: partial block within a verified chunk?"
++ | _ -> assert false
+ ) s.s_networks
- end
-+ match t.t_converted_verified_bitmap.[j] with
-+ | '0' -> t.t_converted_verified_bitmap.[j] <- '1'
-+ | '1' -> ()
-+ | '2' -> lprintf_nl "set_bitmap1: partial block within a completed chunk?"
-+ | '3' -> lprintf_nl "set_bitmap1: partial block within a verified chunk?"
-+ | _ -> assert false
-+ ) s.s_networks
-+ | '1' -> ()
-+ | '2' -> lprintf_nl "set_swarmer_bitmap_1: trying to demote a completed block?"
-+ | '3' -> lprintf_nl "set_swarmer_bitmap_1: trying to demote a verified block?"
-+ | _ -> assert false
++ | '1' -> ()
++ | '2' -> lprintf_nl "set_swarmer_bitmap_1: trying to demote a completed block?"
++ | '3' -> lprintf_nl "set_swarmer_bitmap_1: trying to demote a verified block?"
++ | _ -> assert false
+
-(* we finished this block, we need know to verify it *)
-let set_bitmap_2 s i =
- if s.s_verified_bitmap.[i] < '2' then begin
- s.s_verified_bitmap.[i] <- '2';
-- match s.s_networks with
++(* we finished this block, trying to escalate to primary frontend
++ verification bitmap *)
++let set_swarmer_bitmap_2 s i =
++ match s.s_verified_bitmap.[i] with
++ | '0' | '1' ->
++ (s.s_verified_bitmap.[i] <- '2';
+ match s.s_networks with
- | t :: _ when t.t_primary ->
-- let j = t.t_chunk_of_block.(i) in
++ | t :: _ ->
++ assert (t.t_primary);
+ let j = t.t_chunk_of_block.(i) in
- if List.for_all (fun i -> s.s_verified_bitmap.[i] = '2')
- t.t_blocks_of_chunk.(j) &&
- t.t_converted_verified_bitmap.[j] <> '3' then begin
@@ -1016,30 +1238,22 @@
- | [] -> assert false
- | _ -> ()
- end
-+(* we finished this block, trying to escalate to primary frontend
-+ verification bitmap *)
-+let set_swarmer_bitmap_2 s i =
-+ match s.s_verified_bitmap.[i] with
-+ | '0' | '1' ->
-+ (s.s_verified_bitmap.[i] <- '2';
-+ match s.s_networks with
-+ | t :: _ ->
-+ assert (t.t_primary);
-+ let j = t.t_chunk_of_block.(i) in
-+ (match t.t_converted_verified_bitmap.[j] with
-+ | '0' | '1' ->
-+ if List.for_all (fun i -> s.s_verified_bitmap.[i] = '2')
-+ t.t_blocks_of_chunk.(j) then begin
-+ t.t_ncomplete_chunks <- t.t_ncomplete_chunks + 1;
-+ t.t_converted_verified_bitmap.[j] <- '2'
-+ end
-+ | '2' -> ()
-+ | '3' -> lprintf_nl "set_swarmer_bitmap_2: trying to demote a verified block? (1)"
-+ | _ -> assert false)
-+ | [] -> assert false)
-+ | '2' -> ()
-+ | '3' -> lprintf_nl "set_swarmer_bitmap_2: trying to demote a verified block? (2)"
-+ | _ -> assert false
++ (match t.t_converted_verified_bitmap.[j] with
++ | '0' | '1' ->
++ if List.for_all (fun i -> s.s_verified_bitmap.[i] = '2')
++ t.t_blocks_of_chunk.(j) then begin
++ t.t_ncomplete_chunks <- t.t_ncomplete_chunks + 1;
++ t.t_converted_verified_bitmap.[j] <- '2'
++ end
++ | '2' -> ()
++ | '3' ->
++ (* lprintf_nl "set_swarmer_bitmap_2: trying to demote a verified block? (1)" *)
++ ()
++ | _ -> assert false)
++ | [] -> assert false)
++ | '2' -> ()
++ | '3' -> lprintf_nl "set_swarmer_bitmap_2: trying to demote a verified block? (2)"
++ | _ -> assert false
(* the primary verifier has worked, so let ask secondary ones for
-verification too *)
@@ -1081,6 +1295,9 @@
+ | [] -> assert false
+ | tprim :: secondaries ->
+ assert (tprim.t_primary);
++ (* that test is somewhat redundant, since only primary
++ frontends with verification can have merged secondary
++ frontends; See merge *)
+ match tprim.t_verifier with
+ | NoVerification | VerificationNotAvailable -> ()
+ | Verification _ | ForceVerification ->
@@ -1178,14 +1395,15 @@
set_completed_block None s j;
s.s_blocks.(j) <- VerifiedBlock;
- set_bitmap_3 s j
--
--(*************************************************************************)
--(* *)
--(* set_verified_chunk (internal) *)
--(* *)
--(*************************************************************************)
+ set_swarmer_bitmap_3 s j
+ (*************************************************************************)
+ (* *)
+-(* set_verified_chunk (internal) *)
++(* frontends verified bitmaps *)
+ (* *)
+ (*************************************************************************)
+
-let set_verified_chunk t i =
- t.t_nverified_blocks <- t.t_nverified_blocks + 1;
- t.t_converted_verified_bitmap.[i] <- '3';
@@ -1210,18 +1428,18 @@
+ t.t_converted_verified_bitmap.[j] <- '0';
+ List.iter (fun i ->
+ match s.s_blocks.(i) with
-+ | EmptyBlock -> set_swarmer_bitmap_0 s i
-+ | PartialBlock _ -> set_swarmer_bitmap_1 s i
-+ | CompleteBlock ->
-+ let block_begin = compute_block_begin s i in
-+ let block_end = compute_block_end s i in
-+ (* negative *)
-+ add_file_downloaded None s (block_begin -- block_end);
++ | EmptyBlock -> set_swarmer_bitmap_0 s i
++ | PartialBlock _ -> set_swarmer_bitmap_1 s i
++ | CompleteBlock ->
++ let block_begin = compute_block_begin s i in
++ let block_end = compute_block_end s i in
++ (* negative *)
++ add_file_downloaded None s (block_begin -- block_end);
+
-+ s.s_blocks.(i) <- EmptyBlock;
-+ set_swarmer_bitmap_0 s i
-+
-+ | VerifiedBlock -> assert false
++ s.s_blocks.(i) <- EmptyBlock;
++ set_swarmer_bitmap_0 s i
++
++ | VerifiedBlock -> assert false
+ ) t.t_blocks_of_chunk.(j)
end
+ else begin
@@ -1243,15 +1461,27 @@
-(* verify (internal) *)
-(* *)
-(*************************************************************************)
-+(* aka set_verified_chunk (internal) *)
++(* aka set_completed_chunk (internal) *)
++let set_frontend_bitmap_2 t j =
++ match t.t_converted_verified_bitmap.[j] with
++ | '0' | '1' ->
++ if !verbose_swarming || !verbose then
++ lprintf_nl "Completed block %d/%d of %s"
++ (j + 1) t.t_nchunks (file_best_name t.t_file);
++ let s = t.t_s in
++ List.iter (fun i -> set_completed_block None s i)
++ t.t_blocks_of_chunk.(j)
++ | '2' | '3' -> ()
++ | _ -> assert false
-let verify t chunks num begin_pos end_pos =
- file_verify t.t_file chunks.(num) begin_pos end_pos
++(* aka set_verified_chunk (internal) *)
+let set_frontend_bitmap_3 t j =
+ let mark_verified () =
+ t.t_converted_verified_bitmap.[j] <- '3';
+ if !verbose_swarming || !verbose then
-+ lprintf_nl "Completed block %d/%d of %s"
++ lprintf_nl "Verified block %d/%d of %s"
+ (j + 1) t.t_nchunks (file_best_name t.t_file);
+ if t.t_primary then begin
+ let s = t.t_s in
@@ -1262,25 +1492,38 @@
+ end;
+ t.t_verified t.t_nverified_chunks j in
+ match t.t_converted_verified_bitmap.[j] with
-+ | '0' | '1' ->
-+ t.t_ncomplete_chunks <- t.t_ncomplete_chunks + 1;
-+ t.t_nverified_chunks <- t.t_nverified_chunks + 1;
-+ mark_verified ();
++ | '0' | '1' ->
++ t.t_ncomplete_chunks <- t.t_ncomplete_chunks + 1;
++ t.t_nverified_chunks <- t.t_nverified_chunks + 1;
++ mark_verified ();
++ | '2' ->
++ t.t_nverified_chunks <- t.t_nverified_chunks + 1;
++ mark_verified ();
++ | '3' -> ()
++ | _ -> assert false
++
++let set_chunks_verified_bitmap t bitmap =
++ string_iter (fun j c ->
++ match c with
++ | '0' | '1' ->
++ ()
+ | '2' ->
-+ t.t_nverified_chunks <- t.t_nverified_chunks + 1;
-+ mark_verified ();
-+ | '3' -> ()
++ set_frontend_bitmap_2 t j
++ | '3' ->
++ set_frontend_bitmap_3 t j;
++ if t.t_converted_verified_bitmap.[j] <> '3' then
++ lprintf_nl "FIELD AS BEEN CLEARED"
+ | _ -> assert false
++ ) bitmap
++
++let chunks_verified_bitmap t = t.t_converted_verified_bitmap
+
+(** Check the equality of the hash of [t]'s data between offsets
+ [begin_pos] and [end_pos] against the value of [uid] *)
-+
-+let verify t uid begin_pos end_pos =
-+ file_verify t.t_file uid begin_pos end_pos
(*************************************************************************)
(* *)
-@@ -1094,258 +1220,107 @@
+@@ -1094,258 +1285,82 @@
(* *)
(*************************************************************************)
@@ -1288,6 +1531,9 @@
- if t.t_converted_verified_bitmap.[i] = '2' then
- let nblocks = String.length t.t_converted_verified_bitmap in
+let verify_chunk t j =
++ let verify t uid begin_pos end_pos =
++ file_verify t.t_file uid begin_pos end_pos in
++
+ if t.t_converted_verified_bitmap.[j] = '2' then
+ let nchunks = String.length t.t_converted_verified_bitmap in
match t.t_verifier with
@@ -1452,14 +1698,14 @@
+ ) t.t_converted_verified_bitmap
with VerifierNotReady -> ()
- end
--
--
+
+
-(*************************************************************************)
-(* *)
-(* must_verify_chunk (internal) *)
-(* *)
-(*************************************************************************)
-
+-
- (*
-let must_verify_chunk t i immediatly =
- match t.t_verifier with
@@ -1470,7 +1716,7 @@
- if t.t_converted_verified_bitmap.[i] = '2' && immediatly then
- verify_chunk t i
- *)
-
+-
-(*************************************************************************)
-(* *)
-(* must_verify_block *)
@@ -1511,41 +1757,34 @@
- for i = 0 to String.length s.s_verified_bitmap - 1 do
- must_verify_block s i immediatly
- done
-+ string_iter (fun i _ -> must_verify_block s i) s.s_verified_bitmap
-
+-
-(*************************************************************************)
-(* *)
-(* compute_bitmap *)
-(* *)
-(*************************************************************************)
-+(** same, and synchronously calls the verification of all chunks *)
-+
-+let verify_all_chunks_immediately t =
-+ verify_all_chunks t;
-+ string_iter (fun i _ -> verify_chunk t i) t.t_converted_verified_bitmap
-+
-
-+(** synchronously verify all completed chunks not yet verified *)
-
- let compute_bitmap t =
+-
+-
+-let compute_bitmap t =
- if t.t_ncomplete_blocks > t.t_nverified_blocks then begin
- for i = 0 to String.length t.t_converted_verified_bitmap - 1 do
- if t.t_converted_verified_bitmap.[i] = '2' then
- verify_chunk t i
- done
- end
-+ if t.t_ncomplete_chunks > t.t_nverified_chunks then
-+ string_iter (fun i c ->
-+ if c = '2' then verify_chunk t i) t.t_converted_verified_bitmap
++ string_iter (fun i _ -> must_verify_block s i) s.s_verified_bitmap
++(** same, and synchronously calls the verification of all chunks *)
-(*************************************************************************)
-(* *)
-(* split_range (internal) *)
-(* *)
-(*************************************************************************)
-+(** Replaces the ith block of the swarmer with a PartialBlock
-+ ranges are created with s_range_size size *)
++let verify_all_chunks_immediately t =
++ verify_all_chunks t;
++ string_iter (fun i _ -> verify_chunk t i) t.t_converted_verified_bitmap
++
-let rec split_range r range_size =
- assert (r.range_current_begin = r.range_begin);
@@ -1560,59 +1799,41 @@
- range_begin = next_range;
- range_current_begin = next_range;
- range_end = r.range_end;
-+let new_block s i =
-+
-+ (** Split a range in ranges of at most [range_size] bytes, if needed
-+ ranges stay linked together *)
-+
-+ let rec split_range r range_size =
-+ let cut_pos = r.range_begin ++ range_size in
-+(* lprintf " split_range: cut_pos %Ld\n" cut_pos; *)
-+ if r.range_end > cut_pos then
-+ (* "right" half *)
-+ let split_r = {
-+ range_block = r.range_block;
-+ range_nuploading = 0;
-+ range_next = r.range_next;
-+ range_prev = Some r;
-+ range_begin = cut_pos;
-+ range_end = r.range_end;
- } in
+- } in
- begin
- match r.range_next with
- None -> ()
- | Some rrr ->
-+ (match r.range_next with
-+ | None -> ()
-+ | Some old_next_range ->
- (* lprintf "Another one ??\n"; *)
+-(* lprintf "Another one ??\n"; *)
- rrr.range_prev <- Some rr;
- end;
- r.range_next <- Some rr;
- r.range_end <- next_range;
-+ old_next_range.range_prev <- Some split_r);
-+ (* "left" half *)
-+ r.range_next <- Some split_r;
-+ r.range_end <- cut_pos;
- (* lprintf " NEW RANGE: %Ld- OLD RANGE: %Ld-%Ld\n"
+-(* lprintf " NEW RANGE: %Ld- OLD RANGE: %Ld-%Ld\n"
- rr.range_begin r.range_begin r.range_end; *)
--
++(** synchronously verify all completed chunks not yet verified *)
+
- split_range rr range_size
--
--
++let compute_bitmap t =
++ if t.t_ncomplete_chunks > t.t_nverified_chunks then
++ string_iter (fun i c ->
++ if c = '2' then verify_chunk t i) t.t_converted_verified_bitmap
+
+
-(*************************************************************************)
-(* *)
-(* new_block (internal) *)
-(* *)
-(*************************************************************************)
-+ split_r.range_begin r.range_begin r.range_end; *)
-+ split_range split_r range_size in
++(** Replaces the ith block of the swarmer with a PartialBlock
++ ranges are created with s_range_size size *)
--let new_block s i =
+ let new_block s i =
++
let block_begin = compute_block_begin s i in
let block_end = compute_block_end s i in
let rec b = {
-@@ -1365,348 +1340,227 @@
+@@ -1365,348 +1380,273 @@
range_end = block_end;
range_block = b;
range_nuploading = 0;
@@ -1621,8 +1842,8 @@
in
-
(* lprintf "New block %Ld-%Ld\n" block_begin block_end; *)
- split_range range s.s_range_size;
-
+- split_range range s.s_range_size;
+-
-(*
- let rec iter r =
- lprintf " Range %Ld-%Ld\n" r.range_begin r.range_end;
@@ -1632,7 +1853,7 @@
- in
- iter b.block_ranges;
-*)
--
+
s.s_blocks.(i) <- PartialBlock b;
if s.s_verified_bitmap.[i] < '1' then
- set_bitmap_1 s i;
@@ -1711,33 +1932,6 @@
- begin
- match s.s_blocks.(b.block_num) with
- PartialBlock _ | EmptyBlock ->
--
-- begin
-- match s.s_networks with
-- [] -> assert false
-- | t :: _ when t.t_primary ->
-- begin
-- match t.t_verifier with
-- NoVerification ->
-- set_verified_block s b.block_num
-- | _ ->
-- set_completed_block (Some t) s b.block_num;
-- must_verify_block s b.block_num false
-- end
-- | _ -> ()
-- end
-- | _ -> ()
-- end
-- | Some rr -> b.block_ranges <- rr
-- end;
-- | Some rr -> rr.range_next <- r.range_next);
-- r.range_next <- None;
-- r.range_prev <- None;
-- end (* else begin
-- lprintf " ... new range %Ld-%Ld\n" r.range_current_begin r.range_end;
-- end *)
-- end
--
+ let new_current_begin =
+ max (min interval_end r.range_end) r.range_begin in
+ let downloaded = new_current_begin -- r.range_begin in
@@ -1780,6 +1974,56 @@
+ end *)
+ end
+- begin
+- match s.s_networks with
+- [] -> assert false
+- | t :: _ when t.t_primary ->
+- begin
+- match t.t_verifier with
+- NoVerification ->
+- set_verified_block s b.block_num
+- | _ ->
+- set_completed_block (Some t) s b.block_num;
+- must_verify_block s b.block_num false
+- end
+- | _ -> ()
+- end
+- | _ -> ()
+- end
+- | Some rr -> b.block_ranges <- rr
+- end;
+- | Some rr -> rr.range_next <- r.range_next);
+- r.range_next <- None;
+- r.range_prev <- None;
+- end (* else begin
+- lprintf " ... new range %Ld-%Ld\n" r.range_current_begin r.range_end;
+- end *)
+- end
++(** Split a range at [cut_pos] offset, if needed;
++ ranges stay linked together *)
+
++let rec split_range r cut_pos =
++(* lprintf " split_range: cut_pos %Ld\n" cut_pos; *)
++ if r.range_begin < cut_pos && r.range_end > cut_pos then
++ (* "right" half *)
++ let split_r = {
++ range_block = r.range_block;
++ range_nuploading = 0;
++ range_next = r.range_next;
++ range_prev = Some r;
++ range_begin = cut_pos;
++ range_end = r.range_end;
++ } in
++ (match r.range_next with
++ | None -> ()
++ | Some old_next_range ->
++ old_next_range.range_prev <- Some split_r);
++ (* "left" half *)
++ r.range_next <- Some split_r;
++ r.range_end <- cut_pos
++(* lprintf " NEW RANGE: %Ld- OLD RANGE: %Ld-%Ld\n"
++ split_r.range_begin r.range_begin r.range_end; *)
+
-(*************************************************************************)
-(* *)
-(* set_present_block (internal) *)
@@ -1820,8 +2064,18 @@
-(* *)
-(*************************************************************************)
+let set_present_block b interval_begin interval_end =
++ let interval_size = interval_end -- interval_begin in
++ let old_remaining = b.block_remaining in
++ (* download can only happen at the beginning of ranges, so we must
++ first split at each interval beginning *)
++ iter_block_ranges (fun r ->
++ split_range r interval_begin) b;
+ iter_block_ranges (fun r ->
-+ range_received None r interval_begin interval_end) b
++ range_received None r interval_begin interval_end) b;
++ let new_present = old_remaining -- b.block_remaining in
++ if new_present <> interval_size then
++ lprintf_nl "set_present_block: %Ld added <> %Ld effectively added"
++ interval_size new_present
-let set_present s chunks =
+(** Remove a list of intervals from the ranges of a swarmer *)
@@ -1866,14 +2120,15 @@
(* lprintf " Other\n"; *)
- ()
- ) chunks
--
++ ()
++ ) intervals
+
-(*************************************************************************)
-(* *)
-(* end_present (internal) *)
-(* *)
-(*************************************************************************)
-+ ()
-+ ) intervals
++(** reverse absent/present in the list and call set_present *)
-let rec end_present present begin_present end_file list =
- match list with
@@ -1889,32 +2144,40 @@
- else (begin_present, begin_absent) :: present
- in
- end_present present end_absent end_file tail
-+(** reverse absent/present in the list and call set_present *)
-
--(*************************************************************************)
--(* *)
--(* set_absent *)
--(* *)
--(*************************************************************************)
+let set_absent s list_absent =
+(** Build the complementary list of intervals of [intervals] in
+ [set_begin, set_end[ *)
+ let rec complementary acc set_begin set_end intervals =
+ match intervals with
-+ | [] ->
-+ let acc =
-+ if set_begin = set_end then acc else
-+ (set_begin, set_end) :: acc
-+ in
-+ List.rev acc
-+ | (interval_begin, interval_end) :: other_intervals ->
-+ let acc =
-+ if set_begin = interval_begin then acc
-+ else (set_begin, interval_begin) :: acc
-+ in
-+ complementary acc interval_end set_end other_intervals in
++ | [] ->
++ let acc =
++ if set_begin = set_end then acc else
++ (set_begin, set_end) :: acc
++ in
++ List.rev acc
++ | (interval_begin, interval_end) :: other_intervals ->
++ let acc =
++ if set_begin = interval_begin then acc
++ else (set_begin, interval_begin) :: acc
++ in
++ complementary acc interval_end set_end other_intervals in
+ let list_present = complementary [] Int64.zero s.s_size list_absent in
+ set_present s list_present
++
++let intervals_to_string s intervals =
++ match intervals with
++ | AvailableIntervals intervals ->
++ let st = String.make (Array.length s.s_blocks) '0' in
++ iter_intervals s (fun i _ _ _ _ -> st.[i] <- '1') intervals;
++ st
++ | AvailableBitv b -> Bitv.to_string b
+
+ (*************************************************************************)
+ (* *)
+-(* set_absent *)
++(* Uploaders *)
+ (* *)
+ (*************************************************************************)
-let set_absent s list =
-(* reverse absent/present in the list and call set_present *)
@@ -1927,20 +2190,22 @@
- end_present [zero, t1] t2 s.s_size tail
- in
- set_present s list
-+let intervals_to_string s intervals =
-+ match intervals with
-+ | AvailableIntervals intervals ->
-+ let st = String.make (Array.length s.s_blocks) '0' in
-+ iter_intervals s (fun i _ _ _ _ -> st.[i] <- '1') intervals;
-+ st
-+ | AvailableBitv b -> Bitv.to_string b
++(** (debug) output an [uploader] to current log *)
- (*************************************************************************)
- (* *)
+-(*************************************************************************)
+-(* *)
-(* chunks_to_string (internal) *)
-+(* Uploaders *)
- (* *)
- (*************************************************************************)
+-(* *)
+-(*************************************************************************)
++let print_uploader up =
++ lprintf_n " interesting complete_blocks: %d\n " up.up_ncomplete;
++ Array.iter (fun i -> lprintf " %d " i) up.up_complete_blocks;
++ lprint_newline ();
++ lprintf_n " interesting partial_blocks: %d\n " up.up_npartial;
++ Array.iter (fun (i, begin_pos, end_pos) ->
++ lprintf " %d[%Ld...%Ld] " i begin_pos end_pos
++ ) up.up_partial_blocks;
++ lprint_newline ()
-let chunks_to_string s chunks =
- match chunks with
@@ -2132,7 +2397,7 @@
(*************************************************************************)
(* *)
-@@ -1714,15 +1568,14 @@
+@@ -1714,15 +1654,14 @@
(* *)
(*************************************************************************)
@@ -2150,7 +2415,7 @@
up_complete_blocks = [||];
up_ncomplete = 0;
-@@ -1733,11 +1586,12 @@
+@@ -1733,11 +1672,12 @@
up_block = None;
up_block_begin = zero;
up_block_end = zero;
@@ -2164,7 +2429,7 @@
up
(*************************************************************************)
-@@ -1746,34 +1600,63 @@
+@@ -1746,34 +1686,63 @@
(* *)
(*************************************************************************)
@@ -2250,7 +2515,7 @@
| CompleteBlock -> lprintf "C"
| VerifiedBlock -> lprintf "V"
| PartialBlock b ->
-@@ -1781,127 +1664,128 @@
+@@ -1781,127 +1750,125 @@
lprintf "X"
else
lprintf "%d" s.s_nuploading.(i)
@@ -2291,15 +2556,12 @@
-(* permute_and_return (internal) *)
-(* *)
-(*************************************************************************)
-+(** swap elements n and up_ncomplete-1 in up_complete_blocks, then
-+ decrease up_ncomplete block, return up_ncomplete block, converting
-+ it to a PartialBlock as needed.
-+ global effect is that up_complete_blocks array virtually contains
-+ two disctinct lists, with elements flowing from one to the other,
-+ without any allocation needed.
-+
-+ 0 .. up_ncomplete-1 : not yet returned by permute_and_return
-+ up_ncomplete .. Array.length up_complete_blocks - 1 : already returned
++(** (see uploaders invariants above)
++ Drop the [n]th element from the [up.up_ncomplete] first elements
++ of [up.complete_blocks] by swapping it with the
++ ([up.up_ncomplete]-1)th element, then decrease [up.up_ncomplete];
++ Then return that element, after converting associated block to
++ PartialBlock if necessary.
+*)
let permute_and_return up n =
@@ -2465,7 +2727,7 @@
in
(* if result then
lprintf "should_download_block %d\n" n; *)
-@@ -1913,264 +1797,204 @@
+@@ -1913,264 +1880,302 @@
(* *)
(*************************************************************************)
@@ -2481,13 +2743,22 @@
+ choice_num : int;
+ choice_user_priority : int;
+ choice_nuploaders : int;
-+ choice_size : int64;
+ choice_remaining : int64;
-+ choice_remaining_per_uploader : int64;
++ choice_saturated : bool; (* has enough uploaders *)
+ choice_other_complete : int Lazy.t; (* ...blocks in the same chunk *)
+ choice_availability : int;
+}
+
++let dummy_choice = {
++ choice_num = 0;
++ choice_user_priority = 0;
++ choice_nuploaders = 0;
++ choice_remaining = 0L;
++ choice_saturated = true;
++ choice_other_complete = lazy 0;
++ choice_availability = 0
++}
++
+(* based on Array.fold_left code *)
+let array_fold_lefti f x a =
+ let r = ref x in
@@ -2495,8 +2766,30 @@
+ r := f !r i (Array.unsafe_get a i)
+ done;
+ !r
++
++let subarray_fold_lefti f x a firstidx lastidx =
++ let len = Array.length a in
++ assert(firstidx >= 0 && firstidx < len);
++ assert(lastidx >= 0 && lastidx < len);
++ let r = ref x in
++ for i = firstidx to lastidx do
++ r := f !r i (Array.unsafe_get a i)
++ done;
++ !r
++
++(* DEBUGGING *)
++let delta_needed = ref 0
++let delta_undecided = ref 0
let select_block up =
++(* DEBUGGING *)
++ let compare_choices_saturation = ref 0 in
++ let compare_choices_priority = ref 0 in
++ let compare_choices_rarity = ref 0 in
++ let compare_choices_completion = ref 0 in
++ let compare_choices_siblings = ref 0 in
++ let compare_choices_failure = ref 0 in
++
let t = up.up_t in
let s = t.t_s in
try
@@ -2614,19 +2907,14 @@
- s.s_verified_bitmap.[s_index] = '2'
- ) t.t_blocks_of_chunk.(t_index) in
- let nbs = List.length bs in
--
--(* TODO remove this *)
-- let b = should_download_block s n in
+(* to evaluate the relative rarity of a block, we must compare it to
+ the availability of *all* blocks, not only those available from
+ that uploader *)
+ let sum_availability = Array.fold_left (+) 0 s.s_availability in
+ let mean_availability = sum_availability / Array.length s.s_blocks in
-- if !verbose_swarming then
-- lprintf_nl2 " test %d %c %d %b %d"
-- n s.s_verified_bitmap.[n] s.s_nuploading.(n)
-- b nbs;
+-(* TODO remove this *)
+- let b = should_download_block s n in
+ let my_t = if t.t_verifier <> NoVerification then t else
+ match s.s_networks with
+ | tprim :: _ ->
@@ -2635,9 +2923,10 @@
+ | [] -> assert false in
+ let verification_available = my_t.t_verifier <> NoVerification in
-- if s.s_verified_bitmap.[n] < '2' &&
-- s.s_nuploading.(n) < max_uploaders &&
-- should_download_block s n then
+- if !verbose_swarming then
+- lprintf_nl2 " test %d %c %d %b %d"
+- n s.s_verified_bitmap.[n] s.s_nuploading.(n)
+- b nbs;
+ let several_frontends = List.length s.s_networks > 1 in
+ (* many results may not be useful, evaluate them as needed *)
+ let completed_blocks_in_chunk =
@@ -2647,6 +2936,12 @@
+ if s.s_verified_bitmap.[b] = '2' then acc + 1 else acc
+ ) 0 my_t.t_blocks_of_chunk.(i))) in
+- if s.s_verified_bitmap.[n] < '2' &&
+- s.s_nuploading.(n) < max_uploaders &&
+- should_download_block s n then
++ let preview_beginning = 10000000L in
++ let preview_end = (s.s_size ** 98L) // 100L in
+
- if (!partial_block = -1 || !partial_remaining < nbs)
- then
- begin
@@ -2661,24 +2956,55 @@
- raise (BlockFound !partial_block)
- end
- in
-+ let preview_beginning = 10000000L 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
++
++ let need_to_complete_some_blocks_quickly =
++ verification_available && t.t_nverified_chunks < 2 in
- if my_t.t_verifier <> NoVerification then begin
- download_partial max_nuploaders;
- end;
- end;
-+ (* sources_per_chunk was initially for edonkey only *)
-+ let data_per_source = 9728000L // (Int64.of_int !!sources_per_chunk) in
++ (** > 0 == c1 is best, < 0 = c2 is best, 0 == they're equivalent *)
++ let compare_choices c1 c2 =
-(************* Download rarest first only if other blocks are much more
- available *)
-+ let need_to_complete_some_blocks_quickly = true
-+ (* verification_available && t.t_nverified_chunks < 2 *) in
++ (* avoid overly unbalanced situations *)
++ let cmp =
++ match c1.choice_saturated, c2.choice_saturated with
++ | false, false -> 0
++ | true, false -> -1
++ | false, true -> 1
++ | true, true ->
++ let result =
++ (* both are saturated, try to balance situation *)
++ incr delta_needed;
++ let delta =
++ c1.choice_remaining ** Int64.of_int c2.choice_nuploaders --
++ c2.choice_remaining ** Int64.of_int c1.choice_nuploaders in
++ if delta > c2.choice_remaining then 1
++ else if delta < Int64.neg c1.choice_remaining then -1
++ else begin
++ (* either way we'll unbalance the situation *)
++ incr delta_undecided;
++ 0
++ end in
++ lprintf_nl "compare_choices needed delta %d times, which couldn't decide %d times" !delta_needed !delta_undecided;
++ result in
++ if cmp <> 0 then begin
++ incr compare_choices_saturation;
++ cmp
++ end else
- if debug_all then lprintf "{Rarest}";
-+ (** > 0 == c1 is best, < 0 = c2 is best, 0 == they're equivalent *)
-+ let compare_choices c1 c2 =
++ (* Do what Master asked for *)
++ let cmp = compare c1.choice_user_priority c2.choice_user_priority in
++ if cmp <> 0 then begin
++ incr compare_choices_priority;
++ cmp
++ end else
- let sum_availability = ref 0 in
- let min_availability = ref max_int in
@@ -2689,19 +3015,30 @@
- min_availability := min !min_availability
- s.s_availability.(n);
- done;
-+ (* avoid overly unbalanced situations *)
++ (* Pick really rare gems: if average availability of all
++ blocks is higher than 5 connected sources, pick in
++ priority blocks present in at most 3 connected sources;
++ is that too restrictive ? *)
+ let cmp =
-+ if c1.choice_remaining_per_uploader < data_per_source ||
-+ c2.choice_remaining_per_uploader < data_per_source then
-+ compare c1.choice_remaining_per_uploader
-+ c2.choice_remaining_per_uploader else 0 in
-+ if cmp <> 0 then cmp else
++ if not need_to_complete_some_blocks_quickly &&
++ mean_availability > 5 &&
++ (c1.choice_availability <= 3 || c2.choice_availability <= 3) then
++ compare c2.choice_availability c1.choice_availability
++ else 0 in
++ if cmp <> 0 then begin
++ incr compare_choices_rarity;
++ cmp
++ end else
- let mean_availability =
- !sum_availability / up.up_ncomplete in
-+ (* Do what Master asked for *)
-+ let cmp = compare c1.choice_user_priority c2.choice_user_priority in
-+ if cmp <> 0 then cmp else
++ (* try to quickly complete blocks *)
++ let cmp =
++ compare c2.choice_remaining c1.choice_remaining in
++ if cmp <> 0 then begin
++ incr compare_choices_completion;
++ cmp
++ end else
- if mean_availability > 5 && !min_availability < 3 then
- for i = 0 to up.up_ncomplete - 1 do
@@ -2711,20 +3048,25 @@
- then
- raise (BlockFound i)
- done;
-+ (* Pick really rare gems *)
++ (* try to quickly complete (and validate) chunks;
++ if there's only one frontend, each chunk has only one
++ block, and looking at siblings make no sense *)
+ let cmp =
-+ if mean_availability > 5 &&
-+ (c1.choice_availability <= 3 || c2.choice_availability <= 3) then
-+ compare c2.choice_availability c1.choice_availability
++ if verification_available && several_frontends then
++ compare (Lazy.force c1.choice_other_complete)
++ (Lazy.force c2.choice_other_complete)
+ else 0 in
-+ if cmp <> 0 then cmp else
++ if cmp <> 0 then begin
++ incr compare_choices_siblings;
++ cmp
++ end else
-(************* Otherwise, download in random order *)
-+ (* try to quickly complete blocks *)
-+ let cmp =
-+ if need_to_complete_some_blocks_quickly then
-+ compare c2.choice_remaining c1.choice_remaining else 0 in
-+ if cmp <> 0 then cmp else
++ begin
++ (* Can't tell *)
++ incr compare_choices_failure;
++ 0
++ end in
- if debug_all then lprintf "{Random}";
- let find_random max_uploaders =
@@ -2745,20 +3087,8 @@
- raise (BlockFound (array.(
- random_int (Array.length array))))
- in
-+ (* try to quickly complete (and validate) chunks *)
-+ let cmp =
-+ if verification_available && several_frontends then
-+ compare (Lazy.force c1.choice_other_complete)
-+ (Lazy.force c2.choice_other_complete)
-+ else 0 in
-+ if cmp <> 0 then cmp else
-
-- find_random max_nuploaders
-+ (* Can't tell *)
-+ 0 in
-
--(************* Fall back on linear download if nothing worked *)
-+ let best_choices = array_fold_lefti (fun acc n b ->
++ let best_choices, specimen =
++ subarray_fold_lefti (fun ((best_choices, specimen) as acc) n b ->
+ (* priority bitmap <> 0 here ? *)
+ if not (should_download_block s b) then acc else
+ let nchunk = my_t.t_chunk_of_block.(b) in
@@ -2776,27 +3106,64 @@
+ if block_begin < preview_beginning then 3 else
+ if block_end > preview_end then 2 else 1;
+ choice_nuploaders = nuploaders;
-+ choice_size = size;
+ choice_remaining = remaining;
-+ choice_remaining_per_uploader = remaining //
-+ (Int64.of_int (nuploaders + 1)); (* planned value *)
++ choice_saturated =
++ not need_to_complete_some_blocks_quickly &&
++ remaining <= Int64.of_int nuploaders ** data_per_source;
++(*
++ nuploaders >= Int64.to_int (
++ Int64.pred (
++ remaining ** Int64.of_int !!sources_per_chunk ++ size)
++ // size)
++*)
+ choice_other_complete = completed_blocks_in_chunk.(nchunk);
+ choice_availability = s.s_availability.(b);
+ } in
-+ match acc with
-+ | [] -> [this_choice]
-+ | h :: _ ->
++ match best_choices with
++ | [] -> [n], this_choice
++ | _ :: _ ->
+ (* all the choices in the accumulator are supposed to
-+ be equivalent, compare against the first *)
-+ let cmp = compare_choices this_choice h in
-+ if cmp > 0 then [this_choice]
++ be equivalent, compare against the specimen *)
++ let cmp = compare_choices this_choice specimen in
++ if cmp > 0 then [n], this_choice
+ else if cmp < 0 then acc
-+ else this_choice :: acc
-+ ) [] up.up_complete_blocks in
++ else n :: best_choices, specimen
++ ) ([], dummy_choice) up.up_complete_blocks 0 (up.up_ncomplete - 1) in
+ (* what about up_partial_blocks ?
+ currently they're taken care of by linear_select_block
+ fallback below *)
+- find_random max_nuploaders
++ if debug_all then begin
++ let nbest_choices = List.length best_choices in
++ lprintf_nl "compare_choices: %d choices left based on saturation:%d priority:%d rarity:%d completion:%d siblings:%d failed:%d"
++ nbest_choices
++ !compare_choices_saturation !compare_choices_priority
++ !compare_choices_rarity !compare_choices_completion
++ !compare_choices_siblings !compare_choices_failure;
++ let print_choice c =
++ lprintf_nl "selected %d:%d priority:%d nup:%d rem:%Ld sat:%s sib:%s av:%d"
++ c.choice_num up.up_complete_blocks.(c.choice_num)
++ c.choice_user_priority
++ c.choice_nuploaders
++ c.choice_remaining
++ (if c.choice_saturated then "true" else "false")
++ (if Lazy.lazy_is_val c.choice_other_complete then
++ string_of_int (Lazy.force c.choice_other_complete) else "?")
++ c.choice_availability in
++ print_choice specimen
++ end;
+
+-(************* Fall back on linear download if nothing worked *)
++ try
++ let n =
++ match best_choices with
++ | [] -> raise Not_found
++ | [choice] -> choice
++ | _::_ ->
++ let nchoices = List.length best_choices in
++ List.nth best_choices (Random.int nchoices) in
+
- in
- iter_max_uploaders !!sources_per_chunk;
- iter_max_uploaders max_int;
@@ -2808,20 +3175,12 @@
- permute_and_return up n
- end else
- LinearStrategy.select_block up
-+ try
-+ let result =
-+ match best_choices with
-+ | [] -> raise Not_found
-+ | [choice] -> choice
-+ | _::_ ->
-+ let nchoices = List.length best_choices in
-+ List.nth best_choices (Random.int nchoices) in
-+ let n = result.choice_num in
-+
+ if debug_all then lprintf "\nBlockFound %d\n"
+ up.up_complete_blocks.(n);
+ permute_and_return up n
+ with Not_found ->
++ if !verbose_swarming || !verbose then
++ lprintf "select_block: fallback to linear strategy";
+ linear_select_block up
with Not_found ->
@@ -2887,7 +3246,7 @@
let num = b.block_num in
s.s_nuploading.(num) <- s.s_nuploading.(num) + 1;
up.up_block <- Some b;
-@@ -2179,60 +2003,33 @@
+@@ -2179,60 +2184,33 @@
if debug_all then lprintf " = %d \n" num;
b
with e ->
@@ -2964,10 +3323,12 @@
(*************************************************************************)
(* *)
-@@ -2240,262 +2037,200 @@
+@@ -2240,262 +2218,294 @@
(* *)
(*************************************************************************)
+-let find_range up =
+- clean_ranges up;
+let uploader_ranges_fold_left f acc l =
+ let rec aux acc l =
+ match l with
@@ -2975,14 +3336,55 @@
+ | h :: q -> aux (f acc h) q
+ in aux acc l
+
- let find_range up =
-- clean_ranges up;
++(** Find a range to upload from [up], that is at most [range_size]
++ bytes long (split some range if necessary) *)
++
++(* Is merging at all useful ? Once range starts downloading, they can
++ no longer be merged, so it should be very rare... *)
++let allow_merge_ranges = true
++
++type ranges_cluster = {
++ cluster_ranges: range list;
++ cluster_nuploading: int;
++ cluster_size: Int64.t
++}
++
++let dummy_ranges_cluster = {
++ cluster_ranges = [];
++ cluster_nuploading = 0;
++ cluster_size = 0L
++}
++
++let find_range up range_size =
++
++ (** merge two consecutive ranges in the first, if possible;
++ Return true if successful *)
++ let merge_ranges r r2 =
++ match r.range_next with
++ | None -> false
++ | Some rr ->
++ if rr != r2 ||
++ r.range_end < r2.range_begin ||
++ r2.range_nuploading > 0 then false
++ else begin
++ r.range_end <- r2.range_end;
++ r.range_next <- r2.range_next;
++ (match r.range_next with
++ | None -> ()
++ | Some r3 ->
++ r3.range_prev <- Some r);
++ true
++ end in
++
+ remove_completed_uploader_ranges up;
let b =
match up.up_block with
- None -> raise Not_found
-+ | None -> raise Not_found
++ | None ->
++ if debug_all then
++ lprintf_nl "find_range: uploader had no block selected";
++ raise Not_found
| Some b -> b
in
- let r = b.block_ranges in
@@ -2994,48 +3396,75 @@
| FileAborted _
- | FileCancelled -> raise Not_found
- | _ ->
--
-- let rec iter limit r =
--
--(* let use a very stupid heuristics: ask for the first non-used range.
--we thus might put a lot of clients on the same range !
--*)
+ | FileCancelled
+ | FileShared
+ | FileNew
+ | FileDownloaded ->
++ lprintf_nl "find_range: file in bad state";
+ raise Not_found
+ | FileDownloading
+ | FileQueued ->
-+ (* pick the first correct range with fewest uploaders *)
-+ let best_range =
-+ let rec iter acc r =
-+ let better_found =
-+ if in_uploader_ranges r up.up_ranges ||
-+ r.range_begin = r.range_end ||
-+ r.range_begin < up.up_block_begin ||
-+ r.range_end > up.up_block_end then
-+ false
++ if debug_all then
++ lprintf_nl "find_range: is there a range of size %Ld in [%Ld-%Ld] for %d ?"
++ range_size up.up_block_begin up.up_block_end (client_num up.up_client);
++ let correct_range r =
++ not (in_uploader_ranges r up.up_ranges) &&
++ (* r.range_begin < r.range_end && *)
++ r.range_begin >= up.up_block_begin
++ (* && r.range_end <= up.up_block_end *) in
++ (* pick the first correct cluster with fewest uploaders
++ We're not trying to get a range that's at least as big as
++ [range_size] bytes - that would prevent partially downloaded
++ ranges from being completed first *)
++ let rec iter acc r =
++ let best_cluster =
++ if not (correct_range r) then acc
++ else
++ (* find if they're ranges to merge ahead *)
++ let rec iter_cluster r cluster =
++ if debug_all then
++ lprintf_nl "[%Ld-%Ld] " r.range_begin r.range_end;
++ let cluster = { cluster with
++ cluster_ranges = r :: cluster.cluster_ranges;
++ cluster_size = cluster.cluster_size ++
++ (r.range_end -- r.range_begin)
++ } in
++ if not allow_merge_ranges ||
++ cluster.cluster_size >= range_size then cluster
++ else
++ match r.range_next with
++ | None -> cluster
++ | Some rr ->
++ if rr.range_begin = r.range_end &&
++ correct_range rr && rr.range_nuploading = 0 then
++ iter_cluster rr cluster
++ else cluster in
+
+- let rec iter limit r =
++ let cluster =
++ iter_cluster r { dummy_ranges_cluster with
++ cluster_nuploading = r.range_nuploading } in
++ if debug_all then
++ lprint_newline ();
++ if acc.cluster_ranges = [] then cluster
+ else
-+ match acc with
-+ | None -> true
-+ | Some best_range ->
-+ best_range.range_nuploading > r.range_nuploading in
-+ (* fast exit, and why I didn't use an iterator :/ *)
-+ if better_found && r.range_nuploading = 0 then Some r
-+ else
-+ let acc = if better_found then Some r else acc in
-+ match r.range_next with
-+ | None -> acc
-+ | Some rr -> iter acc rr in
-+ iter None b.block_ranges in
-+ match best_range with
-+ | None -> raise Not_found
-+ | Some r ->
-+ let key = r.range_begin, r.range_end, r in
-+ up.up_ranges <- up.up_ranges @ [key];
-+ r.range_nuploading <- r.range_nuploading + 1;
-+ key
++ (* find a range with as few uploaders as possible *)
++ let cmp = compare acc.cluster_nuploading
++ cluster.cluster_nuploading in
++ if cmp < 0 then acc
++ else cluster in
+
+-(* let use a very stupid heuristics: ask for the first non-used range.
+-we thus might put a lot of clients on the same range !
+-*)
++ (* fast exit, and why I didn't use an iterator :/
++ Could have used an exception, but I don't like that ;) *)
++ if best_cluster.cluster_ranges <> [] &&
++ best_cluster.cluster_nuploading = 0 then best_cluster
++ else
++ match r.range_next with
++ | None -> best_cluster
++ | Some rr -> iter best_cluster rr in
- if not (in_uploader_ranges r up.up_ranges) &&
- r.range_current_begin < r.range_end &&
@@ -3060,32 +3489,55 @@
- with Not_found ->
-(* force maximal uploading otherwise to finish it *)
- iter max_int r
-+(** range accessor(s) *)
++ let best_cluster = iter dummy_ranges_cluster b.block_ranges in
++ match List.rev best_cluster.cluster_ranges with
++ | [] ->
++ if debug_all then
++ lprintf_nl "find_range: no correct range found!";
++ raise Not_found
++ | r :: q ->
++ if not (List.for_all (merge_ranges r) q) then
++ lprintf_nl "find_range: ranges did not merge as well as planned";
++ split_range r (min (r.range_begin ++ range_size)
++ up.up_block_end);
++ if debug_all then begin
++ lprintf "=> [%Ld-%Ld], left:" r.range_begin r.range_end;
++ iter_block_ranges (fun r ->
++ lprintf " [%Ld-%Ld]" r.range_begin r.range_end
++ ) b;
++ lprint_newline ();
++ end;
++ let key = r.range_begin, r.range_end, r in
++ up.up_ranges <- up.up_ranges @ [key];
++ r.range_nuploading <- r.range_nuploading + 1;
++ key
-(*************************************************************************)
-(* *)
-(* range_range *)
-(* *)
-(*************************************************************************)
-+let range_range r = (r.range_begin, r.range_end)
++(** range accessor(s) *)
-let range_range r = (r.range_current_begin, r.range_end)
-+(** Data has been received from uploader [up]. Transfer data to file
-+ and update uploader ranges.
-+ Data = String.sub [str] [string_begin] [string_len] *)
++let range_range r = (r.range_begin, r.range_end)
-(*************************************************************************)
-(* *)
-(* received *)
-(* *)
-(*************************************************************************)
++(** Data has been received from uploader [up]. Transfer data to file
++ and update uploader ranges.
++ Data = String.sub [str] [string_begin] [string_len] *)
+
+-let received (up : uploader) (file_begin : Int64.t)
+- (str:string) (string_begin:int) (string_len:int) =
+let received up file_begin str string_begin string_len =
+ assert (string_begin >= 0);
+ assert (string_len >= 0);
+ assert (string_begin + string_len <= String.length str);
-
--let received (up : uploader) (file_begin : Int64.t)
-- (str:string) (string_begin:int) (string_len:int) =
++
+(*
+ let debug_bad_write r string_pos =
+ if !verbose then begin
@@ -3393,34 +3845,300 @@
(*************************************************************************)
(* *)
-@@ -2550,7 +2285,7 @@
- sw := (t, i, pos) :: !sw;
- iter (i+1) len (pos ++ bsize) bsize size
- in
+@@ -2503,223 +2513,96 @@
+ (* *)
+ (*************************************************************************)
+
+-let propagate_chunk t1 ts pos1 size =
++type chunk_occurrence = t * int * Int64.t (* frontend, chunk number, offset *)
+
+- (*
+- List.iter (fun (t2, i2, pos2) ->
++type chunk_occurrences = {
++ mutable occurrence_present : chunk_occurrence list;
++ mutable occurrence_missing : chunk_occurrence list;
++}
++
++let propagate_chunk t1 pos1 size destinations =
++ List.iter (fun (t2, j2, pos2) ->
++ if t1 != t2 || pos1 <> pos2 then begin
+ lprintf "Should propagate chunk from %s %Ld to %s %Ld [%Ld]\n"
+ (file_best_name t1.t_file) pos1
+ (file_best_name t2.t_file) pos2 size;
+ Unix32.copy_chunk (file_fd t1.t_file) (file_fd t2.t_file)
+ pos1 pos2 (Int64.to_int size);
++ set_frontend_bitmap_2 t2 j2
++ end
++ ) destinations
+
+- set_toverify_block t2 i2;
+- set_verified_block t2 i2;
+- ) ts
+-*)
+- ()
+-
+-(*************************************************************************)
+-(* *)
+-(* duplicate_chunks *)
+-(* *)
+-(*************************************************************************)
+-
+-(* This is the least aggressive version. I was thinking of computing
+-checksums for all possible schemas for all files, to be able to
+-move chunks from/to BT files from/to ED2k files. *)
++let dummy_chunk_occurrences () =
++ { occurrence_present = []; occurrence_missing = [] }
+
+ let duplicate_chunks () =
+- (*
+ let chunks = Hashtbl.create 100 in
+- HS.iter (fun t ->
+- let rec iter i len pos bsize size =
+- if i < len then
+- let c = {
+- chunk_uid = t.t_checksums.(i);
+- chunk_size = min (size -- pos) bsize;
+- } in
+- let (has, has_not) = try
+- Hashtbl.find chunks c
+- with _ ->
+- let sw = (ref [], ref []) in
+- Hashtbl.add chunks c sw;
+- sw
+- in
+- let sw = if t.t_verified_bitmap.[i] = '3' then has else has_not in
+- sw := (t, i, pos) :: !sw;
+- iter (i+1) len (pos ++ bsize) bsize size
+- in
- iter 0 (Array.length t.t_checksums) zero t.t_block_size t.t_size
-+ iter 0 (Array.length t.t_checksums) zero t.t_chunk_size t.t_size
- ) swarmers_by_num;
- Hashtbl.iter (fun c (has, has_not) ->
- match !has, !has_not with
-@@ -2600,7 +2335,7 @@
- match bitmap.[i] with
- | '2' ->
- if t.t_converted_verified_bitmap.[i] < '2' then begin
+- ) swarmers_by_num;
+- Hashtbl.iter (fun c (has, has_not) ->
+- match !has, !has_not with
+- _ , []
+- | [], _ -> ()
+- | (t, _, pos) :: _, ts ->
+- propagate_chunk t ts pos c.chunk_size
++ HS.iter (fun s ->
++ List.iter (fun t ->
++ let nchunks = String.length t.t_converted_verified_bitmap in
++ match t.t_verifier with
++ | Verification uids when Array.length uids = nchunks ->
++ let rec iter j len pos =
++ if j < len then
++ let c = {
++ chunk_uid = uids.(j);
++ chunk_size = min (s.s_size -- pos) t.t_chunk_size;
++ } in
++ let occurrences =
++ try
++ Hashtbl.find chunks c
++ with Not_found ->
++ let occurrences = dummy_chunk_occurrences () in
++ Hashtbl.add chunks c occurrences;
++ occurrences in
++ if t.t_converted_verified_bitmap.[j] = '3' then
++ occurrences.occurrence_present <-
++ (t, j, pos) :: occurrences.occurrence_present
++ else
++ occurrences.occurrence_missing <-
++ (t, j, pos) :: occurrences.occurrence_missing;
++ iter (j+1) len (pos ++ t.t_chunk_size)
++ in
++ iter 0 (String.length t.t_converted_verified_bitmap) zero
++ | _ -> ()
++ ) s.s_networks
++ ) swarmers_by_name;
++ Hashtbl.iter (fun c occurrences ->
++ match occurrences.occurrence_present, occurrences.occurrence_missing with
++ | _ , []
++ | [], _ -> ()
++ | (t, _, pos) :: _, missing ->
++ propagate_chunk t pos c.chunk_size missing
+ ) chunks
+-*)
+- ()
+-
+-(*************************************************************************)
+-(* *)
+-(* set_checksums *)
+-(* *)
+-(*************************************************************************)
+-
+-
+-(* TODO: where is this used ? check that the fact of using the UID for
+- small files does not create any problem. *)
+-let get_checksums t =
+- match t.t_verifier with
+- Verification tab -> tab
+- | _ -> [||]
+-
+-
+-
+-(*************************************************************************)
+-(* *)
+-(* primary (internal) *)
+-(* *)
+-(*************************************************************************)
+-
+-let primary t = t.t_primary
+-
+-(*************************************************************************)
+-(* *)
+-(* set_verified_bitmap *)
+-(* *)
+-(*************************************************************************)
+-
+-let set_verified_bitmap primary t bitmap =
+-(* t.t_verified_bitmap <- bitmap; *)
+-
+- for i = 0 to String.length bitmap - 1 do
+-
+- match bitmap.[i] with
+- | '2' ->
+- if t.t_converted_verified_bitmap.[i] < '2' then begin
- t.t_ncomplete_blocks <- t.t_ncomplete_blocks + 1;
-+ t.t_ncomplete_chunks <- t.t_ncomplete_chunks + 1;
- t.t_converted_verified_bitmap.[i] <- '2'
- end
-
-@@ -2625,7 +2360,7 @@
- ()
- ) t.t_blocks_of_chunk.(i);
- if t.t_converted_verified_bitmap.[i] <> '3' then
+- t.t_converted_verified_bitmap.[i] <- '2'
+- end
+-
+- | '3' ->
+-(* lprintf "Setting 3 on %d\n" i; *)
+- t.t_converted_verified_bitmap.[i] <- '3';
+- if primary then
+- let s = t.t_s in
+- List.iter (fun i ->
+-(* lprintf "Should set %d\n" i; *)
+- match s.s_blocks.(i) with
+- CompleteBlock ->
+-(* lprintf "CompleteBlock\n"; *)
+- set_verified_block s i
+- | EmptyBlock | PartialBlock _ ->
+-(* lprintf "EmptyBlock/PartialBlock\n"; *)
+- set_completed_block None s i;
+-(* lprintf "set_verified_block\n"; *)
+- set_verified_block s i
+- | VerifiedBlock ->
+-(* lprintf "Block already verified\n" *)
+- ()
+- ) t.t_blocks_of_chunk.(i);
+- if t.t_converted_verified_bitmap.[i] <> '3' then
- lprintf_nl () "FIELD AS BEEN CLEARED"
-+ lprintf_nl "FIELD AS BEEN CLEARED"
- | _ -> ()
- done
+- | _ -> ()
+- done
+-
+-(*************************************************************************)
+-(* *)
+-(* verified_bitmap *)
+-(* *)
+-(*************************************************************************)
+
+-let verified_bitmap t = t.t_converted_verified_bitmap
+-
+-(*************************************************************************)
+-(* *)
+-(* set_verifier *)
+-(* *)
+-(*************************************************************************)
+
+ let set_verifier t f =
+ t.t_verifier <- f;
+-(* TODO: check that false as primary is a good value to start with *)
+- set_verified_bitmap false t t.t_converted_verified_bitmap
+-
+-(*************************************************************************)
+-(* *)
+-(* set_verifier *)
+-(* *)
+-(*************************************************************************)
++(* TODO: check that false as t_primary is a good value to start with *)
++ set_chunks_verified_bitmap t t.t_converted_verified_bitmap
+
+ let set_verified t f =
+ t.t_verified <- f
+
+-(*************************************************************************)
+-(* *)
+-(* downloaded *)
+-(* *)
+-(*************************************************************************)
+-
+ let downloaded t = file_downloaded t.t_file
-@@ -2746,7 +2481,7 @@
+-(*************************************************************************)
+-(* *)
+-(* block_block *)
+-(* *)
+-(*************************************************************************)
+-
+-let block_num t b =
+- let n = t.t_chunk_of_block.(b.block_num) in
+- n
+-
+-(*************************************************************************)
+-(* *)
+-(* partition_size *)
+-(* *)
+-(*************************************************************************)
++let block_chunk_num t b =
++ t.t_chunk_of_block.(b.block_num)
+
+ let partition_size t = String.length t.t_converted_verified_bitmap
+
+ let uploader_swarmer up = up.up_t
+
++(** Return the availability of the chunks of [t] as a string *)
+
+-(*************************************************************************)
+-(* *)
+-(* availability *)
+-(* *)
+-(*************************************************************************)
+-
+-let availability t =
+-
++let chunks_availability t =
+ let s = t.t_s in
+- let len = String.length t.t_converted_verified_bitmap in
+- let str = String.make len '\000' in
+- for i = 0 to len - 1 do
+- str.[i] <- char_of_int (
++ string_init (partition_size t) (fun i ->
++ char_of_int (
+ let v = List2.min
+- (List.map (fun i -> s.s_availability.(i)) t.t_blocks_of_chunk.(i)) in
++ (List.map (fun i -> s.s_availability.(i)) t.t_blocks_of_chunk.(i)) in
+ if v < 0 then 0 else
+- if v > 200 then 200 else v)
+- done;
+- str
+-
+-(*************************************************************************)
+-(* *)
+-(* is_interesting *)
+-(* *)
+-(*************************************************************************)
+-
+-(*return true if s is interesting for p1
+- NB: works when s is a mask of 0s(absent bloc) and 1s(present bloc)
+- p1 can be a string 0(absent) 1(partial) 2(present unverified) or
+- 3(present verified)
+- s : 00001111
+- p1 : 01230123
+- is_interesting : 00001110
+-*)
++ if v > 200 then 200 else v))
+
+ let is_interesting up =
+ up.up_ncomplete > 0 || up.up_npartial > 0
+@@ -2733,7 +2616,7 @@
+
+ let value_to_int64_pair v =
+ match v with
+- List [v1;v2] | SmallList [v1;v2] ->
++ | List [v1;v2] | SmallList [v1;v2] ->
+ (value_to_int64 v1, value_to_int64 v2)
+ | _ ->
+ failwith "Options: Not an int32 pair"
+@@ -2746,33 +2629,53 @@
let set_present t = set_present t.t_s
let set_absent t = set_absent t.t_s
@@ -3429,96 +4147,308 @@
let print_t str t = print_s str t.t_s
let print_uploaders t = print_uploaders t.t_s
-@@ -2794,7 +2529,7 @@
- (get_value "file_all_chunks" value_to_string)
+ (*************************************************************************)
+ (* *)
+-(* value_to_swarmer *)
++(* value_to_frontend *)
+ (* *)
+ (*************************************************************************)
+
+-let value_to_swarmer t assocs =
+- let get_value name conv = conv (List.assoc name assocs) in
++let value_to_frontend t assocs =
++
++ let debug_wrong_downloaded t present d =
++ lprintf_nl "ERROR: stored downloaded value not restored !!! (%Ld/%Ld)" (downloaded t) d;
++ lprintf_nl "ERROR: present:";
++ List.iter (fun (x,y) ->
++ lprintf_nl " (%Ld,%Ld);" x y
++ ) present;
++
++ let p = present_intervals t in
++ lprintf_nl "ERROR: present now:";
++
++ let total =
++ List.fold_left (fun acc (x,y) ->
++ lprintf_nl " (%Ld,%Ld);" x y;
++ acc ++ (y -- x)
++ ) zero p in
++
++ lprintf_nl "ERROR: total %Ld" total;
++ if p = present then begin
++ lprintf_nl "ERROR: both appear to be the same!";
++ end;
++ if !exit_on_error then exit 2 in
+
++ let get_value name conv = conv (List.assoc name assocs) in
- with e ->
+ let primary =
+- try get_value "file_primary" value_to_bool with _ -> true
+- in
++ try get_value "file_primary" value_to_bool with _ -> true in
+
+ (try
+- let file_name = get_value "file_swarmer" value_to_string in
+- let s =
+- HS.find swarmers_by_name { dummy_swarmer with s_filename = file_name }
+- in
+- associate primary t s;
+-(* TODO: make as many checks as possible to ensure the file and the swarmers
+- are correctly associed. *)
+- with Not_found -> ());
++ let file_name = get_value "file_swarmer" value_to_string in
++ let s = HS.find swarmers_by_name
++ { dummy_swarmer with s_filename = file_name } in
++ associate primary t s
++ (* TODO: make as many checks as possible to ensure the file and the swarmers
++ are correctly associed. *)
++ with Not_found -> ());
+
+ let _ =
+ let mtime = try file_mtime t.t_file with _ -> 0. in
+@@ -2783,19 +2686,20 @@
+ in
+ old_mtime = mtime
+ in
+-(* TODO: if set_bitmap is false, we should the bitmap to 2222222222 so that
+-it is verified as soon as possible. *)
++
+ (try
+- try
+- set_verified_bitmap primary t
+- (get_value "file_chunks" value_to_string)
+- with Not_found ->
+- set_verified_bitmap primary t
+- (get_value "file_all_chunks" value_to_string)
+-
+- with e ->
- lprintf_nl () "Exception %s while loading bitmap"
-+ lprintf_nl "Exception %s while loading bitmap"
- (Printexc2.to_string e);
+- (Printexc2.to_string e);
++ try
++ set_chunks_verified_bitmap t
++ (get_value "file_chunks" value_to_string)
++ with Not_found ->
++ set_chunks_verified_bitmap t
++ (get_value "file_all_chunks" value_to_string)
++
++ with e ->
++ lprintf_nl "Exception %s while loading bitmap"
++ (Printexc2.to_string e);
++ (* force everything to be checked ASAP ? *)
++ set_chunks_verified_bitmap t (String.make (partition_size t) '2')
);
-@@ -2804,7 +2539,7 @@
+ (*
+@@ -2804,61 +2708,28 @@
*)
if primary then begin
- if !verbose_swarming then lprintf_nl () "Loading present...";
-+ if !verbose_swarming then lprintf_nl "Loading present...";
- let present = try
- let present =
- (get_value "file_present_chunks"
-@@ -2813,46 +2548,46 @@
- set_present t present;
- present
- with e ->
+- let present = try
+- let present =
+- (get_value "file_present_chunks"
+- (value_to_list value_to_int64_pair))
+- in
+- set_present t present;
+- present
+- with e ->
- lprintf_nl () "Exception %s while set present"
-+ lprintf_nl "Exception %s while set present"
- (Printexc2.to_string e);
- []
+- (Printexc2.to_string e);
+- []
++ if !verbose_swarming then lprintf_nl "Loading present...";
++ let present = try
++ let present =
++ (get_value "file_present_chunks"
++ (value_to_list value_to_int64_pair))
in
- if !verbose_swarming then lprintf_nl () "Downloaded after present %Ld" (downloaded t);
-+ if !verbose_swarming then lprintf_nl "Downloaded after present %Ld" (downloaded t);
-
- (*
+-
+-(*
- if !verbose then lprintf_nl () "Loading absent...";
-+ if !verbose then lprintf_nl "Loading absent...";
- (try
- set_absent t
- (get_value "file_absent_chunks"
- (value_to_list value_to_int64_pair));
- with e ->
+- (try
+- set_absent t
+- (get_value "file_absent_chunks"
+- (value_to_list value_to_int64_pair));
+- with e ->
- if !verbose_hidden_errors then lprintf_nl () "Exception %s while set absent"
-+ if !verbose_hidden_errors then lprintf_nl "Exception %s while set absent"
- (Printexc2.to_string e);
- );
+- (Printexc2.to_string e);
+- );
- if !verbose then lprintf_nl () "Downloaded after absent %Ld" (downloaded t);
-+ if !verbose then lprintf_nl "Downloaded after absent %Ld" (downloaded t);
- *)
- (try
- let d = get_value "file_downloaded" value_to_int64 in
-
- if d <> downloaded t && !verbose then begin
+-*)
+- (try
+- let d = get_value "file_downloaded" value_to_int64 in
+-
+- if d <> downloaded t && !verbose then begin
- lprintf_nl () "ERROR: stored downloaded value not restored !!! (%Ld/%Ld)" (downloaded t) d;
- lprintf_nl () "ERROR: present:";
-+ lprintf_nl "ERROR: stored downloaded value not restored !!! (%Ld/%Ld)" (downloaded t) d;
-+ lprintf_nl "ERROR: present:";
- List.iter (fun (x,y) ->
+- List.iter (fun (x,y) ->
- lprintf_nl () " (%Ld,%Ld);" x y
-+ lprintf_nl " (%Ld,%Ld);" x y
- ) present;
-
+- ) present;
+-
- let p = present_chunks t in
- lprintf_nl () "ERROR: present now:";
-+ let p = present_intervals t in
-+ lprintf_nl "ERROR: present now:";
-
- let total = ref zero in
- List.iter (fun (x,y) ->
+-
+- let total = ref zero in
+- List.iter (fun (x,y) ->
- lprintf_nl () " (%Ld,%Ld);" x y;
-+ lprintf_nl " (%Ld,%Ld);" x y;
- total := !total ++ (y -- x);
- ) p;
-
+- total := !total ++ (y -- x);
+- ) p;
+-
- lprintf_nl () "ERROR: total %Ld" !total;
-+ lprintf_nl "ERROR: total %Ld" !total;
- if p = present then begin
+- if p = present then begin
- lprintf_nl () "ERROR: both appear to be the same!";
-+ lprintf_nl "ERROR: both appear to be the same!";
- end;
- if !exit_on_error then exit 2
- end
-@@ -2893,7 +2628,7 @@
- ("file_present_chunks", List
+- end;
+- if !exit_on_error then exit 2
+- end
++ set_present t present;
++ present
++ with e ->
++ lprintf_nl "Exception %s while set present"
++ (Printexc2.to_string e);
++ verify_all_chunks t;
++ []
++ in
++ if !verbose_swarming then lprintf_nl "Downloaded after present %Ld" (downloaded t);
+
+- with e -> ());
+- end;
++ (try
++ let d = get_value "file_downloaded" value_to_int64 in
++ if d <> downloaded t && !verbose then
++ debug_wrong_downloaded t present d
++ with Not_found -> ());
++ end;
+
+ (* TODO re-implement this
+ (try
+@@ -2872,122 +2743,102 @@
+
+ (*************************************************************************)
+ (* *)
+-(* set_verified_bitmap *)
+-(* *)
+-(*************************************************************************)
+-
+-let set_verified_bitmap t bitmap =
+- set_verified_bitmap (primary t) t bitmap
+-
+-(*************************************************************************)
+-(* *)
+-(* swarmer_to_value *)
++(* frontend_to_value *)
+ (* *)
+ (*************************************************************************)
+
+-let swarmer_to_value t other_vals =
+- ("file_primary", bool_to_value (primary t)) ::
+- ("file_swarmer", string_to_value t.t_s.s_filename) ::
+- ("file_mtime", float_to_value (try file_mtime t.t_file with _ -> 0.)) ::
+- ("file_chunks", string_to_value (verified_bitmap t)) ::
+- ("file_present_chunks", List
++let frontend_to_value t other_vals =
++ [("file_primary", bool_to_value t.t_primary);
++ ("file_swarmer", string_to_value t.t_s.s_filename);
++ ("file_mtime", float_to_value (try file_mtime t.t_file with _ -> 0.));
++ ("file_chunks", string_to_value (chunks_verified_bitmap t))] @
++ (if t.t_primary then
++ [("file_present_chunks", List
(List.map (fun (i1,i2) ->
- SmallList [int64_to_value i1; int64_to_value i2])
+- SmallList [int64_to_value i1; int64_to_value i2])
- (present_chunks t))) ::
-+ (present_intervals t))) ::
- ("file_downloaded", int64_to_value (downloaded t)) ::
+- ("file_downloaded", int64_to_value (downloaded t)) ::
+-
+- ("file_chunks_age", List (Array.to_list
+- (Array.map int_to_value t.t_last_seen))) ::
+-
++ SmallList [int64_to_value i1; int64_to_value i2])
++ (present_intervals t)))]
++ else []) @
++ [("file_downloaded", int64_to_value (downloaded t));
++ ("file_chunks_age", List (Array.to_list
++ (Array.map int_to_value t.t_last_seen)))] @
+ other_vals
+
+-(*************************************************************************)
+-(* *)
+-(* verify_one_chunk *)
+-(* *)
+-(*************************************************************************)
++(** Verify one chunk of swarmer [s], if any frontend of that swarmer
++ has a chunk to verify *)
+
+ let verify_one_chunk s =
+-(* lprintf "verify_one_chunk: %d networks\n" (List.length s.s_networks); *)
+- List.iter (fun t ->
++ (* lprintf "verify_one_chunk: %d networks\n" (List.length s.s_networks); *)
++ List.exists (fun t ->
+ (* lprintf "verify_one_chunk of file %d\n" (file_num t.t_file); *)
+- let bitmap = t.t_converted_verified_bitmap in
+- for i = 0 to String.length bitmap - 1 do
+- if bitmap.[i] = '2' then begin
+-(* lprintf " verifying...\n"; *)
+- verify_chunk t i;
+- raise Exit
+- end
+- done
+- ) s.s_networks;
++ string_existsi (fun i c ->
++ if c = '2' then verify_chunk t i;
++ c = '2') t.t_converted_verified_bitmap
++ ) s.s_networks
+ (* lprintf "verify_one_chunk: nothing done\n"; *)
+- ()
+
+-(*************************************************************************)
+-(* *)
+-(* verify_some_chunks *)
+-(* *)
+-(*************************************************************************)
++(** Verify one chunk of each swarmer that needs it *)
+
+ let verify_some_chunks () =
+ HS.iter (fun s ->
+- try
+- verify_one_chunk s
+- with _ -> ()) swarmers_by_name
++ try
++ ignore(verify_one_chunk s)
++ with _ -> ()
++ ) swarmers_by_name
+
+-(*************************************************************************)
+-(* *)
+-(* verify_one_chunk *)
+-(* *)
+-(*************************************************************************)
++(** Verify one chunk of the swarmer associated with [t], if needed *)
- ("file_chunks_age", List (Array.to_list
-@@ -2955,27 +2690,28 @@
- let s1 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f1 } in
- let s2 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f2 } in
+ let verify_one_chunk t =
+- verify_one_chunk t.t_s
++ ignore(verify_one_chunk t.t_s)
+
+-(*************************************************************************)
+-(* *)
+-(* merge *)
+-(* *)
+-(*************************************************************************)
++(** Merge a second frontend [f2] to a first one [f1], so they share
++ the same swarmer.
++
++ First swarmer [f1] must support some hashing scheme.
++ Data of the second swarmer [f2] is currently lost during merging, so
++ you'd better merge in swarmers quickly.
++ Merging is denied if any of the two frontends is being used, so it
++ may be necessary to pause them first, to get rid of any downloads.
++*)
+
+ let merge f1 f2 =
+
+- let s1 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f1 } in
+- let s2 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f2 } in
++ let s1 = HS.find swarmers_by_name { dummy_swarmer with
++ s_filename = file_disk_name f1 } in
++ let s2 = HS.find swarmers_by_name { dummy_swarmer with
++ s_filename = file_disk_name f2 } in
- if s1 == s2 then
+ if s1.s_filename = s2.s_filename then
@@ -3551,9 +4481,42 @@
+ | Verification _ | ForceVerification -> t1
in
- begin
-@@ -3012,7 +2748,7 @@
- None -> ()
+- begin
+- List.iter (fun (s, filename) ->
+- for i = 0 to Array.length s.s_nuploading - 1 do
+- if s.s_nuploading.(i) > 0 then
+- failwith (Printf.sprintf "%s is currently being downloaded" filename)
+- done
+- ) [
+- s1, "First file";
+- s2, "Second file" ];
+- end;
++ List.iter (fun (s, filename) ->
++ Array.iteri (fun i nuploading ->
++ if nuploading > 0 then
++ failwith (Printf.sprintf "%s is currently being downloaded" filename)
++ ) s.s_nuploading
++ ) [
++ s1, "First file";
++ s2, "Second file"];
+
+ (* replace T2 swarmer *)
+ associate false t2 t1.t_s
+@@ -2999,7 +2850,7 @@
+ (*************************************************************************)
+
+ let has_secondaries t =
+- primary t && List.length t.t_s.s_networks > 1
++ t.t_primary && List.length t.t_s.s_networks > 1
+
+ (*************************************************************************)
+ (* *)
+@@ -3009,10 +2860,10 @@
+
+ let remove_swarmer file_swarmer =
+ match file_swarmer with
+- None -> ()
++ | None -> ()
| Some sw -> if not (has_secondaries sw)
then HS.remove swarmers_by_name sw.t_s
- else lprintf_nl () "Tried to remove swarmer with secondaries"
@@ -3561,7 +4524,12 @@
(*************************************************************************)
(* *)
-@@ -3037,7 +2773,7 @@
+@@ -3033,11 +2884,11 @@
+
+ let value_to_swarmer v =
+ match v with
+- Module assocs ->
++ | Module assocs ->
let get_value name conv = conv (List.assoc name assocs) in
let file_size = get_value "file_size" value_to_int64 in
let file_name = get_value "file_name" value_to_string in
@@ -3570,7 +4538,7 @@
let block_sizes = get_value "file_chunk_sizes"
(value_to_list value_to_int64) in
List.iter (fun bsize ->
-@@ -3053,7 +2789,7 @@
+@@ -3053,7 +2904,7 @@
("file_name", string_to_value s.s_filename);
("file_bitmap", string_to_value s.s_verified_bitmap);
("file_chunk_sizes", list_to_value int64_to_value
@@ -3579,7 +4547,126 @@
]
let t =
-@@ -3189,9 +2925,8 @@
+@@ -3061,55 +2912,49 @@
+
+ end
+
+-(*************************************************************************)
+-(* *)
+-(* check_swarmer *)
+-(* *)
+-(*************************************************************************)
++(** Checks most variants of a swarmer, nobably verification bitmaps
++ consistency; Raise an exception if a problem is found *)
+
+ let check_swarmer s =
+ try
+ match s.s_networks with
+- [] -> ()
+- | t :: tail ->
+- assert t.t_primary;
++ | [] -> assert false
++ | tprim :: tail ->
++ assert(tprim.t_primary);
+
+- for i = 0 to t.t_nchunks - 1 do
+- List.iter (fun j ->
+- if t.t_converted_verified_bitmap.[i] = '3' then begin
+- if s.s_verified_bitmap.[j] <> '3' then
+- failwith "Bad propagation of 3 from primary to main";
+- end
+- else
+- if s.s_verified_bitmap.[j] = '3' then begin
+- failwith "Main has 3 not coming from primary";
+- end
+- ) t.t_blocks_of_chunk.(i)
+- done;
++ string_iter (fun i c ->
++ if c = '3' then begin
++ if List.exists (fun j -> s.s_verified_bitmap.[j] <> '3')
++ tprim.t_blocks_of_chunk.(i) then
++ failwith "Bad propagation of 3 from primary to swarmer";
++ end
++ else if List.exists (fun j -> s.s_verified_bitmap.[j] = '3')
++ tprim.t_blocks_of_chunk.(i) then
++ failwith "Swarmer has 3 not coming from primary";
++ ) tprim.t_converted_verified_bitmap;
+
+- let fd = file_fd t.t_file in
++ let fd = file_fd tprim.t_file in
+
+ List.iter (fun t ->
+- assert (not t.t_primary);
+- assert (file_fd t.t_file == fd);
+-
+- for i = 0 to t.t_nchunks - 1 do
+- List.iter (fun j ->
+- if t.t_converted_verified_bitmap.[i] = '3' then begin
+- if s.s_verified_bitmap.[j] <> '3' then
+- failwith "3 in secondary without 3 in primary";
+- end
+- else
+- if t.t_converted_verified_bitmap.[i] = '2' then begin
+- if s.s_verified_bitmap.[j] <> '3' then
+- failwith "2 in secondary without 3 in primary";
+- end
+- ) t.t_blocks_of_chunk.(i)
+- done;
++ assert (not t.t_primary);
++ assert (file_fd t.t_file == fd);
++
++ string_iter (fun i c ->
++ if c = '3' then begin
++ if List.exists (fun j -> s.s_verified_bitmap.[j] <> '3')
++ t.t_blocks_of_chunk.(i) then
++ failwith "3 in secondary without 3 in primary"
++ end
++ else if c = '2' then begin
++ if List.exists (fun j -> s.s_verified_bitmap.[j] <> '3')
++ t.t_blocks_of_chunk.(i) then
++ failwith "2 in secondary without 3 in primary"
++ end
++ ) t.t_converted_verified_bitmap
+ ) tail
+ with e ->
+- print_s "ERROR" s;
+- raise e
++ print_s "ERROR" s;
++ raise e
+
+ (*************************************************************************)
+ (* *)
+@@ -3130,19 +2975,18 @@
+ let _ =
+ set_after_save_hook files_ini (fun _ -> swarmers =:= []);
+ set_before_save_hook files_ini (fun _ ->
+- let list = ref [] in
+- HS.iter (fun s ->
+- if s.s_networks <> [] then
+- list := s :: !list) swarmers_by_name;
+- swarmers =:= !list
++ let list = ref [] in
++ HS.iter (fun s ->
++ if s.s_networks <> [] then
++ list := s :: !list) swarmers_by_name;
++ swarmers =:= !list
+ );
+ set_after_load_hook files_ini (fun _ ->
+- List.iter (fun s ->
+- check_swarmer s;
+- ) !!swarmers;
+-
+- swarmers =:= [])
+-
++ List.iter (fun s ->
++ check_swarmer s;
++ ) !!swarmers;
++ swarmers =:= []
++ )
+
+ (*************************************************************************)
+ (* *)
+@@ -3189,9 +3033,8 @@
Array.length up.up_complete_blocks * 4 +
List.length up.up_ranges * (12 + 16 + 12 + 12 + 4) +
Array.length up.up_partial_blocks * (16 + 12 + 12) +
@@ -3591,12 +4678,24 @@
| AvailableBitv b -> let ws = Sys.word_size in (ws/8) + ((ws / 8) * (Bitv.length b / (ws - 2)))
) ;
incr counter;
-@@ -3211,7 +2946,7 @@
- if bitmap.[i] <> '3' then raise Not_found;
- done;
- if file_size file <> downloaded t then
+@@ -3199,20 +3042,3 @@
+ Printf.bprintf buf " Uploaders: %d\n" !counter;
+ Printf.bprintf buf " Storage: %d bytes\n" !storage;
+ )
+-
+-let check_finished t =
+- try
+- let file = t.t_file in
+- match file_state file with
+- FileCancelled | FileShared | FileDownloaded -> false
+- | _ ->
+- let bitmap = verified_bitmap t in
+- for i = 0 to String.length bitmap - 1 do
+- if bitmap.[i] <> '3' then raise Not_found;
+- done;
+- if file_size file <> downloaded t then
- lprintf_nl () "Downloaded size differs after complete verification";
-+ lprintf_nl "Downloaded size differs after complete verification";
- true
- with _ -> false
-
+- true
+- with _ -> false
+-
+-
diff --git a/net-p2p/mldonkey-devel/files/patch-src__daemon__driver__driverMain.ml b/net-p2p/mldonkey-devel/files/patch-src__daemon__driver__driverMain.ml
new file mode 100644
index 0000000..0e822cf
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__daemon__driver__driverMain.ml
@@ -0,0 +1,13 @@
+--- ./src/daemon/driver/driverMain.ml.orig Sat Apr 8 21:26:40 2006
++++ ./src/daemon/driver/driverMain.ml Mon May 15 13:03:12 2006
+@@ -74,8 +74,8 @@
+ CommonInteractive.force_download_quotas ();
+ CommonResult.dummy_result.result_time <- last_time ();
+ (try
+- CommonSwarming.verify_some_chunks ()
+- with _ -> ());
++ CommonSwarming.verify_some_chunks ()
++ with _ -> ());
+ CommonClient.clear_upload_slots ()
+
+ let hourly_timer timer =
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTClients.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTClients.ml
index 32d17df..c23cc77 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTClients.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTClients.ml
@@ -1,5 +1,14 @@
--- ./src/networks/bittorrent/bTClients.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/bittorrent/bTClients.ml Sun May 7 06:39:10 2006
++++ ./src/networks/bittorrent/bTClients.ml Mon May 15 13:03:12 2006
+@@ -401,7 +401,7 @@
+ (* This must be a seeded file... *)
+ String.make (Array.length c.client_file.file_chunks) '3'
+ | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer
++ CommonSwarming.chunks_verified_bitmap swarmer
+ in
+
+ if !verbose_download then lprintf_nl () "Sending verified bitmap: [%s]" bitmap;
@@ -561,7 +561,7 @@
match c.client_uploader with
None ->
@@ -18,3 +27,39 @@
end
+@@ -691,7 +691,7 @@
+ c.client_range_waiting <- None;
+ (x,y,r)
+ | None ->
+- CommonSwarming.find_range up
++ CommonSwarming.find_range up (min max_range_len file.file_piece_size)
+ in
+
+ let (x,y,r) =
+@@ -706,7 +706,7 @@
+ c.client_ranges_sent <- c.client_ranges_sent @ [x,y, r];
+ (* CommonSwarming.alloc_range r; *)
+
+- let num = CommonSwarming.block_num swarmer b in
++ let num = CommonSwarming.block_chunk_num swarmer b in
+
+ if !verbose_swarming then
+ lprintf_nl () "Asking %d For Range %Ld-%Ld" num x y;
+@@ -917,7 +917,7 @@
+ disconnect_client c (Closed_for_error "Wrong bitfield length")
+ end else begin
+
+- let verified = CommonSwarming.verified_bitmap swarmer in
++ let verified = CommonSwarming.chunks_verified_bitmap swarmer in
+
+ for i = 0 to npieces - 1 do
+ if is_bit_set p i then begin
+@@ -952,7 +952,7 @@
+ None -> ()
+ | Some swarmer ->
+ let n = Int64.to_int n in
+- let verified = CommonSwarming.verified_bitmap swarmer in
++ let verified = CommonSwarming.chunks_verified_bitmap swarmer in
+ (* lprintf_nl "verified: %c;" verified.[n]; *)
+ (* if the peer has a chunk we don't, tell him we're interested and update his bitmap *)
+ if verified.[n] < '2' then begin
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTComplexOptions.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTComplexOptions.ml
new file mode 100644
index 0000000..787a315
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTComplexOptions.ml
@@ -0,0 +1,20 @@
+--- ./src/networks/bittorrent/bTComplexOptions.ml.orig Sat Apr 8 21:26:40 2006
++++ ./src/networks/bittorrent/bTComplexOptions.ml Mon May 15 13:03:12 2006
+@@ -210,7 +210,7 @@
+ (match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- CommonSwarming.value_to_swarmer swarmer assocs;
++ CommonSwarming.value_to_frontend swarmer assocs;
+ );
+
+ (*
+@@ -262,7 +262,7 @@
+ match file.file_swarmer with
+ None -> assocs
+ | Some swarmer ->
+- CommonSwarming.swarmer_to_value swarmer assocs
++ CommonSwarming.frontend_to_value swarmer assocs
+ with
+ e ->
+ lprintf_nl () "exception %s in file_to_value"
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTGlobals.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTGlobals.ml
index ea6fd3a..9ba6327 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTGlobals.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTGlobals.ml
@@ -1,5 +1,18 @@
--- ./src/networks/bittorrent/bTGlobals.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/bittorrent/bTGlobals.ml Sun May 7 06:39:10 2006
++++ ./src/networks/bittorrent/bTGlobals.ml Mon May 15 13:03:12 2006
+@@ -150,9 +150,9 @@
+ (match c.client_block with
+ None -> true
+ | Some b ->
+- let block_num = CommonSwarming.block_num swarmer b in
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
+- bitmap.[block_num] <> '3')
++ let chunk_num = CommonSwarming.block_chunk_num swarmer b in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
++ bitmap.[chunk_num] <> '3')
+ in
+ if must_send then
+ begin
@@ -252,8 +252,7 @@
else
set_trackers file [t.torrent_announce];
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTInteractive.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTInteractive.ml
index 042bd25..4248b54 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTInteractive.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__bittorrent__bTInteractive.ml
@@ -1,5 +1,14 @@
--- ./src/networks/bittorrent/bTInteractive.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/bittorrent/bTInteractive.ml Sun May 7 06:39:10 2006
++++ ./src/networks/bittorrent/bTInteractive.ml Mon May 15 13:03:12 2006
+@@ -279,7 +279,7 @@
+
+ let chunks = (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer) in
++ CommonSwarming.chunks_verified_bitmap swarmer) in
+
+ let header_list = [
+ ( "1", "srh br ac", "Client number", "Num" ) ;
@@ -372,7 +372,7 @@
None ->
lprintf_nl () "verify_chunks: no swarmer to verify chunks"
@@ -9,3 +18,17 @@
let remove_all_clients file =
Hashtbl.clear file.file_clients;
+@@ -408,11 +408,11 @@
+ P.file_names = [file.file_name, P.noips()];
+ P.file_chunks = (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer);
++ CommonSwarming.chunks_verified_bitmap swarmer);
+ P.file_availability =
+ [network.network_num,(match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.availability swarmer)];
++ CommonSwarming.chunks_availability swarmer)];
+
+ P.file_chunks_age = last_seen;
+ P.file_uids = [Uid.create (BTUrl file.file_id)];
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyClient.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyClient.ml
new file mode 100644
index 0000000..1731bd7
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyClient.ml
@@ -0,0 +1,38 @@
+--- ./src/networks/donkey/donkeyClient.ml.orig Sat Apr 8 21:26:40 2006
++++ ./src/networks/donkey/donkeyClient.ml Mon May 15 13:03:12 2006
+@@ -862,7 +862,7 @@
+ match file.file_swarmer with
+ None -> false
+ | Some swarmer ->
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
+ let rec iter bitmap chunks i len =
+ if i = len then false else
+ if Bitv.get chunks i && bitmap.[i] < '2' then true else
+@@ -879,7 +879,7 @@
+ match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- lprintf_nl () " %s" (CommonSwarming.verified_bitmap swarmer);
++ lprintf_nl () " %s" (CommonSwarming.chunks_verified_bitmap swarmer);
+ end;
+
+ let chunks =
+@@ -1946,7 +1946,7 @@
+ asume that we have all chunks! *)
+ Bitv.create file.file_nchunks true
+ | Some swarmer ->
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
+ Bitv.init (String.length bitmap)
+ (fun i -> bitmap.[i] = '3')
+ (* This is not very smart, as we might get banned for this request.
+@@ -2538,7 +2538,7 @@
+ match file.file_swarmer with
+ None -> None
+ | Some swarmer ->
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
+ let chunks =
+ Bitv.init (String.length bitmap)
+ (fun i -> bitmap.[i] = '3')
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyComplexOptions.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyComplexOptions.ml
new file mode 100644
index 0000000..5b069d8
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyComplexOptions.ml
@@ -0,0 +1,20 @@
+--- ./src/networks/donkey/donkeyComplexOptions.ml.orig Sat Apr 8 21:26:40 2006
++++ ./src/networks/donkey/donkeyComplexOptions.ml Mon May 15 13:03:12 2006
+@@ -297,7 +297,7 @@
+ (match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- CommonSwarming.value_to_swarmer swarmer assocs;
++ CommonSwarming.value_to_frontend swarmer assocs;
+ CommonSwarming.set_verifier swarmer (if md4s = [||] then
+ VerificationNotAvailable
+ else
+@@ -321,7 +321,7 @@
+ match file.file_swarmer with
+ None -> fields
+ | Some swarmer ->
+- CommonSwarming.swarmer_to_value swarmer fields
++ CommonSwarming.frontend_to_value swarmer fields
+ in
+ fields
+
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyGlobals.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyGlobals.ml
index d77815e..f145af7 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyGlobals.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyGlobals.ml
@@ -1,5 +1,5 @@
--- ./src/networks/donkey/donkeyGlobals.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/donkey/donkeyGlobals.ml Sun May 7 06:39:10 2006
++++ ./src/networks/donkey/donkeyGlobals.ml Mon May 15 13:03:12 2006
@@ -397,7 +397,7 @@
(match file_state with
FileShared -> ()
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyInteractive.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyInteractive.ml
index eba8b14..0fe73a9 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyInteractive.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyInteractive.ml
@@ -1,5 +1,5 @@
--- ./src/networks/donkey/donkeyInteractive.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/donkey/donkeyInteractive.ml Sun May 7 06:39:10 2006
++++ ./src/networks/donkey/donkeyInteractive.ml Mon May 15 13:03:12 2006
@@ -507,7 +507,7 @@
match file.file_swarmer with
None -> ()
@@ -18,3 +18,28 @@
let register_commands list =
register_commands
+@@ -1044,13 +1044,13 @@
+ P.file_chunks =
+ (match file.file_swarmer with
+ | None -> ""
+- | Some swarmer -> CommonSwarming.verified_bitmap swarmer);
++ | Some swarmer -> CommonSwarming.chunks_verified_bitmap swarmer);
+ P.file_availability =
+ [
+ network.network_num,
+ (match file.file_swarmer with
+ | None -> ""
+- | Some swarmer -> CommonSwarming.availability swarmer)
++ | Some swarmer -> CommonSwarming.chunks_availability swarmer)
+ ];
+ P.file_format = file.file_format;
+ P.file_chunks_age = last_seen;
+@@ -1305,7 +1305,7 @@
+ let chunks =
+ (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer)
++ CommonSwarming.chunks_verified_bitmap swarmer)
+ in
+
+ html_mods_table_header buf "sourcesTable" "sources al" ([
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyOneFile.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyOneFile.ml
index 4c63704..b730f64 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyOneFile.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyOneFile.ml
@@ -1,5 +1,23 @@
--- ./src/networks/donkey/donkeyOneFile.ml.orig Sat Apr 8 21:26:40 2006
-+++ ./src/networks/donkey/donkeyOneFile.ml Sun May 7 06:39:10 2006
++++ ./src/networks/donkey/donkeyOneFile.ml Mon May 15 13:03:12 2006
+@@ -166,7 +166,7 @@
+ match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
+ (* lprintf "Verified bitmap: [%s]\n" bitmap; *)
+ let rec iter i =
+ if i = String.length bitmap then true
+@@ -197,7 +197,7 @@
+ match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- let bitmap = CommonSwarming.verified_bitmap swarmer in
++ let bitmap = CommonSwarming.chunks_verified_bitmap swarmer in
+ let rec iter i len =
+ if i < len then
+ if bitmap.[i] = '3' then
@@ -217,7 +217,7 @@
(f, chunks, up) :: tail ->
if f != file then iter tail
@@ -19,3 +37,12 @@
c.client_download <- None
let send_get_range_request c file ranges =
+@@ -333,7 +332,7 @@
+ let rec iter n =
+ if n < 3 then
+ try
+- ignore (CommonSwarming.find_range up);
++ ignore (CommonSwarming.find_range up zone_size);
+ iter (n+1)
+ with
+ Not_found -> n
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyShare.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyShare.ml
new file mode 100644
index 0000000..920c5a0
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__donkey__donkeyShare.ml
@@ -0,0 +1,29 @@
+--- ./src/networks/donkey/donkeyShare.ml.orig Sat Apr 8 21:26:40 2006
++++ ./src/networks/donkey/donkeyShare.ml Mon May 15 13:03:12 2006
+@@ -107,7 +107,7 @@
+ (* file.file_all_chunks <- String.make file.file_nchunks '1'; *)
+ (* Should we trust mtimes, or reverify each file. If we trust
+ * mtimes, I guess we have to call
+- * CommonSwarming.set_verified_bitmap "333..."
++ * CommonSwarming.set_chunks_verified_bitmap "333..."
+ * this seems unspeakably ugly, but the alternative is to reverify
+ * every shared file every hour.
+ *
+@@ -122,7 +122,7 @@
+ match file.file_swarmer with
+ Some s -> (let len = Array.length md4s in
+ let ver_str = String.make len '3' in
+- CommonSwarming.set_verified_bitmap s ver_str;
++ CommonSwarming.set_chunks_verified_bitmap s ver_str;
+ (*
+ CommonSwarming.set_present s [(Int64.zero, file_size file)];
+ (* If we don't verify now, it will never happen! *)
+@@ -130,7 +130,7 @@
+ *)
+ if !verbose_share then
+ lprintf_nl () "verified map of %s = %s"
+- (codedname) (CommonSwarming.verified_bitmap s))
++ (codedname) (CommonSwarming.chunks_verified_bitmap s))
+ | None -> if !verbose_share then lprintf_nl () "no swarmer for %s" codedname;
+ (try
+ file.file_format <- CommonMultimedia.get_info
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__fasttrack__fasttrackGlobals.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__fasttrack__fasttrackGlobals.ml
index bc8f3c9..78cda08 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__fasttrack__fasttrackGlobals.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__fasttrack__fasttrackGlobals.ml
@@ -1,5 +1,5 @@
--- ./src/networks/fasttrack/fasttrackGlobals.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/fasttrack/fasttrackGlobals.ml Sun May 7 06:39:10 2006
++++ ./src/networks/fasttrack/fasttrackGlobals.ml Mon May 15 13:03:12 2006
@@ -298,7 +298,7 @@
}
in
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPClients.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPClients.ml
index 782bdd8..e1c5d47 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPClients.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPClients.ml
@@ -1,5 +1,16 @@
--- ./src/networks/fileTP/fileTPClients.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/fileTP/fileTPClients.ml Sun May 7 06:39:10 2006
++++ ./src/networks/fileTP/fileTPClients.ml Mon May 15 13:03:12 2006
+@@ -188,8 +188,8 @@
+ lprintf "Current Block: "; CommonSwarming.print_block b;
+ end;
+ try
+- let (x,y,r) = CommonSwarming.find_range up in
+-
++ let (x,y,r) =
++ CommonSwarming.find_range up min_range_size in
+ (* lprintf "GOT RANGE:\n"; *)
+ if !verbose_swarming then CommonSwarming.print_uploaders swarmer;
+
@@ -269,7 +269,7 @@
let chunks = [ Int64.zero, file_size file ] in
let up = CommonSwarming.register_uploader swarmer
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPComplexOptions.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPComplexOptions.ml
new file mode 100644
index 0000000..78de7fe
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPComplexOptions.ml
@@ -0,0 +1,20 @@
+--- ./src/networks/fileTP/fileTPComplexOptions.ml.orig Sat Apr 8 21:26:41 2006
++++ ./src/networks/fileTP/fileTPComplexOptions.ml Mon May 15 13:03:12 2006
+@@ -84,7 +84,7 @@
+ (match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- CommonSwarming.value_to_swarmer swarmer assocs;
++ CommonSwarming.value_to_frontend swarmer assocs;
+ );
+
+ (try
+@@ -118,7 +118,7 @@
+ match file.file_swarmer with
+ None -> assocs
+ | Some swarmer ->
+- CommonSwarming.swarmer_to_value swarmer assocs
++ CommonSwarming.frontend_to_value swarmer assocs
+
+ let old_files =
+ define_option fileTP_section ["old_urls"]
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPGlobals.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPGlobals.ml
index 1157c2b..607f423 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPGlobals.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPGlobals.ml
@@ -1,5 +1,5 @@
--- ./src/networks/fileTP/fileTPGlobals.ml.orig Mon Apr 10 16:16:13 2006
-+++ ./src/networks/fileTP/fileTPGlobals.ml Sun May 7 06:39:10 2006
++++ ./src/networks/fileTP/fileTPGlobals.ml Mon May 15 13:03:12 2006
@@ -120,7 +120,7 @@
in
file.file_file.impl_file_size <- size;
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPInteractive.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPInteractive.ml
new file mode 100644
index 0000000..0137b3e
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__fileTP__fileTPInteractive.ml
@@ -0,0 +1,16 @@
+--- ./src/networks/fileTP/fileTPInteractive.ml.orig Mon Apr 10 16:16:13 2006
++++ ./src/networks/fileTP/fileTPInteractive.ml Mon May 15 13:03:12 2006
+@@ -90,11 +90,11 @@
+ P.file_download_rate = file_download_rate file.file_file;
+ P.file_chunks = (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer);
++ CommonSwarming.chunks_verified_bitmap swarmer);
+ P.file_availability =
+ [network.network_num,(match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.availability swarmer)];
++ CommonSwarming.chunks_availability swarmer)];
+ P.file_format = FormatNotComputed 0;
+ P.file_chunks_age = [|0|];
+ P.file_age = file_age file;
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaClients.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaClients.ml
index 4114d5b..8f6b67b 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaClients.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaClients.ml
@@ -1,5 +1,5 @@
--- ./src/networks/gnutella/gnutellaClients.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/gnutella/gnutellaClients.ml Sun May 7 06:39:10 2006
++++ ./src/networks/gnutella/gnutellaClients.ml Mon May 15 13:03:12 2006
@@ -479,7 +479,7 @@
let chunks = [ Int64.zero, file_size file ] in
let up = CommonSwarming.register_uploader swarmer
@@ -9,3 +9,13 @@
d.download_uploader <- Some up;
up
+@@ -536,7 +536,8 @@
+ end;
+ *)
+ try
+- let (x,y,r) = CommonSwarming.find_range up in
++ let (x,y,r) =
++ CommonSwarming.find_range up (Int64.of_int (256 * 1024)) in
+
+ if !verbose_swarming then begin
+ lprintf "GOT RANGE:\n";
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaComplexOptions.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaComplexOptions.ml
index 5741b61..1f051b2 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaComplexOptions.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaComplexOptions.ml
@@ -1,5 +1,14 @@
--- ./src/networks/gnutella/gnutellaComplexOptions.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/gnutella/gnutellaComplexOptions.ml Sun May 7 06:39:10 2006
++++ ./src/networks/gnutella/gnutellaComplexOptions.ml Mon May 15 13:03:12 2006
+@@ -140,7 +140,7 @@
+ (match file.file_swarmer with
+ None -> ()
+ | Some swarmer ->
+- CommonSwarming.value_to_swarmer swarmer assocs;
++ CommonSwarming.value_to_frontend swarmer assocs;
+ CommonSwarming.set_verifier swarmer (
+ match file.file_ttr with
+ None -> ForceVerification
@@ -183,7 +183,7 @@
(* "file_present_chunks", List
(List.map (fun (i1,i2) ->
@@ -9,3 +18,12 @@
*)
]
in
+@@ -196,7 +196,7 @@
+ match file.file_swarmer with
+ None -> assocs
+ | Some swarmer ->
+- CommonSwarming.swarmer_to_value swarmer assocs
++ CommonSwarming.frontend_to_value swarmer assocs
+
+
+ (*
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaGlobals.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaGlobals.ml
index ae3de29..a28168b 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaGlobals.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaGlobals.ml
@@ -1,5 +1,5 @@
--- ./src/networks/gnutella/gnutellaGlobals.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/gnutella/gnutellaGlobals.ml Sun May 7 06:39:10 2006
++++ ./src/networks/gnutella/gnutellaGlobals.ml Mon May 15 13:03:12 2006
@@ -325,8 +325,7 @@
in
if !verbose then
diff --git a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaInteractive.ml b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaInteractive.ml
index 10805c7..3207be9 100644
--- a/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaInteractive.ml
+++ b/net-p2p/mldonkey-devel/files/patch-src__networks__gnutella__gnutellaInteractive.ml
@@ -1,5 +1,5 @@
--- ./src/networks/gnutella/gnutellaInteractive.ml.orig Sat Apr 8 21:26:41 2006
-+++ ./src/networks/gnutella/gnutellaInteractive.ml Sun May 7 06:39:10 2006
++++ ./src/networks/gnutella/gnutellaInteractive.ml Mon May 15 13:03:12 2006
@@ -252,7 +252,7 @@
match file.file_ttr with
None -> failwith "No TTR for verification"
@@ -9,3 +9,17 @@
);
file_ops.op_file_recover <- (fun file ->
+@@ -289,11 +289,11 @@
+
+ P.file_chunks = (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.verified_bitmap swarmer);
++ CommonSwarming.chunks_verified_bitmap swarmer);
+ P.file_availability = [network.network_num,
+ (match file.file_swarmer with
+ None -> "" | Some swarmer ->
+- CommonSwarming.availability swarmer)];
++ CommonSwarming.chunks_availability swarmer)];
+
+ P.file_chunks_age = [|0|];
+ P.file_last_seen = BasicSocket.last_time ();
diff --git a/net-p2p/mldonkey-devel/files/patch-src__utils__net__ip.ml b/net-p2p/mldonkey-devel/files/patch-src__utils__net__ip.ml
new file mode 100644
index 0000000..54b4e94
--- /dev/null
+++ b/net-p2p/mldonkey-devel/files/patch-src__utils__net__ip.ml
@@ -0,0 +1,203 @@
+--- src/utils/net/ip.ml.orig Wed Mar 29 12:41:10 2006
++++ src/utils/net/ip.ml Sun May 14 17:24:09 2006
+@@ -17,52 +17,56 @@
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *)
+
++(* This module uses 2 ints to save IPv4 numbers. *)
++
+ open Int64ops
+ open Printf2
+-type t = int * int * int * int
++type t = { hi: int; lo: int }
+
+-external of_string : string -> t = "ml_ints_of_string"
++let of_ints (a,b,c,d) =
++ { hi = (a lsl 8) lor b;
++ lo = (c lsl 8) lor d; }
+
+-let allow_local_network = ref false
++let to_ints t =
++ t.hi lsr 8, t.hi land 255,
++ t.lo lsr 8, t.lo land 255
+
+-let of_inet_addr t =
+- of_string (Unix.string_of_inet_addr t)
++external ints_of_string : string -> (int*int*int*int) = "ml_ints_of_string"
+
+-let any = of_inet_addr Unix.inet_addr_any
++let of_string s =
++ of_ints (ints_of_string s)
+
+-let null = (0,0,0,0)
++let to_string t =
++ let (a4, a3, a2, a1) = to_ints t in
++ Printf.sprintf "%d.%d.%d.%d" a4 a3 a2 a1
+
+-let of_ints t = t
++let allow_local_network = ref false
+
+-let to_ints t = t
+-let to_string (a4, a3, a2, a1) =
+- Printf.sprintf "%d.%d.%d.%d" a4 a3 a2 a1
++let of_inet_addr ia =
++ of_string (Unix.string_of_inet_addr ia)
++
++let any = of_inet_addr Unix.inet_addr_any
++
++let null = { hi = 0; lo = 0; }
+
+ let to_inet_addr t =
+ Unix.inet_addr_of_string (to_string t)
+
+ let hostname_table = Hashtbl.create 997
+
+-let to_fixed_string ((a4, a3, a2, a1) as t)=
++let to_fixed_string t =
++ let (a4, a3, a2, a1) = to_ints t in
+ try
+ Hashtbl.find hostname_table t
+ with _ ->
+ Printf.sprintf "%03d.%03d.%03d.%03d" a4 a3 a2 a1
+
+-let to_int64 (a4, a3, a2, a1) =
+- let small = a1 lor (a2 lsl 8) lor (a3 lsl 16) in
+- (Int64.of_int small) ++ (Int64.shift_left (Int64.of_int a4) 24)
++let to_int64 t =
++ Int64.logor (Int64.shift_left (Int64.of_int t.hi) 16) (Int64.of_int t.lo)
+
+ let of_int64 i =
+- let a4 = Int64.to_int (Int64.logand (Int64.shift_right i 24) 0xffL)
+- in
+- let a3 = Int64.to_int (Int64.logand (Int64.shift_right i 16) 0xffL)
+- in
+- let a2 = Int64.to_int (Int64.logand (Int64.shift_right i 8) 0xffL)
+- in
+- let a1 = Int64.to_int (Int64.logand i 0xffL)
+- in
+- (a4, a3, a2, a1)
++ { hi = Int64.to_int (Int64.shift_right i 16);
++ lo = Int64.to_int (Int64.logand i 65535L); }
+
+ let resolve_one t =
+ try
+@@ -79,13 +83,15 @@
+ end;
+ to_fixed_string t
+
+-let valid (j,k,l,i) =
++let valid t =
++ let (j,k,l,i) = to_ints t in
+ j > 0 && j < 224 &&
+ k >= 0 && k <= 255 &&
+ l >= 0 && l <= 255 &&
+ i >= 0 && i <= 255
+
+-let local_ip ip =
++let local_ip t =
++ let ip = to_ints t in
+ match ip with
+ 192, 168,_,_ -> true
+ | 10, _, _, _ | 127, _,_,_ -> true
+@@ -98,48 +104,38 @@
+ let usable ip =
+ reachable ip && valid ip
+
+-let rec matches ((a4,a3,a2,a1) as a) ips =
+- match ips with
+- [] -> false
+- | (b4,b3,b2,b1) :: tail ->
+- ( (a4 = b4 || b4 = 255) &&
+- (a3 = b3 || b3 = 255) &&
+- (a2 = b2 || b2 = 255) &&
+- (a1 = b1 || b1 = 255))
+- || (matches a tail)
++let matches t ips =
++ let (a4,a3,a2,a1) = to_ints t in
++ let rec matches_aux ips =
++ match ips with
++ [] -> false
++ | b :: tail ->
++ let (b4,b3,b2,b1) = to_ints b in
++ ( (a4 = b4 || b4 = 255) &&
++ (a3 = b3 || b3 = 255) &&
++ (a2 = b2 || b2 = 255) &&
++ (a1 = b1 || b1 = 255))
++ || (matches_aux tail) in
++ matches_aux ips
+
+-let compare (a4,a3,a2,a1) (b4,b3,b2,b1) =
+- let c4 = compare a4 b4 in
+- if c4 <> 0 then c4 else
+- let c3 = compare a3 b3 in
+- if c3 <> 0 then c3 else
+- let c2 = compare a2 b2 in
+- if c2 <> 0 then c2 else
+- compare a1 b1
++let compare a b =
++ let hicompare = compare a.hi b.hi in
++ if hicompare <> 0 then
++ hicompare
++ else
++ compare a.lo b.lo
+
+-let succ (a4,a3,a2,a1) =
+- if a1 < 255 then
+- (a4,a3,a2,a1+1)
+- else if a2 < 255 then
+- (a4,a3,a2+1,0)
+- else if a3 < 255 then
+- (a4,a3+1,0,0)
+- else if a4 < 255 then
+- (a4+1,0,0,0)
++let succ t =
++ if t.lo < 65535 then
++ { t with lo = t.lo+1 }
+ else
+- (0,0,0,0) (* or exception ? *)
++ { hi = t.hi+1; lo = 0; }
+
+-let pred (a4,a3,a2,a1) =
+- if a1 > 0 then
+- (a4,a3,a2,a1-1)
+- else if a2 > 0 then
+- (a4,a3,a2-1,255)
+- else if a3 > 0 then
+- (a4,a3-1,255,255)
+- else if a4 > 0 then
+- (a4-1,255,255,255)
++let pred t =
++ if t.lo > 0 then
++ { t with lo = t.lo-1 }
+ else
+- (255,255,255,255) (* or exception ? *)
++ { hi = t.hi-1; lo = 65535; }
+
+ let banned = ref (fun (ip:t) -> None)
+
+@@ -154,7 +150,7 @@
+ [] -> raise Not_found
+ | ip :: tail ->
+ let ip = of_inet_addr ip in
+- if ip = (127,0,0,1) then
++ if ip = localhost then
+ iter tail
+ else ip
+ in
+@@ -225,12 +221,12 @@
+
+ let option = define_option_class "Ip" value_to_ip ip_to_value
+
+-let rev (a1,a2,a3,a4) = (a4,a3,a2,a1)
++let rev t =
++ let (a4,a3,a2,a1) = to_ints t in
++ of_ints (a1,a2,a3,a4)
+
+ let equal a b =
+- let (a1,a2,a3,a4) = a in
+- let (b1,b2,b3,b4) = b in
+- ( a1=b1 && a2=b2 && a3=b3 && a4=b4)
++ a = b
+
+ type job = {
+ name : string;
OpenPOWER on IntegriCloud