/[mldonkey]/mldonkey/src/daemon/common/commonSwarming2.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/common/commonSwarming2.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by spiralvoice, Tue Jun 28 23:17:07 2005 UTC revision 1.9 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 21  open Md4 Line 21  open Md4
21  open Int64ops  open Int64ops
22  open Options  open Options
23  open Printf2  open Printf2
24      
25  open CommonOptions  open CommonOptions
26  open CommonSwarming  open CommonSwarming
27    
# Line 37  open CommonSwarming Line 37  open CommonSwarming
37    
38  (* let debug_all = true *)  (* let debug_all = true *)
39  let exit_on_error = ref false  let exit_on_error = ref false
40      
41  open CommonTypes  open CommonTypes
42      
43  module Make(M: CommonEnv) = struct  module Make(M: CommonEnv) = struct
44    
45      open M      open M
46      open CommonFile      open CommonFile
47      open CommonTypes      open CommonTypes
48      open CommonClient      open CommonClient
49          
50            
51  let ( ** ) x y = Int64.mul x (Int64.of_int y)  let ( ** ) x y = Int64.mul x (Int64.of_int y)
52    
53  (* Worst scenario?: 1 GB splitted in small ranges of 64 KB = 16 000 ranges.  (* Worst scenario?: 1 GB splitted in small ranges of 64 KB = 16 000 ranges.
# Line 59  let ( ** ) x y = Int64.mul x (Int64.of_i Line 59  let ( ** ) x y = Int64.mul x (Int64.of_i
59    to the largest blocks which are completely included in one block for    to the largest blocks which are completely included in one block for
60    every network.    every network.
61  * the range_size should be the same for all networks.  * the range_size should be the same for all networks.
62  * a completed block should not be verified until all the blocks are  * a completed block should not be verified until all the blocks are
63     completed for all networks.     completed for all networks.
64  * swarmers should be loaded before other files, so that they can be  * swarmers should be loaded before other files, so that they can be
65  used and shared by different files.  used and shared by different files.
# Line 83  type t = { Line 83  type t = {
83      t_file : file;      t_file : file;
84      mutable t_s : swarmer;      mutable t_s : swarmer;
85      t_block_size : int64;      t_block_size : int64;
86        
87      t_nchunks : int;      t_nchunks : int;
88      mutable t_converted_verified_bitmap : string;      mutable t_converted_verified_bitmap : string;
89      mutable t_last_seen : int array;      mutable t_last_seen : int array;
90      mutable t_ncomplete_blocks : int;      mutable t_ncomplete_blocks : int;
91      mutable t_nverified_blocks : int;          mutable t_nverified_blocks : int;
92        
93      mutable t_verifier : verification;      mutable t_verifier : verification;
94      mutable t_verified : (int -> int -> unit);      mutable t_verified : (int -> int -> unit);
95        
96  (* conversion from network blocks to swarmer blocks *)  (* conversion from network blocks to swarmer blocks *)
97      mutable t_t2s_blocks : int list array;          mutable t_t2s_blocks : int list array;
98  (* conversion from swarmer blocks to network blocks *)  (* conversion from swarmer blocks to network blocks *)
99      mutable t_s2t_blocks : int array;          mutable t_s2t_blocks : int array;
100    }    }
101    
102  and swarmer = {  and swarmer = {
103      mutable s_num : int;      mutable s_num : int;
104      mutable s_filename : string;      mutable s_filename : string;
105        
106      mutable s_networks : t list;      mutable s_networks : t list;
107      mutable s_size : int64;      mutable s_size : int64;
108      mutable s_range_size : int64;      mutable s_range_size : int64;
109      mutable s_strategy : strategy;      mutable s_strategy : strategy;
110        
111      mutable s_verified_bitmap : string;      mutable s_verified_bitmap : string;
112      mutable s_availability : int array;      mutable s_availability : int array;
113      mutable s_nuploading : int array;      mutable s_nuploading : int array;
114  (*    mutable s_last_seen : int array; *)  (*    mutable s_last_seen : int array; *)
115        
116      mutable s_blocks : block_v array;      mutable s_blocks : block_v array;
117      mutable s_block_pos : int64 array;          mutable s_block_pos : int64 array;
118    }    }
119      
120  and block_v =  and block_v =
121    EmptyBlock    EmptyBlock
122  | PartialBlock of block  | PartialBlock of block
123  | CompleteBlock  | CompleteBlock
# Line 146  and range = { Line 146  and range = {
146  and uploader = {  and uploader = {
147      up_t : t;      up_t : t;
148      up_client : client;      up_client : client;
149        
150      mutable up_declared : bool;      mutable up_declared : bool;
151        
152      mutable up_chunks : chunks;      mutable up_chunks : chunks;
153      mutable up_complete_blocks : int array;      mutable up_complete_blocks : int array;
154      mutable up_ncomplete : int;      mutable up_ncomplete : int;
155        
156      mutable up_partial_blocks : (int * int64 * int64) array;      mutable up_partial_blocks : (int * int64 * int64) array;
157      mutable up_npartial : int;      mutable up_npartial : int;
158        
159      mutable up_block : block option;      mutable up_block : block option;
160      mutable up_block_begin : int64;      mutable up_block_begin : int64;
161      mutable up_block_end : int64;      mutable up_block_end : int64;
162        
163      mutable up_ranges : (int64 * int64 * range) list;      mutable up_ranges : (int64 * int64 * range) list;
164    }    }
165    
# Line 173  and uploader = { Line 173  and uploader = {
173  module HS = Weak2.Make(struct  module HS = Weak2.Make(struct
174        type t = swarmer        type t = swarmer
175        let hash file = Hashtbl.hash file.s_filename        let hash file = Hashtbl.hash file.s_filename
176          
177        let equal x y  = x.s_filename = y.s_filename        let equal x y  = x.s_filename = y.s_filename
178      end)      end)
179    
# Line 182  let swarmers_by_name = HS.create 31 Line 182  let swarmers_by_name = HS.create 31
182  module HU = Weak2.Make(struct  module HU = Weak2.Make(struct
183        type t = uploader        type t = uploader
184        let hash u = Hashtbl.hash (client_num u.up_client)        let hash u = Hashtbl.hash (client_num u.up_client)
185          
186        let equal x y  =  (client_num x.up_client) =  (client_num y.up_client)        let equal x y  =  (client_num x.up_client) =  (client_num y.up_client)
187      end)      end)
188    
189  let uploaders_by_num = HU.create 113  let uploaders_by_num = HU.create 113
190    
191  let edonkey_range_size = Int64.of_int (180 * 1024)    let edonkey_range_size = Int64.of_int (180 * 1024)
192        
193  let swarmer_counter = ref 0  let swarmer_counter = ref 0
194        
195  let has_multinet = true  let has_multinet = true
196    
197  (*************************************************************************)  (*************************************************************************)
# Line 200  let has_multinet = true Line 200  let has_multinet = true
200  (*                                                                       *)  (*                                                                       *)
201  (*************************************************************************)  (*************************************************************************)
202    
203  let dummy_swarmer = {      let dummy_swarmer = {
204      s_num = 0;      s_num = 0;
205      s_filename = "";      s_filename = "";
206      s_networks = [];      s_networks = [];
# Line 224  let print_uploader up = Line 224  let print_uploader up =
224    lprintf "  interesting complete_blocks: %d\n     " up.up_ncomplete;    lprintf "  interesting complete_blocks: %d\n     " up.up_ncomplete;
225    Array.iter (fun i -> lprintf " %d " i) up.up_complete_blocks;    Array.iter (fun i -> lprintf " %d " i) up.up_complete_blocks;
226    lprintf "  interesting partial_blocks: %d\n     " up.up_npartial;    lprintf "  interesting partial_blocks: %d\n     " up.up_npartial;
227    Array.iter (fun (i, begin_pos, end_pos) ->    Array.iter (fun (i, begin_pos, end_pos) ->
228        lprintf " %d[%s...%s] " i        lprintf " %d[%s...%s] " i
229          (Int64.to_string begin_pos)          (Int64.to_string begin_pos)
230        (Int64.to_string end_pos)) up.up_partial_blocks        (Int64.to_string end_pos)) up.up_partial_blocks
231    
# Line 235  let print_uploader up = Line 235  let print_uploader up =
235  (*                                                                       *)  (*                                                                       *)
236  (*************************************************************************)  (*************************************************************************)
237    
238  let compute_last_seen t =  let compute_last_seen t =
239    let last_seen_total = ref (BasicSocket.last_time ()) in    let last_seen_total = ref (BasicSocket.last_time ()) in
240    for i = 0 to String.length t.t_converted_verified_bitmap - 1 do    for i = 0 to String.length t.t_converted_verified_bitmap - 1 do
241      if t.t_converted_verified_bitmap.[i] > '2' then      if t.t_converted_verified_bitmap.[i] > '2' then
# Line 245  let compute_last_seen t = Line 245  let compute_last_seen t =
245    done;    done;
246    set_file_last_seen t.t_file !last_seen_total;    set_file_last_seen t.t_file !last_seen_total;
247    t.t_last_seen    t.t_last_seen
248      
249  (*************************************************************************)  (*************************************************************************)
250  (*                                                                       *)  (*                                                                       *)
251  (*                         create_swarmer                                *)  (*                         create_swarmer                                *)
# Line 253  let compute_last_seen t = Line 253  let compute_last_seen t =
253  (*************************************************************************)  (*************************************************************************)
254    
255  let create_swarmer file_name file_size range_size =  let create_swarmer file_name file_size range_size =
256      
257    try    try
258      HS.find swarmers_by_name      HS.find swarmers_by_name
259        { dummy_swarmer with        { dummy_swarmer with
260        s_filename = file_name        s_filename = file_name
261      }      }
262    with Not_found ->    with Not_found ->
263        incr swarmer_counter;        incr swarmer_counter;
264    
265  (* Let be VERY conservative... *)  (* Let be VERY conservative... *)
266        let range_size = edonkey_range_size in        let range_size = edonkey_range_size in
267          
268        let nchunks = 1 in        let nchunks = 1 in
269        let rec s = {        let rec s = {
270              
271            s_num = !swarmer_counter;            s_num = !swarmer_counter;
272            s_filename = file_name;            s_filename = file_name;
273              
274            s_networks = [];            s_networks = [];
275              
276            s_size = file_size;            s_size = file_size;
277            s_range_size = range_size;            s_range_size = range_size;
278            s_strategy = AdvancedStrategy;            s_strategy = AdvancedStrategy;
279              
280            s_verified_bitmap = String.make nchunks '0';            s_verified_bitmap = String.make nchunks '0';
281            s_blocks = Array.create nchunks EmptyBlock ;            s_blocks = Array.create nchunks EmptyBlock ;
282            s_block_pos = Array.create nchunks zero;            s_block_pos = Array.create nchunks zero;
# Line 284  let create_swarmer file_name file_size r Line 284  let create_swarmer file_name file_size r
284            s_nuploading = Array.create nchunks 0;            s_nuploading = Array.create nchunks 0;
285  (*      s_last_seen = Array.create nchunks 0; *)  (*      s_last_seen = Array.create nchunks 0; *)
286          }          }
287        in        in
288        HS.add swarmers_by_name s;        HS.add swarmers_by_name s;
289        s        s
290          
291  (*************************************************************************)  (*************************************************************************)
292  (*                                                                       *)  (*                                                                       *)
293  (*                         compute_block_end (internal)                  *)  (*                         compute_block_end (internal)                  *)
# Line 300  let compute_block_end s i = Line 300  let compute_block_end s i =
300      s.s_size      s.s_size
301    else    else
302      b.(i+1)      b.(i+1)
303      
304  (*************************************************************************)  (*************************************************************************)
305  (*                                                                       *)  (*                                                                       *)
306  (*                         compute_block_end (internal)                  *)  (*                         compute_block_begin (internal)                *)
307  (*                                                                       *)  (*                                                                       *)
308  (*************************************************************************)  (*************************************************************************)
309    
310  let compute_block_begin s i =  let compute_block_begin s i =
311    let b = s.s_block_pos in    let b = s.s_block_pos in
312    b.(i)    b.(i)
313      
314  (*************************************************************************)  (*************************************************************************)
315  (*                                                                       *)  (*                                                                       *)
316  (*                         void_range (internal)                         *)  (*                         void_range (internal)                         *)
317  (*                                                                       *)  (*                                                                       *)
318  (*************************************************************************)  (*************************************************************************)
319      
320  let void_range b pos =  let void_range b pos =
321    let r = {    let r = {
322        range_prev = None;        range_prev = None;
# Line 329  let void_range b pos = Line 329  let void_range b pos =
329      }      }
330    in    in
331    r    r
332      
333  (*************************************************************************)  (*************************************************************************)
334  (*                                                                       *)  (*                                                                       *)
335  (*                         cut_ranges (internal)                         *)  (*                         cut_ranges (internal)                         *)
# Line 341  let rec own_ranges b r = Line 341  let rec own_ranges b r =
341    match r.range_next with    match r.range_next with
342      None -> ()      None -> ()
343    | Some r -> own_ranges b r    | Some r -> own_ranges b r
344      
345  (*************************************************************************)  (*************************************************************************)
346  (*                                                                       *)  (*                                                                       *)
347  (*                         get_after_ranges (internal)                   *)  (*                         get_after_ranges (internal)                   *)
# Line 352  let rec get_after_ranges b r cut_pos = Line 352  let rec get_after_ranges b r cut_pos =
352    if r.range_begin >= cut_pos then begin    if r.range_begin >= cut_pos then begin
353        r.range_prev <- None;        r.range_prev <- None;
354        own_ranges b r;        own_ranges b r;
355        r        r
356      end else      end else
357    if r.range_end <= cut_pos then    if r.range_end <= cut_pos then
358      match r.range_next with      match r.range_next with
359        None -> void_range b cut_pos        None -> void_range b cut_pos
360      | Some r -> get_after_ranges b r cut_pos      | Some r -> get_after_ranges b r cut_pos
361    else    else
362    let r = { r with    let r = { r with
363        range_prev = None;        range_prev = None;
364        range_begin = cut_pos;        range_begin = cut_pos;
365        range_current_begin = max r.range_current_begin cut_pos        range_current_begin = max r.range_current_begin cut_pos
# Line 367  let rec get_after_ranges b r cut_pos = Line 367  let rec get_after_ranges b r cut_pos =
367    own_ranges b r;    own_ranges b r;
368    r    r
369    
370        
371  (*************************************************************************)  (*************************************************************************)
372  (*                                                                       *)  (*                                                                       *)
373  (*                         get_before_ranges (internal)                  *)  (*                         get_before_ranges (internal)                  *)
# Line 383  let get_before_ranges b r cut_pos = Line 383  let get_before_ranges b r cut_pos =
383          r.range_current_begin <- min cut_pos r.range_current_begin;          r.range_current_begin <- min cut_pos r.range_current_begin;
384          r.range_end <- cut_pos;          r.range_end <- cut_pos;
385          r.range_next <- None;          r.range_next <- None;
386        end else        end else
387      if r.range_end = cut_pos then      if r.range_end = cut_pos then
388        r.range_next <- None        r.range_next <- None
389      else      else
# Line 422  let empty_block b = Line 422  let empty_block b =
422  let split_blocks s chunk_size =  let split_blocks s chunk_size =
423    
424    let size = s.s_size in    let size = s.s_size in
425      
426    let nblocks = Array.length s.s_blocks in    let nblocks = Array.length s.s_blocks in
427    let rec iter index_s chunk_begin new_blocks =    let rec iter index_s chunk_begin new_blocks =
428  (*    lprintf "iter (1) %d/%d %Ld\n" index_s nblocks chunk_begin; *)  (*    lprintf "iter (1) %d/%d %Ld\n" index_s nblocks chunk_begin; *)
429      if index_s = nblocks then List.rev new_blocks else      if index_s = nblocks then List.rev new_blocks else
430      let block_begin = compute_block_begin s index_s in      let block_begin = compute_block_begin s index_s in
431      let block_end = compute_block_end s index_s in      let block_end = compute_block_end s index_s in
432        
433      let chunk_end = chunk_begin ++ chunk_size in      let chunk_end = chunk_begin ++ chunk_size in
434      let chunk_end = min chunk_end size in      let chunk_end = min chunk_end size in
435        
436      if chunk_end > block_end then begin      if chunk_end > block_end then begin
437            
438          let new_blocks = (          let new_blocks = (
439              s.s_blocks.(index_s),              s.s_blocks.(index_s),
440              block_begin,              block_begin,
441              s.s_verified_bitmap.[index_s]              s.s_verified_bitmap.[index_s]
442            ) :: new_blocks in            ) :: new_blocks in
443          iter (index_s+1) chunk_begin new_blocks          iter (index_s+1) chunk_begin new_blocks
444          
445        end else        end else
446        
447      if chunk_end = block_end then begin      if chunk_end = block_end then begin
448            
449          let new_blocks =  (          let new_blocks =  (
450              s.s_blocks.(index_s),              s.s_blocks.(index_s),
451              block_begin,              block_begin,
452              s.s_verified_bitmap.[index_s]              s.s_verified_bitmap.[index_s]
453            ) :: new_blocks in            ) :: new_blocks in
454          iter (index_s+1) chunk_end new_blocks          iter (index_s+1) chunk_end new_blocks
455          
456        end else begin        end else begin
457    
458  (* We need to split this block in two parts *)  (* We need to split this block in two parts *)
459            
460          s.s_block_pos.(index_s) <- chunk_end;          s.s_block_pos.(index_s) <- chunk_end;
461          match s.s_blocks.(index_s) with          match s.s_blocks.(index_s) with
462            EmptyBlock | CompleteBlock | VerifiedBlock ->            EmptyBlock | CompleteBlock | VerifiedBlock ->
463                
464              let new_blocks =  (              let new_blocks =  (
465                  s.s_blocks.(index_s),                  s.s_blocks.(index_s),
466                  block_begin,                  block_begin,
467                  s.s_verified_bitmap.[index_s]                  s.s_verified_bitmap.[index_s]
468                ) :: new_blocks in                ) :: new_blocks in
469              iter index_s chunk_end new_blocks              iter index_s chunk_end new_blocks
470            
471          | PartialBlock b1 ->          | PartialBlock b1 ->
472                
473              let b2 = {              let b2 = {
474                  block_s = s;                  block_s = s;
475                    
476                  block_begin = chunk_end;                  block_begin = chunk_end;
477                  block_end = b1.block_end;                  block_end = b1.block_end;
478                  block_ranges = b1.block_ranges;                  block_ranges = b1.block_ranges;
# Line 480  let split_blocks s chunk_size = Line 480  let split_blocks s chunk_size =
480                  block_remaining = zero;                  block_remaining = zero;
481                } in                } in
482              b1.block_end <- chunk_end;              b1.block_end <- chunk_end;
483                
484              b2.block_ranges <- get_after_ranges b2 b2.block_ranges chunk_end;              b2.block_ranges <- get_after_ranges b2 b2.block_ranges chunk_end;
485              b1.block_ranges <- get_before_ranges b1 b1.block_ranges chunk_end;              b1.block_ranges <- get_before_ranges b1 b1.block_ranges chunk_end;
486                
487                
488              if empty_block b2 then begin              if empty_block b2 then begin
489  (* lprintf "Partial block b2 should become EmptyBlock\n"; *)  (* lprintf "Partial block b2 should become EmptyBlock\n"; *)
490                  s.s_blocks.(index_s) <- EmptyBlock;                  s.s_blocks.(index_s) <- EmptyBlock;
# Line 492  let split_blocks s chunk_size = Line 492  let split_blocks s chunk_size =
492                end else begin                end else begin
493                  s.s_blocks.(index_s) <- PartialBlock b2;                  s.s_blocks.(index_s) <- PartialBlock b2;
494                end;                end;
495                
496              let new_blocks =              let new_blocks =
497                (if empty_block b1 then                (if empty_block b1 then
498  (* lprintf "Partial block b1 should become EmptyBlock\n"; *)  (* lprintf "Partial block b1 should become EmptyBlock\n"; *)
499                    (                    (
500                      EmptyBlock,                      EmptyBlock,
# Line 507  let split_blocks s chunk_size = Line 507  let split_blocks s chunk_size =
507                    ))                    ))
508                :: new_blocks in                :: new_blocks in
509              iter index_s chunk_end new_blocks              iter index_s chunk_end new_blocks
510          
511        end        end
512      
513      
514    in    in
515    let blocks = iter 0 zero [] in    let blocks = iter 0 zero [] in
516      
517    let nblocks = List.length blocks in    let nblocks = List.length blocks in
518  (*  lprintf "%d blocks to generate\n" nblocks; *)  (*  lprintf "%d blocks to generate\n" nblocks; *)
519      
520    s.s_blocks <- Array.create nblocks EmptyBlock;    s.s_blocks <- Array.create nblocks EmptyBlock;
521    s.s_verified_bitmap <- String.make nblocks '0';    s.s_verified_bitmap <- String.make nblocks '0';
522    s.s_block_pos <- Array.create nblocks zero;    s.s_block_pos <- Array.create nblocks zero;
523    s.s_availability <- Array.create nblocks 0;    s.s_availability <- Array.create nblocks 0;
524    s.s_nuploading <- Array.create nblocks 0;    s.s_nuploading <- Array.create nblocks 0;
525  (*  s.s_last_seen <- Array.create nblocks 0; *)  (*  s.s_last_seen <- Array.create nblocks 0; *)
526      
527    let rec iter i list =    let rec iter i list =
528      match list with      match list with
529        [] -> ()        [] -> ()
530      | (b, pos, c) :: tail ->      | (b, pos, c) :: tail ->
531          begin          begin
532            match b with            match b with
533              PartialBlock b -> b.block_num <- i              PartialBlock b -> b.block_num <- i
534            | _ -> ()            | _ -> ()
535          end;          end;
536          s.s_blocks.(i) <- b;          s.s_blocks.(i) <- b;
537          s.s_verified_bitmap.[i] <- c;          s.s_verified_bitmap.[i] <- c;
538          s.s_block_pos.(i) <- pos;          s.s_block_pos.(i) <- pos;
539            
540          iter (i+1) tail          iter (i+1) tail
541    in    in
542    iter 0 blocks    iter 0 blocks
543      
544  (*************************************************************************)  (*************************************************************************)
545  (*                                                                       *)  (*                                                                       *)
546  (*                         associate                                     *)  (*                         associate                                     *)
547  (*                                                                       *)  (*                                                                       *)
548  (*************************************************************************)  (*************************************************************************)
549      
550  let associate primary t s =  let associate primary t s =
551      
552    if not (List.memq t s.s_networks) then    if not (List.memq t s.s_networks) then
553    let size = file_size t.t_file in    let size = file_size t.t_file in
554        
555      begin      begin
556        if t.t_s != s then begin        if t.t_s != s then begin
557            t.t_s.s_networks <- [];            t.t_s.s_networks <- [];
558          end;          end;
559      end;      end;
560      
561    assert (s.s_size = size);    assert (s.s_size = size);
562      
563    t.t_s <- s;      t.t_s <- s;
564    t.t_converted_verified_bitmap <- String.make t.t_nchunks '0';    t.t_converted_verified_bitmap <- String.make t.t_nchunks '0';
565    t.t_last_seen <- Array.create t.t_nchunks 0;    t.t_last_seen <- Array.create t.t_nchunks 0;
566    t.t_s2t_blocks <- [||];    t.t_s2t_blocks <- [||];
567    t.t_t2s_blocks <- Array.create t.t_nchunks [];    t.t_t2s_blocks <- Array.create t.t_nchunks [];
568      
569    if primary then begin        if primary then begin
570          t.t_primary <- true;          t.t_primary <- true;
571          s.s_networks <- t :: s.s_networks;            s.s_networks <- t :: s.s_networks;
572      end else begin      end else begin
573          t.t_primary <- false;          t.t_primary <- false;
574          s.s_networks <- s.s_networks @ [t];                  s.s_networks <- s.s_networks @ [t];
575          Unix32.remove (file_fd t.t_file);          Unix32.remove (file_fd t.t_file);
576      end;      end;
577  (* at this point, we are supposed to split the blocks in the swarmer  (* at this point, we are supposed to split the blocks in the swarmer
578  in smaller blocks depending on the block_size of this network, and compute  in smaller blocks depending on the block_size of this network, and compute
579  the t_s2t_blocks and t_t2s_blocks fields. *)  the t_s2t_blocks and t_t2s_blocks fields. *)
580      
581    let chunk_size = t.t_block_size in    let chunk_size = t.t_block_size in
582    
583    split_blocks s chunk_size;    split_blocks s chunk_size;
584      
585    let nblocks = Array.length s.s_blocks in    let nblocks = Array.length s.s_blocks in
586  (* For all networks, adjust the blocks *)  (* For all networks, adjust the blocks *)
587    List.iter (fun t ->    List.iter (fun t ->
588        let nchunks = String.length t.t_converted_verified_bitmap in        let nchunks = String.length t.t_converted_verified_bitmap in
589        t.t_s2t_blocks <- Array.create nblocks 0;        t.t_s2t_blocks <- Array.create nblocks 0;
590        t.t_t2s_blocks <- Array.create nchunks [];        t.t_t2s_blocks <- Array.create nchunks [];
591          
592        let chunk_size = t.t_block_size in        let chunk_size = t.t_block_size in
593        for i = 0 to nblocks - 1 do        for i = 0 to nblocks - 1 do
594          let block_begin = compute_block_begin s i in          let block_begin = compute_block_begin s i in
# Line 596  the t_s2t_blocks and t_t2s_blocks fields Line 596  the t_s2t_blocks and t_t2s_blocks fields
596          t.t_s2t_blocks.(i) <- chunk;          t.t_s2t_blocks.(i) <- chunk;
597          t.t_t2s_blocks.(chunk) <- i :: t.t_t2s_blocks.(chunk)          t.t_t2s_blocks.(chunk) <- i :: t.t_t2s_blocks.(chunk)
598        done        done
599      ) s.s_networks;        ) s.s_networks;
600        
601  (* TODO: If not primary, set_file_downloaded should be called *)  (* TODO: If not primary, set_file_downloaded should be called *)
602    if not primary then    if not primary then
603        add_file_downloaded t.t_file (zero -- file_downloaded t.t_file);        add_file_downloaded t.t_file (zero -- file_downloaded t.t_file);
604        
605      begin      begin
606        match s.s_networks with        match s.s_networks with
607          t :: tail when primary ->          t :: tail when primary ->
# Line 609  the t_s2t_blocks and t_t2s_blocks fields Line 609  the t_s2t_blocks and t_t2s_blocks fields
609                assert (not tt.t_primary);                assert (not tt.t_primary);
610                set_file_fd tt.t_file (file_fd t.t_file)                set_file_fd tt.t_file (file_fd t.t_file)
611            ) tail            ) tail
612              
613        | tt :: tail when tt.t_primary ->        | tt :: tail when tt.t_primary ->
614            assert (not primary);            assert (not primary);
615            set_file_fd t.t_file (file_fd tt.t_file)            set_file_fd t.t_file (file_fd tt.t_file)
# Line 617  the t_s2t_blocks and t_t2s_blocks fields Line 617  the t_s2t_blocks and t_t2s_blocks fields
617      end;      end;
618    
619    ()    ()
620      
621  (*************************************************************************)  (*************************************************************************)
622  (*                                                                       *)  (*                                                                       *)
623  (*                         create                                        *)  (*                         create                                        *)
624  (*                                                                       *)  (*                                                                       *)
625  (*************************************************************************)  (*************************************************************************)
626      
627  let create ss file chunk_size =  let create ss file chunk_size =
628      
629    let size = file_size file in    let size = file_size file in
630    let nchunks =    let nchunks =
631      1 + Int64.to_int (      1 + Int64.to_int (
632        Int64.div (Int64.sub size Int64.one) chunk_size) in        Int64.div (Int64.sub size Int64.one) chunk_size) in
633      
634    let rec t = {    let rec t = {
635          
636        t_s = ss;        t_s = ss;
637        t_primary = true;        t_primary = true;
638        t_file = file;        t_file = file;
639          
640        t_nchunks = nchunks;        t_nchunks = nchunks;
641        t_block_size = chunk_size;        t_block_size = chunk_size;
642          
643        t_ncomplete_blocks = 0;        t_ncomplete_blocks = 0;
644        t_nverified_blocks = 0;        t_nverified_blocks = 0;
645          
646        t_converted_verified_bitmap = String.make nchunks '0';        t_converted_verified_bitmap = String.make nchunks '0';
647        t_last_seen = Array.create nchunks 0;        t_last_seen = Array.create nchunks 0;
648          
649        t_verifier = NoVerification;        t_verifier = NoVerification;
650        t_verified = (fun _ _ -> ());        t_verified = (fun _ _ -> ());
651          
652        t_s2t_blocks = [||];        t_s2t_blocks = [||];
653        t_t2s_blocks = Array.create nchunks [];        t_t2s_blocks = Array.create nchunks [];
654      }      }
655    in    in
656    associate true t ss;      associate true t ss;
657    t    t
658    
659              
660  (*************************************************************************)  (*************************************************************************)
661  (*                                                                       *)  (*                                                                       *)
662  (*                         clear_uploader_ranges                         *)  (*                         clear_uploader_ranges                         *)
663  (*                                                                       *)  (*                                                                       *)
664  (*************************************************************************)  (*************************************************************************)
665    
666  let clear_uploader_ranges up =  let clear_uploader_ranges up =
667    List.iter (fun (_,_,r) ->    List.iter (fun (_,_,r) ->
668        r.range_nuploading <- r.range_nuploading - 1        r.range_nuploading <- r.range_nuploading - 1
669    ) up.up_ranges;    ) up.up_ranges;
# Line 673  let clear_uploader_ranges up = Line 673  let clear_uploader_ranges up =
673  (*                                                                       *)  (*                                                                       *)
674  (*                         clear_uploader_block                          *)  (*                         clear_uploader_block                          *)
675  (*                                                                       *)  (*                                                                       *)
676  (*************************************************************************)  (*************************************************************************)
677    
678  let clear_uploader_block up =  let clear_uploader_block up =
679    match up.up_block with    match up.up_block with
680      None -> ()      None -> ()
681    | Some b ->    | Some b ->
# Line 691  let clear_uploader_block up = Line 691  let clear_uploader_block up =
691  (*                                                                       *)  (*                                                                       *)
692  (*************************************************************************)  (*************************************************************************)
693    
694  let compute_block_num s chunk_pos =  let compute_block_num s chunk_pos =
695    let b = s.s_block_pos in    let b = s.s_block_pos in
696    let rec iter min max =    let rec iter min max =
697      if min = max then min else      if min = max then min else
# Line 706  let compute_block_num s chunk_pos = Line 706  let compute_block_num s chunk_pos =
706        iter medium max        iter medium max
707    in    in
708    let i = iter 0 (Array.length b - 1) in    let i = iter 0 (Array.length b - 1) in
709    if debug_all then      if debug_all then
710      lprintf "%Ld is block %d [%Ld-%Ld]\n" chunk_pos i      lprintf "%Ld is block %d [%Ld-%Ld]\n" chunk_pos i
711        (compute_block_begin s i) (compute_block_end s i);        (compute_block_begin s i) (compute_block_end s i);
712    i    i
713    
714      
715  (*************************************************************************)  (*************************************************************************)
716  (*                                                                       *)  (*                                                                       *)
717  (*                         apply_intervals (internal)                    *)  (*                         apply_intervals (internal)                    *)
# Line 731  let apply_intervals s f chunks = Line 731  let apply_intervals s f chunks =
731              let i0 = compute_block_num s chunk_begin in              let i0 = compute_block_num s chunk_begin in
732              let block_begin = compute_block_begin s i0 in              let block_begin = compute_block_begin s i0 in
733              let rec iter_blocks i block_begin chunk_begin =              let rec iter_blocks i block_begin chunk_begin =
734                  
735  (*              lprintf "iter_blocks %d %Ld %Ld\n" i block_begin chunk_begin; *)  (*              lprintf "iter_blocks %d %Ld %Ld\n" i block_begin chunk_begin; *)
736                if i < nchunks && block_begin < chunk_end then                if i < nchunks && block_begin < chunk_end then
737                  let block_end = compute_block_end s i in                  let block_end = compute_block_end s i in
738                    
739                  let current_end =  min block_end chunk_end in                  let current_end =  min block_end chunk_end in
740                    
741                  if debug_all then                  if debug_all then
742                    lprintf "Apply: %d %s-%s %s-%s\n"                    lprintf "Apply: %d %s-%s %s-%s\n"
743                      i                      i
744                      (Int64.to_string block_begin)                      (Int64.to_string block_begin)
745                    (Int64.to_string block_end)                    (Int64.to_string block_end)
746                    (Int64.to_string chunk_begin)                    (Int64.to_string chunk_begin)
747                    (Int64.to_string current_end);                    (Int64.to_string current_end);
748                    
749                  f i block_begin block_end chunk_begin current_end;                  f i block_begin block_end chunk_begin current_end;
750                    
751                  iter_blocks (i+1) block_end block_end                  iter_blocks (i+1) block_end block_end
752              in              in
753              iter_blocks i0 block_begin chunk_begin;              iter_blocks i0 block_begin chunk_begin;
# Line 765  let apply_intervals s f chunks = Line 765  let apply_intervals s f chunks =
765    
766  let print_s str s =  let print_s str s =
767    lprintf "Ranges after %s:\n" str;    lprintf "Ranges after %s:\n" str;
768      
769    let rec iter r =    let rec iter r =
770      lprintf " %s(%s)-%s(%d)"      lprintf " %s(%s)-%s(%d)"
771        (Int64.to_string r.range_begin)        (Int64.to_string r.range_begin)
772      (Int64.to_string r.range_current_begin)      (Int64.to_string r.range_current_begin)
773      (Int64.to_string r.range_end) r.range_nuploading;      (Int64.to_string r.range_end) r.range_nuploading;
# Line 775  let print_s str s = Line 775  let print_s str s =
775        None -> lprintf "\n"        None -> lprintf "\n"
776      | Some r -> iter r      | Some r -> iter r
777    in    in
778      
779    Array.iteri (fun i b ->    Array.iteri (fun i b ->
780        lprintf "   %d: " i;        lprintf "   %d: " i;
781        let block_begin = compute_block_begin s i in        let block_begin = compute_block_begin s i in
# Line 788  let print_s str s = Line 788  let print_s str s =
788            List.iter (fun ii -> lprintf "%d " ii) t.t_t2s_blocks.(j);            List.iter (fun ii -> lprintf "%d " ii) t.t_t2s_blocks.(j);
789            lprintf "]";            lprintf "]";
790        ) s.s_networks;        ) s.s_networks;
791          
792        match b with        match b with
793          PartialBlock b ->          PartialBlock b ->
794            lprintf " [%s .. %s] --> "            lprintf " [%s .. %s] --> "
795              (Int64.to_string b.block_begin)              (Int64.to_string b.block_begin)
796            (Int64.to_string b.block_end);            (Int64.to_string b.block_end);
797            iter b.block_ranges            iter b.block_ranges
# Line 799  let print_s str s = Line 799  let print_s str s =
799        | CompleteBlock -> lprintf "C\n"        | CompleteBlock -> lprintf "C\n"
800        | VerifiedBlock -> lprintf "V\n"        | VerifiedBlock -> lprintf "V\n"
801    ) s.s_blocks;    ) s.s_blocks;
802      
803    lprintf "Files:\n";    lprintf "Files:\n";
804    List.iter (fun t ->    List.iter (fun t ->
805        lprintf "  File num: %d\n" (file_num t.t_file);        lprintf "  File num: %d\n" (file_num t.t_file);
# Line 830  let iter_block_ranges f b = Line 830  let iter_block_ranges f b =
830  (*************************************************************************)  (*************************************************************************)
831    
832  let print_block b =  let print_block b =
833    lprintf "Block %d: %s-%s"    lprintf "Block %d: %s-%s"
834      b.block_num      b.block_num
835      (Int64.to_string b.block_begin)      (Int64.to_string b.block_begin)
836    (Int64.to_string b.block_end);    (Int64.to_string b.block_end);
# Line 844  let print_block b = Line 844  let print_block b =
844    in    in
845    iter_range b.block_ranges;    iter_range b.block_ranges;
846    lprintf "\n"    lprintf "\n"
847          
848  (*************************************************************************)  (*************************************************************************)
849  (*                                                                       *)  (*                                                                       *)
850  (*                         add_file_downloaded                           *)  (*                         add_file_downloaded                           *)
# Line 854  let print_block b = Line 854  let print_block b =
854  let add_file_downloaded maybe_t s size =  let add_file_downloaded maybe_t s size =
855  (*  lprintf "add_file_downloaded %Ld\n" size; *)  (*  lprintf "add_file_downloaded %Ld\n" size; *)
856    match s.s_networks with    match s.s_networks with
857      t :: _ when t.t_primary ->      t :: _ when t.t_primary ->
858        add_file_downloaded t.t_file size;        add_file_downloaded t.t_file size;
859        begin        begin
860          match maybe_t with          match maybe_t with
# Line 865  let add_file_downloaded maybe_t s size = Line 865  let add_file_downloaded maybe_t s size =
865        end;        end;
866        if file_downloaded t.t_file < zero then        if file_downloaded t.t_file < zero then
867            lprintf "ERROR: file_downloaded < zero !!!\n";            lprintf "ERROR: file_downloaded < zero !!!\n";
868              
869    | _ -> ()    | _ -> ()
870    
871  (*************************************************************************)  (*************************************************************************)
# Line 875  let add_file_downloaded maybe_t s size = Line 875  let add_file_downloaded maybe_t s size =
875  (*************************************************************************)  (*************************************************************************)
876    
877  let rec close_ranges maybe_t s r =  let rec close_ranges maybe_t s r =
878      
879    let added = r.range_end -- r.range_current_begin in    let added = r.range_end -- r.range_current_begin in
880    add_file_downloaded maybe_t s added;    add_file_downloaded maybe_t s added;
881    let b = r.range_block in    let b = r.range_block in
882    b.block_remaining <- b.block_remaining -- added;    b.block_remaining <- b.block_remaining -- added;
883      
884    r.range_current_begin <- r.range_end;    r.range_current_begin <- r.range_end;
885    match r.range_next with    match r.range_next with
886      None -> ()      None -> ()
887    | Some rr ->    | Some rr ->
888        r.range_prev <- None;        r.range_prev <- None;
889        r.range_next <- None;        r.range_next <- None;
890        close_ranges maybe_t s rr        close_ranges maybe_t s rr
891    
892          
893  (*************************************************************************)  (*************************************************************************)
894  (*                                                                       *)  (*                                                                       *)
895  (*                         set_downloaded_block                          *)  (*                         set_downloaded_block                          *)
# Line 908  let set_downloaded_block maybe_t s i = Line 908  let set_downloaded_block maybe_t s i =
908          r.range_current_begin <- r.range_end;          r.range_current_begin <- r.range_end;
909          match r.range_next with          match r.range_next with
910            None -> r.range_prev <- None; r            None -> r.range_prev <- None; r
911          | Some rr ->          | Some rr ->
912              r.range_prev <- None;              r.range_prev <- None;
913              r.range_next <- None;              r.range_next <- None;
914              iter rr              iter rr
# Line 930  needed on the primary. If the verificati Line 930  needed on the primary. If the verificati
930  becomes '3', and the secondary verifiers are tagged with '2' (if they use  becomes '3', and the secondary verifiers are tagged with '2' (if they use
931  a different verification scheme) or '3' (if no verification scheme or  a different verification scheme) or '3' (if no verification scheme or
932  a verification scheme that has already been used). *)  a verification scheme that has already been used). *)
933      
934  (* corruption has been detected, and the block has been reset to 0 *)  (* corruption has been detected, and the block has been reset to 0 *)
935  let set_bitmap_0 s i =  let set_bitmap_0 s i =
936    if s.s_verified_bitmap.[i] > '1' then begin    if s.s_verified_bitmap.[i] > '1' then begin
# Line 942  let set_bitmap_0 s i = Line 942  let set_bitmap_0 s i =
942              t.t_converted_verified_bitmap.[j] <- '0'              t.t_converted_verified_bitmap.[j] <- '0'
943        ) s.s_networks        ) s.s_networks
944      end      end
945        
946  (* we have started downloading this block, so mark all containing blocks  (* we have started downloading this block, so mark all containing blocks
947    also as started. *)    also as started. *)
948  let set_bitmap_1 s i =  let set_bitmap_1 s i =
# Line 954  let set_bitmap_1 s i = Line 954  let set_bitmap_1 s i =
954              t.t_converted_verified_bitmap.[j] <- '1'              t.t_converted_verified_bitmap.[j] <- '1'
955        ) s.s_networks        ) s.s_networks
956      end      end
957        
958  (* we finished this block, we need know to verify it *)  (* we finished this block, we need know to verify it *)
959  let set_bitmap_2 s i =  let set_bitmap_2 s i =
960    if s.s_verified_bitmap.[i] < '2' then begin    if s.s_verified_bitmap.[i] < '2' then begin
# Line 971  let set_bitmap_2 s i = Line 971  let set_bitmap_2 s i =
971        | [] -> assert false        | [] -> assert false
972        | _ -> ()        | _ -> ()
973      end      end
974        
975  (* the primary verifier has worked, so let ask secondary ones for  (* the primary verifier has worked, so let ask secondary ones for
976  verification too *)  verification too *)
977  let set_bitmap_3 s i =  let set_bitmap_3 s i =
978    if s.s_verified_bitmap.[i] < '3' then begin    if s.s_verified_bitmap.[i] < '3' then begin
979        s.s_verified_bitmap.[i] <- '3';          s.s_verified_bitmap.[i] <- '3';
980  (*      lprintf "set_bitmap_3 %d done\n" i; *)  (*      lprintf "set_bitmap_3 %d done\n" i; *)
981        match s.s_networks with        match s.s_networks with
982          [] -> assert false          [] -> assert false
# Line 993  let set_bitmap_3 s i = Line 993  let set_bitmap_3 s i =
993                      t.t_converted_verified_bitmap.[j] <- '2'                      t.t_converted_verified_bitmap.[j] <- '2'
994            ) tail            ) tail
995      end      end
996          
997  (*************************************************************************)  (*************************************************************************)
998  (*                                                                       *)  (*                                                                       *)
999  (*                         set_toverify_block (internal)                 *)  (*                         set_toverify_block (internal)                 *)
# Line 1015  let set_completed_block maybe_t s i = Line 1015  let set_completed_block maybe_t s i =
1015      match s.s_blocks.(i) with      match s.s_blocks.(i) with
1016        PartialBlock b -> close_ranges maybe_t s b.block_ranges        PartialBlock b -> close_ranges maybe_t s b.block_ranges
1017      | _ -> ()      | _ -> ()
1018    end;      end;
1019    match s.s_blocks.(i) with    match s.s_blocks.(i) with
1020      CompleteBlock | VerifiedBlock -> ()      CompleteBlock | VerifiedBlock -> ()
1021    | _ ->    | _ ->
# Line 1028  let set_completed_block maybe_t s i = Line 1028  let set_completed_block maybe_t s i =
1028  (*                         set_verified_block (internal)                 *)  (*                         set_verified_block (internal)                 *)
1029  (*                                                                       *)  (*                                                                       *)
1030  (*************************************************************************)  (*************************************************************************)
1031          
1032  let set_verified_block s j =  let set_verified_block s j =
1033    match s.s_blocks.(j) with    match s.s_blocks.(j) with
1034      VerifiedBlock -> ()      VerifiedBlock -> ()
# Line 1042  let set_verified_block s j = Line 1042  let set_verified_block s j =
1042  (*                         set_verified_chunk (internal)                 *)  (*                         set_verified_chunk (internal)                 *)
1043  (*                                                                       *)  (*                                                                       *)
1044  (*************************************************************************)  (*************************************************************************)
1045          
1046  let set_verified_chunk t i =  let set_verified_chunk t i =
1047    t.t_nverified_blocks <- t.t_nverified_blocks + 1;    t.t_nverified_blocks <- t.t_nverified_blocks + 1;
1048    t.t_converted_verified_bitmap.[i] <- '3';    t.t_converted_verified_bitmap.[i] <- '3';
# Line 1063  let set_verified_chunk t i = Line 1063  let set_verified_chunk t i =
1063  let verify t chunks num begin_pos end_pos =  let verify t chunks num begin_pos end_pos =
1064    let file = t.t_file in    let file = t.t_file in
1065    file_verify t.t_file chunks.(num) begin_pos end_pos    file_verify t.t_file chunks.(num) begin_pos end_pos
1066      
1067  (*************************************************************************)  (*************************************************************************)
1068  (*                                                                       *)  (*                                                                       *)
1069  (*                         verify_chunk (internal)                       *)  (*                         verify_chunk (internal)                       *)
1070  (*                                                                       *)  (*                                                                       *)
1071  (*************************************************************************)  (*************************************************************************)
1072        
1073  let verify_chunk t i =  let verify_chunk t i =
1074    if t.t_converted_verified_bitmap.[i] = '2' then    if t.t_converted_verified_bitmap.[i] = '2' then
1075      let nblocks = String.length t.t_converted_verified_bitmap in      let nblocks = String.length t.t_converted_verified_bitmap in
1076      match t.t_verifier with      match t.t_verifier with
1077        NoVerification        NoVerification
1078      | VerificationNotAvailable -> ()      | VerificationNotAvailable -> ()
1079        
1080      | Verification chunks when Array.length chunks = nblocks ->      | Verification chunks when Array.length chunks = nblocks ->
1081            
1082          begin try          begin try
1083              let s = t.t_s in              let s = t.t_s in
1084              let block_begin = t.t_block_size ** i in              let block_begin = t.t_block_size ** i in
# Line 1087  let verify_chunk t i = Line 1087  let verify_chunk t i =
1087              if verify t chunks i block_begin block_end then begin              if verify t chunks i block_begin block_end then begin
1088                  set_verified_chunk t i;                  set_verified_chunk t i;
1089                  t.t_verified t.t_nverified_blocks i;                  t.t_verified t.t_nverified_blocks i;
1090                  
1091                end else begin                end else begin
1092                    
1093                  if !verbose_swarming then                  if !verbose_swarming then
1094                      lprintf "VERIFICATION OF BLOC %d OF %s FAILED\n"                      lprintf "VERIFICATION OF BLOC %d OF %s FAILED\n"
1095                          i (file_best_name t.t_file);                          i (file_best_name t.t_file);
1096                  t.t_ncomplete_blocks <- t.t_ncomplete_blocks - 1;                  t.t_ncomplete_blocks <- t.t_ncomplete_blocks - 1;
1097                    
1098                  if List.for_all (fun i ->                  if List.for_all (fun i ->
1099                        s.s_verified_bitmap.[i] = '2'                        s.s_verified_bitmap.[i] = '2'
1100                    ) t.t_t2s_blocks.(i) then begin                    ) t.t_t2s_blocks.(i) then begin
1101                        
1102                      lprintf "Verification of complete block %d of %s FAILED, redownloading it.\n"                      lprintf "Verification of complete block %d of %s FAILED, redownloading it.\n"
1103                              i (file_best_name t.t_file);                              i (file_best_name t.t_file);
1104                        
1105                      t.t_converted_verified_bitmap.[i] <- '0';                      t.t_converted_verified_bitmap.[i] <- '0';
1106                        
1107                      List.iter (fun i ->                      List.iter (fun i ->
1108                          match s.s_blocks.(i) with                          match s.s_blocks.(i) with
1109                            EmptyBlock -> set_bitmap_0 s i                            EmptyBlock -> set_bitmap_0 s i
# Line 1112  let verify_chunk t i = Line 1112  let verify_chunk t i =
1112                              let block_begin = compute_block_begin s i in                              let block_begin = compute_block_begin s i in
1113                              let block_end = compute_block_end s i in                              let block_end = compute_block_end s i in
1114                              add_file_downloaded None s (block_begin -- block_end);                              add_file_downloaded None s (block_begin -- block_end);
1115                                
1116                              s.s_blocks.(i) <- EmptyBlock;                              s.s_blocks.(i) <- EmptyBlock;
1117                              set_bitmap_0 s i                              set_bitmap_0 s i
1118                            
1119                          | VerifiedBlock -> assert false                          | VerifiedBlock -> assert false
1120                      ) t.t_t2s_blocks.(i)                      ) t.t_t2s_blocks.(i)
1121                    end else begin                    end else begin
1122                      let nsub = ref 0 in                      let nsub = ref 0 in
1123                        
1124                      lprintf "  Swarmer was incomplete: ";                      lprintf "  Swarmer was incomplete: ";
1125                      List.iter (fun i ->                      List.iter (fun i ->
1126                          lprintf "%c" s.s_verified_bitmap.[i];                          lprintf "%c" s.s_verified_bitmap.[i];
1127                          if s.s_verified_bitmap.[i] = '2' then incr nsub;                          if s.s_verified_bitmap.[i] = '2' then incr nsub;
1128                      ) t.t_t2s_blocks.(i);                      ) t.t_t2s_blocks.(i);
1129                      lprintf "   = %d/%d\n" !nsub (List.length t.t_t2s_blocks.(i));                      lprintf "   = %d/%d\n" !nsub (List.length t.t_t2s_blocks.(i));
1130                        
1131                      t.t_converted_verified_bitmap.[i] <- '1'                      t.t_converted_verified_bitmap.[i] <- '1'
1132                    end;                    end;
1133                end                end
1134            with VerifierNotReady -> ()            with VerifierNotReady -> ()
1135          end          end
1136            
1137      | Verification chunks ->      | Verification chunks ->
1138          assert (Array.length chunks = 1);          assert (Array.length chunks = 1);
1139          let can_verify = ref true in          let can_verify = ref true in
# Line 1148  let verify_chunk t i = Line 1148  let verify_chunk t i =
1148                if verify t chunks 0 zero s.s_size then begin                if verify t chunks 0 zero s.s_size then begin
1149                    for i = 0 to nblocks - 1 do                    for i = 0 to nblocks - 1 do
1150                      if t.t_converted_verified_bitmap.[i] = '2' then begin                      if t.t_converted_verified_bitmap.[i] = '2' then begin
1151                            
1152                          set_verified_chunk t i;                          set_verified_chunk t i;
1153                          t.t_verified t.t_nverified_blocks i;                          t.t_verified t.t_nverified_blocks i;
1154                        end                        end
1155                    done                    done
1156                  
1157                end else begin                end else begin
1158                    
1159                  lprintf "VERIFICATION OF BLOCS OF %s FAILED\n"                  lprintf "VERIFICATION OF BLOCS OF %s FAILED\n"
1160                      (file_best_name t.t_file);                      (file_best_name t.t_file);
1161                      
1162                    for i = 0 to nblocks - 1 do                    for i = 0 to nblocks - 1 do
1163                      if t.t_converted_verified_bitmap.[i] = '2' then begin                      if t.t_converted_verified_bitmap.[i] = '2' then begin
1164                      
1165                          t.t_ncomplete_blocks <- t.t_ncomplete_blocks - 1;                          t.t_ncomplete_blocks <- t.t_ncomplete_blocks - 1;
1166                          if List.for_all (fun i ->                          if List.for_all (fun i ->
1167                                s.s_verified_bitmap.[i] = '2'                                s.s_verified_bitmap.[i] = '2'
1168                            ) t.t_t2s_blocks.(i) then begin                            ) t.t_t2s_blocks.(i) then begin
1169                        
1170                              t.t_converted_verified_bitmap.[i] <- '0';                              t.t_converted_verified_bitmap.[i] <- '0';
1171                                
1172                              List.iter (fun i ->                              List.iter (fun i ->
1173                                  match s.s_blocks.(i) with                                  match s.s_blocks.(i) with
1174                                    EmptyBlock -> set_bitmap_0 s i                                    EmptyBlock -> set_bitmap_0 s i
# Line 1180  let verify_chunk t i = Line 1180  let verify_chunk t i =
1180                                      let block_begin = compute_block_begin s i in                                      let block_begin = compute_block_begin s i in
1181                                      let block_end = compute_block_end s i in                                      let block_end = compute_block_end s i in
1182                                      add_file_downloaded None s (block_begin -- block_end);                                      add_file_downloaded None s (block_begin -- block_end);
1183                                        
1184                                      s.s_blocks.(i) <- EmptyBlock;                                      s.s_blocks.(i) <- EmptyBlock;
1185                                      set_bitmap_0 s i                                      set_bitmap_0 s i
1186                            
1187                                  | VerifiedBlock -> assert false                                  | VerifiedBlock -> assert false
1188                              ) t.t_t2s_blocks.(i)                              ) t.t_t2s_blocks.(i)
1189                            end else begin                            end else begin
1190                              let nsub = ref 0 in                              let nsub = ref 0 in
1191                                
1192                              lprintf "  Swarmer was incomplete: ";                              lprintf "  Swarmer was incomplete: ";
1193                              List.iter (fun i ->                              List.iter (fun i ->
1194                                  lprintf "%c" s.s_verified_bitmap.[i];                                  lprintf "%c" s.s_verified_bitmap.[i];
1195                                  if s.s_verified_bitmap.[i] = '2' then incr nsub;                                  if s.s_verified_bitmap.[i] = '2' then incr nsub;
1196                                  ) t.t_t2s_blocks.(i);                                  ) t.t_t2s_blocks.(i);
1197                              lprintf "   = %d/%d\n" !nsub (List.length t.t_t2s_blocks.(i));                              lprintf "   = %d/%d\n" !nsub (List.length t.t_t2s_blocks.(i));
1198                        
1199                              t.t_converted_verified_bitmap.[i] <- '1'                              t.t_converted_verified_bitmap.[i] <- '1'
1200                            end;                            end;
1201                        end                        end
# Line 1204  let verify_chunk t i = Line 1204  let verify_chunk t i =
1204            with VerifierNotReady -> ()            with VerifierNotReady -> ()
1205          end          end
1206    
1207                
1208  (*************************************************************************)  (*************************************************************************)
1209  (*                                                                       *)  (*                                                                       *)
1210  (*                         must_verify_chunk (internal)                  *)  (*                         must_verify_chunk (internal)                  *)
# Line 1212  let verify_chunk t i = Line 1212  let verify_chunk t i =
1212  (*************************************************************************)  (*************************************************************************)
1213    
1214              (*              (*
1215  let must_verify_chunk t i immediatly =  let must_verify_chunk t i immediatly =
1216    match t.t_verifier with    match t.t_verifier with
1217      NoVerification -> ()      NoVerification -> ()
1218    | _ ->    | _ ->
1219        if t.t_converted_verified_bitmap.[i] < '2' then        if t.t_converted_verified_bitmap.[i] < '2' then
1220          set_toverify_chunk t i;          set_toverify_chunk t i;
1221        if t.t_converted_verified_bitmap.[i] = '2' && immediatly then        if t.t_converted_verified_bitmap.[i] = '2' && immediatly then
1222          verify_chunk t i          verify_chunk t i
1223            *)            *)
1224    
# Line 1227  let must_verify_chunk t i immediatly = Line 1227  let must_verify_chunk t i immediatly =
1227  (*                         must_verify_block                             *)  (*                         must_verify_block                             *)
1228  (*                                                                       *)  (*                                                                       *)
1229  (*************************************************************************)  (*************************************************************************)
1230        
1231  let must_verify_block s i immediatly =  let must_verify_block s i immediatly =
1232    set_bitmap_2 s i;    set_bitmap_2 s i;
1233    if immediatly then    if immediatly then
1234      match s.s_networks with      match s.s_networks with
# Line 1238  let must_verify_block s i immediatly = Line 1238  let must_verify_block s i immediatly =
1238          t.t_converted_verified_bitmap.[i] <- '2';          t.t_converted_verified_bitmap.[i] <- '2';
1239  (*        List.iter (fun j ->  (*        List.iter (fun j ->
1240              if s.s_verified_bitmap.[j] <> '2' then begin              if s.s_verified_bitmap.[j] <> '2' then begin
1241                  lprintf "   block %d not downloaded\n" j;                  lprintf "   block %d not downloaded\n" j;
1242                  exit_on_error := false;                  exit_on_error := false;
1243                end;                end;
1244          ) t.t_t2s_blocks.(i);  *)          ) t.t_t2s_blocks.(i);  *)
1245          verify_chunk t i;          verify_chunk t i;
1246  (*      exit_on_error := true; *)  (*      exit_on_error := true; *)
1247      | _ -> ()          | _ -> ()
1248            
1249  (*************************************************************************)  (*************************************************************************)
1250  (*                                                                       *)  (*                                                                       *)
1251  (*                         verify_all_blocks                             *)  (*                         verify_all_blocks                             *)
# Line 1284  let rec split_range r range_size = Line 1284  let rec split_range r range_size =
1284    assert (r.range_current_begin = r.range_begin);    assert (r.range_current_begin = r.range_begin);
1285    let next_range = r.range_begin ++ range_size in    let next_range = r.range_begin ++ range_size in
1286  (*  lprintf "   split_range: next_range %Ld\n" next_range; *)  (*  lprintf "   split_range: next_range %Ld\n" next_range; *)
1287    if r.range_end > next_range then    if r.range_end > next_range then
1288      let rr = {      let rr = {
1289          range_block = r.range_block;          range_block = r.range_block;
1290          range_nuploading = 0;          range_nuploading = 0;
1291          range_next = r.range_next;          range_next = r.range_next;
1292          range_prev = Some r;          range_prev = Some r;
1293          range_begin = next_range;          range_begin = next_range;
1294          range_current_begin = next_range;          range_current_begin = next_range;
1295          range_end = r.range_end;          range_end = r.range_end;
# Line 1297  let rec split_range r range_size = Line 1297  let rec split_range r range_size =
1297      begin      begin
1298        match r.range_next with        match r.range_next with
1299          None -> ()          None -> ()
1300        | Some rrr ->        | Some rrr ->
1301  (*          lprintf "Another one ??\n"; *)  (*          lprintf "Another one ??\n"; *)
1302            rrr.range_prev <- Some rr;            rrr.range_prev <- Some rr;
1303      end;      end;
1304      r.range_next <- Some rr;      r.range_next <- Some rr;
1305      r.range_end <- next_range;      r.range_end <- next_range;
1306  (*    lprintf "      NEW RANGE: %Ld- OLD RANGE: %Ld-%Ld\n"  (*    lprintf "      NEW RANGE: %Ld- OLD RANGE: %Ld-%Ld\n"
1307        rr.range_begin r.range_begin r.range_end; *)        rr.range_begin r.range_begin r.range_end; *)
1308        
1309      split_range rr range_size      split_range rr range_size
1310    
1311    
# Line 1320  let new_block s i = Line 1320  let new_block s i =
1320    let block_end = compute_block_end s i in    let block_end = compute_block_end s i in
1321    let rec b = {    let rec b = {
1322        block_s = s;        block_s = s;
1323          
1324        block_begin = block_begin;        block_begin = block_begin;
1325        block_end = block_end;        block_end = block_end;
1326        block_ranges = range;        block_ranges = range;
1327        block_num = i;        block_num = i;
1328        block_remaining = block_end -- block_begin;        block_remaining = block_end -- block_begin;
1329      }      }
1330      
1331    and range = {    and range = {
1332        range_prev = None;        range_prev = None;
1333        range_next = None;        range_next = None;
# Line 1338  let new_block s i = Line 1338  let new_block s i =
1338        range_current_begin = block_begin;        range_current_begin = block_begin;
1339      }      }
1340    in    in
1341      
1342  (*  lprintf "New block %Ld-%Ld\n" block_begin block_end; *)  (*  lprintf "New block %Ld-%Ld\n" block_begin block_end; *)
1343    split_range range s.s_range_size;    split_range range s.s_range_size;
1344      
1345  (*  (*
1346    let rec iter r =    let rec iter r =
1347      lprintf "  Range %Ld-%Ld\n" r.range_begin r.range_end;      lprintf "  Range %Ld-%Ld\n" r.range_begin r.range_end;
1348      match r.range_next with      match r.range_next with
1349        None -> ()        None -> ()
1350      | Some r -> iter r      | Some r -> iter r
1351    in    in
1352    iter b.block_ranges;    iter b.block_ranges;
1353  *)  *)
1354      
1355    s.s_blocks.(i) <- PartialBlock b;    s.s_blocks.(i) <- PartialBlock b;
1356    if s.s_verified_bitmap.[i] < '1' then    if s.s_verified_bitmap.[i] < '1' then
1357      set_bitmap_1 s i;      set_bitmap_1 s i;
# Line 1364  let new_block s i = Line 1364  let new_block s i =
1364  (*                         next_range (internal)                         *)  (*                         next_range (internal)                         *)
1365  (*                                                                       *)  (*                                                                       *)
1366  (*************************************************************************)  (*************************************************************************)
1367      
1368  (*  (*
1369  let next_range f r =  let next_range f r =
1370    match r.range_next with    match r.range_next with
# Line 1372  let next_range f r = Line 1372  let next_range f r =
1372    | Some rr -> f rr    | Some rr -> f rr
1373          *)          *)
1374    
1375            
1376  (*************************************************************************)  (*************************************************************************)
1377  (*                                                                       *)  (*                                                                       *)
1378  (*                         add_all_downloaded                            *)  (*                         add_all_downloaded                            *)
# Line 1380  let next_range f r = Line 1380  let next_range f r =
1380  (*************************************************************************)  (*************************************************************************)
1381    
1382  (*  (*
1383  let add_all_downloaded t old_downloaded =  let add_all_downloaded t old_downloaded =
1384    let new_downloaded = t.t_downloaded in    let new_downloaded = t.t_downloaded in
1385    if new_downloaded <> old_downloaded then    if new_downloaded <> old_downloaded then
1386      add_file_downloaded t.t_file (new_downloaded -- old_downloaded)      add_file_downloaded t.t_file (new_downloaded -- old_downloaded)
1387      *)      *)
1388    
# Line 1396  let range_received maybe_t r chunk_begin Line 1396  let range_received maybe_t r chunk_begin
1396  (*  lprintf "   range_received: %Ld-%Ld for %Ld-%Ld\n"  (*  lprintf "   range_received: %Ld-%Ld for %Ld-%Ld\n"
1397      chunk_begin chunk_end r.range_begin r.range_end;  *)      chunk_begin chunk_end r.range_begin r.range_end;  *)
1398    if r.range_begin < chunk_end && r.range_end > chunk_begin then begin    if r.range_begin < chunk_end && r.range_end > chunk_begin then begin
1399          
1400  (*      lprintf "... entered\n"; *)  (*      lprintf "... entered\n"; *)
1401        let new_current_begin =        let new_current_begin =
1402          max (min chunk_end r.range_end) r.range_current_begin in          max (min chunk_end r.range_end) r.range_current_begin in
1403        let downloaded = new_current_begin -- r.range_current_begin in        let downloaded = new_current_begin -- r.range_current_begin in
1404        let b = r.range_block in        let b = r.range_block in
# Line 1411  let range_received maybe_t r chunk_begin Line 1411  let range_received maybe_t r chunk_begin
1411                None -> ()                None -> ()
1412              | Some rr -> rr.range_prev <- r.range_prev);              | Some rr -> rr.range_prev <- r.range_prev);
1413            (match r.range_prev with            (match r.range_prev with
1414                None ->                None ->
1415                  begin                  begin
1416                    match r.range_next with                    match r.range_next with
1417                      None ->                      None ->
1418                        begin                        begin
1419                          match s.s_blocks.(b.block_num) with                          match s.s_blocks.(b.block_num) with
1420                            PartialBlock _ | EmptyBlock ->                            PartialBlock _ | EmptyBlock ->
1421                                
1422                              begin                              begin
1423                                match s.s_networks with                                match s.s_networks with
1424                                  [] -> assert false                                  [] -> assert false
1425                                | t :: _ when t.t_primary ->                                | t :: _ when t.t_primary ->
1426                                    begin                                    begin
# Line 1480  let set_present_block b chunk_begin chun Line 1480  let set_present_block b chunk_begin chun
1480  (*                                                                       *)  (*                                                                       *)
1481  (*************************************************************************)  (*************************************************************************)
1482    
1483  let set_present s chunks =  let set_present s chunks =
1484      
1485    apply_intervals s (fun i block_begin block_end chunk_begin chunk_end ->    apply_intervals s (fun i block_begin block_end chunk_begin chunk_end ->
1486  (*      lprintf "interval: %Ld-%Ld in block %d [%Ld-%Ld]\n"  (*      lprintf "interval: %Ld-%Ld in block %d [%Ld-%Ld]\n"
1487        chunk_begin chunk_end i block_begin block_end;  *)        chunk_begin chunk_end i block_begin block_end;  *)
# Line 1502  let set_present s chunks = Line 1502  let set_present s chunks =
1502        | PartialBlock b ->        | PartialBlock b ->
1503  (*          lprintf "  PartialBlock\n"; *)  (*          lprintf "  PartialBlock\n"; *)
1504            set_present_block b chunk_begin chunk_end            set_present_block b chunk_begin chunk_end
1505        | _ ->        | _ ->
1506  (*          lprintf "  Other\n"; *)  (*          lprintf "  Other\n"; *)
1507            ()            ()
1508    ) chunks    ) chunks
1509      
1510  (*************************************************************************)  (*************************************************************************)
1511  (*                                                                       *)  (*                                                                       *)
1512  (*                         end_present (internal)                        *)  (*                         end_present (internal)                        *)
# Line 1516  let set_present s chunks = Line 1516  let set_present s chunks =
1516  let rec end_present present begin_present end_file list =  let rec end_present present begin_present end_file list =
1517    match list with    match list with
1518      [] ->      [] ->
1519        let present =        let present =
1520          if begin_present = end_file then present else          if begin_present = end_file then present else
1521            (begin_present, end_file) :: present            (begin_present, end_file) :: present
1522        in        in
1523        List.rev present        List.rev present
1524    | (begin_absent, end_absent) :: tail ->    | (begin_absent, end_absent) :: tail ->
1525        let present =        let present =
1526          if begin_present = begin_absent then present          if begin_present = begin_absent then present
1527          else (begin_present, begin_absent) :: present          else (begin_present, begin_absent) :: present
1528        in        in
# Line 1534  let rec end_present present begin_presen Line 1534  let rec end_present present begin_presen
1534  (*                                                                       *)  (*                                                                       *)
1535  (*************************************************************************)  (*************************************************************************)
1536    
1537  let set_absent s list =  let set_absent s list =
1538  (* reverse absent/present in the list and call set_present *)  (* reverse absent/present in the list and call set_present *)
1539    let list =    let list =
1540      match list with [] -> [ Int64.zero, s.s_size ]      match list with [] -> [ Int64.zero, s.s_size ]
1541      | (t1,t2) :: tail ->      | (t1,t2) :: tail ->
1542          if t1 = zero then          if t1 = zero then
# Line 1550  let set_absent s list = Line 1550  let set_absent s list =
1550  (*                                                                       *)  (*                                                                       *)
1551  (*                         chunks_to_string (internal)                   *)  (*                         chunks_to_string (internal)                   *)
1552  (*                                                                       *)  (*                                                                       *)
1553  (*************************************************************************)  (*************************************************************************)
1554    
1555  let chunks_to_string s chunks =  let chunks_to_string s chunks =
1556    match chunks with    match chunks with
# Line 1576  let chunks_to_string s chunks = Line 1576  let chunks_to_string s chunks =
1576  (*                                                                       *)  (*                                                                       *)
1577  (*                         update_uploader_chunks (internal)             *)  (*                         update_uploader_chunks (internal)             *)
1578  (*                                                                       *)  (*                                                                       *)
1579  (*************************************************************************)  (*************************************************************************)
1580    
1581  let update_uploader_chunks up chunks =  let update_uploader_chunks up chunks =
1582    if not up.up_declared then    if not up.up_declared then
1583      let t = up.up_t in      let t = up.up_t in
1584      let s = t.t_s in      let s = t.t_s in
1585  (* INVARIANT: complete_blocks must be in reverse order *)  (* INVARIANT: complete_blocks must be in reverse order *)
1586        
1587      let complete_blocks = ref [] in      let complete_blocks = ref [] in
1588      let partial_blocks = ref [] in      let partial_blocks = ref [] in
1589        
1590      begin      begin
1591        match chunks with        match chunks with
1592          AvailableRanges chunks ->          AvailableRanges chunks ->
1593              
1594            apply_intervals s (fun i block_begin block_end            apply_intervals s (fun i block_begin block_end
1595                  chunk_begin chunk_end ->                  chunk_begin chunk_end ->
1596  (*              lprintf "apply_intervals %d %Ld-%Ld %Ld-%Ld\n"  (*              lprintf "apply_intervals %d %Ld-%Ld %Ld-%Ld\n"
1597                  i block_begin block_end chunk_begin chunk_end; *)                  i block_begin block_end chunk_begin chunk_end; *)
1598                s.s_availability.(i) <- s.s_availability.(i) + 1;                s.s_availability.(i) <- s.s_availability.(i) + 1;
1599                  
1600                match s.s_blocks.(i) with                match s.s_blocks.(i) with
1601                  CompleteBlock | VerifiedBlock -> ()                  CompleteBlock | VerifiedBlock -> ()
1602                | _ ->                | _ ->
1603                    if block_begin = chunk_begin && block_end = chunk_end then                    if block_begin = chunk_begin && block_end = chunk_end then
1604                      complete_blocks := i :: !complete_blocks                      complete_blocks := i :: !complete_blocks
1605                    else                    else
1606                      partial_blocks :=                      partial_blocks :=
1607                      (i, chunk_begin, chunk_end) :: !partial_blocks                      (i, chunk_begin, chunk_end) :: !partial_blocks
1608            ) chunks;            ) chunks;
1609          
1610        | AvailableCharBitmap string ->        | AvailableCharBitmap string ->
1611            for i = 0 to String.length string - 1 do            for i = 0 to String.length string - 1 do
1612              if string.[i] = '1' then              if string.[i] = '1' then
1613                List.iter (fun i ->                            List.iter (fun i ->
1614                    s.s_availability.(i) <- s.s_availability.(i) + 1;                    s.s_availability.(i) <- s.s_availability.(i) + 1;
1615                    complete_blocks := i :: !complete_blocks                    complete_blocks := i :: !complete_blocks
1616                ) t.t_t2s_blocks.(i)                ) t.t_t2s_blocks.(i)
1617            done;            done;
1618        | AvailableBoolBitmap bitmap ->        | AvailableBoolBitmap bitmap ->
1619            for i = 0 to Array.length bitmap - 1 do            for i = 0 to Array.length bitmap - 1 do
1620              if bitmap.(i) then              if bitmap.(i) then
1621                List.iter (fun i ->                List.iter (fun i ->
1622                    s.s_availability.(i) <- s.s_availability.(i) + 1;                    s.s_availability.(i) <- s.s_availability.(i) + 1;
1623                    complete_blocks := i :: !complete_blocks                    complete_blocks := i :: !complete_blocks
1624                ) t.t_t2s_blocks.(i)                ) t.t_t2s_blocks.(i)
1625            done;            done;
1626      end;      end;
1627        
1628      List.iter (fun i ->      List.iter (fun i ->
1629  (*        s.s_last_seen.(i) <- BasicSocket.last_time (); *)  (*        s.s_last_seen.(i) <- BasicSocket.last_time (); *)
1630            
1631          let i = t.t_s2t_blocks.(i) in          let i = t.t_s2t_blocks.(i) in
1632          t.t_last_seen.(i) <- BasicSocket.last_time ()          t.t_last_seen.(i) <- BasicSocket.last_time ()
1633            
1634      ) !complete_blocks;      ) !complete_blocks;
1635        
1636      let complete_blocks = Array.of_list !complete_blocks in      let complete_blocks = Array.of_list !complete_blocks in
1637      let partial_blocks = Array.of_list !partial_blocks in      let partial_blocks = Array.of_list !partial_blocks in
1638      up.up_chunks <- chunks;      up.up_chunks <- chunks;
1639        
1640      up.up_complete_blocks <- complete_blocks;      up.up_complete_blocks <- complete_blocks;
1641      up.up_ncomplete <- Array.length complete_blocks;      up.up_ncomplete <- Array.length complete_blocks;
1642        
1643      if Array.length partial_blocks > 0 then      if Array.length partial_blocks > 0 then
1644        lprintf "WARNING: partial_blocks = %d\n" (Array.length partial_blocks);        lprintf "WARNING: partial_blocks = %d\n" (Array.length partial_blocks);
1645      up.up_partial_blocks <- partial_blocks;      up.up_partial_blocks <- partial_blocks;
1646      up.up_npartial <- Array.length partial_blocks;      up.up_npartial <- Array.length partial_blocks;
1647        
1648      up.up_block <- None;      up.up_block <- None;
1649      up.up_block_begin <- zero;      up.up_block_begin <- zero;
1650      up.up_block_end <- zero;      up.up_block_end <- zero;
1651        
1652      up.up_declared <- true;      up.up_declared <- true;
1653    
1654      let bm = chunks_to_string s chunks in      let bm = chunks_to_string s chunks in
# Line 1660  let update_uploader_chunks up chunks = Line 1660  let update_uploader_chunks up chunks =
1660  (*                                                                       *)  (*                                                                       *)
1661  (*                         clean_uploader_chunks (internal)              *)  (*                         clean_uploader_chunks (internal)              *)
1662  (*                                                                       *)  (*                                                                       *)
1663  (*************************************************************************)  (*************************************************************************)
1664    
1665    
1666  let clean_uploader_chunks up =  let clean_uploader_chunks up =
1667      
1668    if up.up_declared then    if up.up_declared then
1669        
1670      let decr_availability s i =      let decr_availability s i =
1671        s.s_availability.(i) <- s.s_availability.(i) - 1        s.s_availability.(i) <- s.s_availability.(i) - 1
1672      in      in
1673  (*          lprintf "clean_uploader_chunks:\n"; *)  (*          lprintf "clean_uploader_chunks:\n"; *)
1674        
1675      let t = up.up_t in      let t = up.up_t in
1676      let s = t.t_s in      let s = t.t_s in
1677      for i = 0 to Array.length up.up_complete_blocks - 1 do      for i = 0 to Array.length up.up_complete_blocks - 1 do
# Line 1691  let clean_uploader_chunks up = Line 1691  let clean_uploader_chunks up =
1691  (*                                                                       *)  (*                                                                       *)
1692  (*                         register_uploader                             *)  (*                         register_uploader                             *)
1693  (*                                                                       *)  (*                                                                       *)
1694  (*************************************************************************)  (*************************************************************************)
1695    
1696  let register_uploader t client chunks =  let register_uploader t client chunks =
1697      
1698    let up =    let up =
1699      {      {
1700        up_t = t;        up_t = t;
1701        up_client = client;        up_client = client;
1702          
1703        up_declared = false;        up_declared = false;
1704        up_chunks = chunks;        up_chunks = chunks;
1705          
1706        up_complete_blocks = [||];        up_complete_blocks = [||];
1707        up_ncomplete = 0;        up_ncomplete = 0;
1708          
1709        up_partial_blocks = [||];        up_partial_blocks = [||];
1710        up_npartial = 0;        up_npartial = 0;
1711          
1712        up_block = None;        up_block = None;
1713        up_block_begin = zero;        up_block_begin = zero;
1714        up_block_end = zero;        up_block_end = zero;
# Line 1723  let register_uploader t client chunks = Line 1723  let register_uploader t client chunks =
1723  (*                                                                       *)  (*                                                                       *)
1724  (*                         unregister_uploader                           *)  (*                         unregister_uploader                           *)
1725  (*                                                                       *)  (*                                                                       *)
1726  (*************************************************************************)  (*************************************************************************)
1727    
1728  let unregister_uploader up =  let unregister_uploader up =
1729    clean_uploader_chunks up;    clean_uploader_chunks up;
1730    clear_uploader_block up;    clear_uploader_block up;
1731    clear_uploader_ranges up    clear_uploader_ranges up
# Line 1734  let unregister_uploader up = Line 1734  let unregister_uploader up =
1734  (*                                                                       *)  (*                                                                       *)
1735  (*                         update_uploader                               *)  (*                         update_uploader                               *)
1736  (*                                                                       *)  (*                                                                       *)
1737  (*************************************************************************)  (*************************************************************************)
1738    
1739    let update_uploader up chunks =
1740    
 let update_uploader up chunks =  
     
1741    clean_uploader_chunks up;    clean_uploader_chunks up;
1742    update_uploader_chunks up chunks    update_uploader_chunks up chunks
1743    
# Line 1750  let update_uploader up chunks = Line 1750  let update_uploader up chunks =
1750  let print_uploaders s =  let print_uploaders s =
1751    let nblocks = Array.length s.s_blocks in    let nblocks = Array.length s.s_blocks in
1752    for i = 0 to nblocks - 1 do    for i = 0 to nblocks - 1 do
1753        
1754      match s.s_blocks.(i) with      match s.s_blocks.(i) with
1755        EmptyBlock -> lprintf "_"        EmptyBlock -> lprintf "_"
1756      | CompleteBlock -> lprintf "C"      | CompleteBlock -> lprintf "C"
# Line 1763  let print_uploaders s = Line 1763  let print_uploaders s =
1763    done;    done;
1764    lprintf "\n";    lprintf "\n";
1765    for i = 0 to nblocks - 1 do    for i = 0 to nblocks - 1 do
1766        
1767      match s.s_blocks.(i) with      match s.s_blocks.(i) with
1768        EmptyBlock -> lprintf "_"        EmptyBlock -> lprintf "_"
1769      | CompleteBlock -> lprintf "C"      | CompleteBlock -> lprintf "C"
1770      | VerifiedBlock -> lprintf "V"      | VerifiedBlock -> lprintf "V"
1771      | PartialBlock b ->      | PartialBlock b ->
1772          lprintf "{%d : %d=" b.block_num          lprintf "{ %d : %d=" b.block_num
1773            s.s_nuploading.(b.block_num);            s.s_nuploading.(b.block_num);
1774            
1775          let rec iter_range r =          let rec iter_range r =
1776            lprintf "(%d)" r.range_nuploading;            lprintf "(%d)" r.range_nuploading;
1777            match r.range_next with            match r.range_next with
# Line 1780  let print_uploaders s = Line 1780  let print_uploaders s =
1780          in          in
1781          iter_range b.block_ranges;          iter_range b.block_ranges;
1782          lprintf " }";          lprintf " }";
1783      
1784    done;    done;
1785    lprintf "\n"    lprintf "\n"
1786    
# Line 1801  let permute_and_return up n = Line 1801  let permute_and_return up n =
1801    let t = up.up_t in    let t = up.up_t in
1802    let s = t.t_s in    let s = t.t_s in
1803    match s.s_blocks.(b) with    match s.s_blocks.(b) with
1804      EmptyBlock ->      EmptyBlock ->
1805        let b = new_block s b in        let b = new_block s b in
1806        b, b.block_begin, b.block_end        b, b.block_begin, b.block_end
1807    | PartialBlock b ->    | PartialBlock b ->
1808        b, b.block_begin, b.block_end        b, b.block_begin, b.block_end
1809    | VerifiedBlock ->    | VerifiedBlock ->
1810        lprintf "ERROR: verified block in permute_and_return %d\n" b;        lprintf "ERROR: verified block in permute_and_return %d\n" b;
1811        assert false        assert false
1812    | CompleteBlock ->    | CompleteBlock ->
1813        lprintf "ERROR: complete block in permute_and_return %d\n" b;        lprintf "ERROR: complete block in permute_and_return %d\n" b;
1814        assert false        assert false
1815          
1816  (*************************************************************************)  (*************************************************************************)
1817  (*                                                                       *)  (*                                                                       *)
1818  (*                         LinearStrategy.select_block (internal)            *)  (*                         LinearStrategy.select_block (internal)            *)
# Line 1830  module LinearStrategy = struct Line 1830  module LinearStrategy = struct
1830          let t = up.up_t in          let t = up.up_t in
1831          let s = t.t_s in          let s = t.t_s in
1832          match s.s_blocks.(b) with          match s.s_blocks.(b) with
1833            CompleteBlock | VerifiedBlock ->            CompleteBlock | VerifiedBlock ->
1834              iter_complete up              iter_complete up
1835          | PartialBlock b ->          | PartialBlock b ->
1836              b, b.block_begin, b.block_end              b, b.block_begin, b.block_end
1837          | EmptyBlock ->          | EmptyBlock ->
1838              let b = new_block s b in              let b = new_block s b in
1839              b, b.block_begin, b.block_end              b, b.block_begin, b.block_end
1840          
1841        and iter_partial up =        and iter_partial up =
1842          let n = up.up_npartial in          let n = up.up_npartial in
1843          if n = 0 then raise Not_found;          if n = 0 then raise Not_found;
# Line 1846  module LinearStrategy = struct Line 1846  module LinearStrategy = struct
1846          let t = up.up_t in          let t = up.up_t in
1847          let s = t.t_s in          let s = t.t_s in
1848          match s.s_blocks.(b) with          match s.s_blocks.(b) with
1849            CompleteBlock | VerifiedBlock ->            CompleteBlock | VerifiedBlock ->
1850              iter_partial up              iter_partial up
1851          | PartialBlock b ->          | PartialBlock b ->
1852              b, block_begin, block_end              b, block_begin, block_end
1853          | EmptyBlock ->          | EmptyBlock ->
1854              let b = new_block s b in              let b = new_block s b in
# Line 1865  module LinearStrategy = struct Line 1865  module LinearStrategy = struct
1865    
1866  let should_download_block s n =  let should_download_block s n =
1867  (*  lprintf "should_download_block %d\n" n; *)  (*  lprintf "should_download_block %d\n" n; *)
1868    let result =    let result =
1869      match s.s_verified_bitmap.[n] with      match s.s_verified_bitmap.[n] with
1870        '2' ->        '2' ->
1871          begin          begin
# Line 1888  let should_download_block s n = Line 1888  let should_download_block s n =
1888  (*  if result then  (*  if result then
1889      lprintf "should_download_block %d\n" n; *)      lprintf "should_download_block %d\n" n; *)
1890    result    result
1891      
1892  (*************************************************************************)  (*************************************************************************)
1893  (*                                                                       *)  (*                                                                       *)
1894  (*                         select_block (internal)                       *)  (*                         select_block (internal)                       *)
# Line 1897  let should_download_block s n = Line 1897  let should_download_block s n =
1897    
1898  exception BlockFound of int  exception BlockFound of int
1899    
1900  let random_int max =  let random_int max =
1901    let x = Random.int max in    let x = Random.int max in
1902    if debug_all then lprintf "(Random %d -> %d)" max x;    if debug_all then lprintf "(Random %d -> %d)" max x;
1903    x    x
# Line 1909  let select_block up = Line 1909  let select_block up =
1909      match s.s_strategy with      match s.s_strategy with
1910        LinearStrategy ->        LinearStrategy ->
1911          LinearStrategy.select_block up          LinearStrategy.select_block up
1912      | _ ->      | _ ->
1913          if up.up_ncomplete = 0 && up.up_npartial = 0 then raise Not_found;          if up.up_ncomplete = 0 && up.up_npartial = 0 then raise Not_found;
1914    
1915  (**************  (**************
1916    
1917  This strategy sucks. It has to be improved.  This strategy sucks. It has to be improved.
1918  Important:  Important:
1919  1) never give a block to 2 clients if another one has 0 client.  1) never give a block to 2 clients if another one has 0 client.
1920  2) try to complete partial blocks as soon as possible.  2) try to complete partial blocks as soon as possible.
1921  3) comfigure the chooser depending on the network (maybe BT might  3) comfigure the chooser depending on the network (maybe BT might
# Line 1923  better work at the beginning if the firs Line 1923  better work at the beginning if the firs
1923      to several clients.      to several clients.
1924    
1925  ***************)  ***************)
1926            
1927            
1928            
1929          if up.up_ncomplete > 1 then begin          if up.up_ncomplete > 1 then begin
1930  (*          let debug_all = true in *)  (*          let debug_all = true in *)
1931              try              try
1932                  
1933                let rec iter_max_uploaders max_nuploaders =                let rec iter_max_uploaders max_nuploaders =
1934                  let t = up.up_t in                  let t = up.up_t in
1935                  let nblocks = Array.length s.s_blocks in                  let nblocks = Array.length s.s_blocks in
1936    
1937  (*************   Try to download the movie index and the first minute to  (*************   Try to download the movie index and the first minute to
1938     allow preview of the file as soon as possible *)     allow preview of the file as soon as possible *)
1939                    
1940                  if debug_all then lprintf "{First}";                  if debug_all then lprintf "{First}";
1941                    
1942                  let download_first n b =                  let download_first n b =
1943  (*                lprintf "download_first %d\n" n; *)  (*                lprintf "download_first %d\n" n; *)
1944                    if                    if
1945                      up.up_complete_blocks.(n) = b &&                      up.up_complete_blocks.(n) = b &&
1946                      s.s_nuploading.(b) < max_nuploaders &&                      s.s_nuploading.(b) < max_nuploaders &&
1947                      should_download_block s b then                      should_download_block s b then
1948                      raise (BlockFound n)                      raise (BlockFound n)
1949                  in                  in
1950    
1951  (*              lprintf "up_complete_blocks: %d\n"  (*              lprintf "up_complete_blocks: %d\n"
1952                  (Array.length up.up_complete_blocks); *)                  (Array.length up.up_complete_blocks); *)
1953    
1954  (* This must be the position of the last block of the file *)  (* This must be the position of the last block of the file *)
# Line 1967  better work at the beginning if the firs Line 1967  better work at the beginning if the firs
1967    
1968  (************* If the file can be verified, and we don't have a lot of blocks  (************* If the file can be verified, and we don't have a lot of blocks
1969      yet, try to download the partial ones as soon as possible *)      yet, try to download the partial ones as soon as possible *)
1970                    
1971                  if debug_all then lprintf "{PartialBlock}";                  if debug_all then lprintf "{PartialBlock}";
1972                    
1973                  let download_partial max_uploaders =                  let download_partial max_uploaders =
1974                    let partial_block = ref (-1) in                    let partial_block = ref (-1) in
1975                    let partial_remaining = ref zero in                    let partial_remaining = ref zero in
# Line 1984  better work at the beginning if the firs Line 1984  better work at the beginning if the firs
1984                            begin                            begin
1985                              partial_block := i;                              partial_block := i;
1986                              partial_remaining := b.block_remaining                              partial_remaining := b.block_remaining
1987                            end                                                      end
1988                      | _ -> ()                      | _ -> ()
1989                    done;                    done;
1990                    if !partial_block <> -1 then                    if !partial_block <> -1 then
1991                      raise (BlockFound !partial_block)                      raise (BlockFound !partial_block)
1992                  in                  in
1993                    
1994                  if t.t_verifier <> NoVerification &&                  if t.t_verifier <> NoVerification &&
1995                    t.t_nverified_blocks  < 2  then begin                    t.t_nverified_blocks  < 2  then begin
1996                      download_partial max_nuploaders;                      download_partial max_nuploaders;
1997                    end;                    end;
1998    
1999  (************* Download partial chunks from the verification point of view *)  (************* Download partial chunks from the verification point of view *)
2000                    
2001                  if List.length s.s_networks > 1 then begin                  if List.length s.s_networks > 1 then begin
2002                      if debug_all then lprintf "{PartialChunk}";                      if debug_all then lprintf "{PartialChunk}";
2003                        
2004                      let my_t = if t.t_verifier <> NoVerification then t                      let my_t = if t.t_verifier <> NoVerification then t
2005                        else match s.s_networks with t :: _ -> t | _ -> t in                        else match s.s_networks with t :: _ -> t | _ -> t in
2006                        
2007                      let download_partial max_uploaders =                      let download_partial max_uploaders =
2008                        let partial_block = ref (-1) in                        let partial_block = ref (-1) in
2009                        let partial_remaining = ref 0 in                        let partial_remaining = ref 0 in
2010                        for i = 0 to up.up_ncomplete - 1 do                        for i = 0 to up.up_ncomplete - 1 do
2011                          let n = up.up_complete_blocks.(i) in                          let n = up.up_complete_blocks.(i) in
2012  (* TODO move this after the first if... *)  (* TODO move this after the first if... *)
2013                          let t_index = t.t_s2t_blocks.(n) in                                                let t_index = t.t_s2t_blocks.(n) in
2014                          let bs = List.filter (fun s_index ->                          let bs = List.filter (fun s_index ->
2015                                s.s_verified_bitmap.[s_index] = '2'                                s.s_verified_bitmap.[s_index] = '2'
2016                            ) t.t_t2s_blocks.(t_index) in                            ) t.t_t2s_blocks.(t_index) in
# Line 2018  better work at the beginning if the firs Line 2018  better work at the beginning if the firs
2018    
2019  (* TODO remove this *)  (* TODO remove this *)
2020                          let b = should_download_block s n in                          let b = should_download_block s n in
2021                            
2022                          if !verbose_swarming then begin                          if !verbose_swarming then begin
2023                              lprintf "  test %d %c %d %b %d\n"                              lprintf "  test %d %c %d %b %d\n"
2024                                n s.s_verified_bitmap.[n] s.s_nuploading.(n)                                n s.s_verified_bitmap.[n] s.s_nuploading.(n)
2025                              b nbs;                              b nbs;
2026                            end;                            end;
2027                            
2028                          if s.s_verified_bitmap.[n] < '2' &&                          if s.s_verified_bitmap.[n] < '2' &&
2029                            s.s_nuploading.(n) < max_uploaders &&                            s.s_nuploading.(n) < max_uploaders &&
2030                            should_download_block s n then                            should_download_block s n then
2031                              
2032                            if (!partial_block = -1 || !partial_remaining < nbs)                            if (!partial_block = -1 || !partial_remaining < nbs)
2033                            then                            then
2034                              begin                              begin
# Line 2043  better work at the beginning if the firs Line 2043  better work at the beginning if the firs
2043                            raise (BlockFound !partial_block)                            raise (BlockFound !partial_block)
2044                          end                          end
2045                      in                      in
2046                        
2047                      if my_t.t_verifier <> NoVerification then begin                      if my_t.t_verifier <> NoVerification then begin
2048                          download_partial max_nuploaders;                          download_partial max_nuploaders;
2049                        end;                        end;
2050                    end;                                  end;
2051    
2052  (************* Download rarest first only if other blocks are much more  (************* Download rarest first only if other blocks are much more
2053    available *)    available *)
2054                    
2055                  if debug_all then lprintf "{Rarest}";                  if debug_all then lprintf "{Rarest}";
2056                    
2057                  let sum_availability = ref 0 in                  let sum_availability = ref 0 in
2058                  let min_availability = ref max_int in                  let min_availability = ref max_int in
2059                  for i = 0 to up.up_ncomplete - 1 do                  for i = 0 to up.up_ncomplete - 1 do
2060                    let n = up.up_complete_blocks.(i) in                    let n = up.up_complete_blocks.(i) in
2061                    sum_availability := !sum_availability +                    sum_availability := !sum_availability +
2062                      s.s_availability.(n);                      s.s_availability.(n);
2063                    min_availability := min !min_availability                    min_availability := min !min_availability
2064                      s.s_availability.(n);                      s.s_availability.(n);
2065                  done;                  done;
2066                    
2067                  let mean_availability =                  let mean_availability =
2068                    !sum_availability / up.up_ncomplete in                    !sum_availability / up.up_ncomplete in
2069                    
2070                  if mean_availability > 5 && !min_availability < 3 then                  if mean_availability > 5 && !min_availability < 3 then
2071                    for i = 0 to up.up_ncomplete - 1 do                    for i = 0 to up.up_ncomplete - 1 do
2072                      let n = up.up_complete_blocks.(i) in                      let n = up.up_complete_blocks.(i) in
2073                      if s.s_availability.(n) < 3                      if s.s_availability.(n) < 3
2074                          && should_download_block s n                          && should_download_block s n
2075                      then                      then
2076                        raise (BlockFound i)                        raise (BlockFound i)
2077                    done;                    done;
2078    
2079  (************* Otherwise, download in random order *)  (************* Otherwise, download in random order *)
2080                    
2081                  if debug_all then lprintf "{Random}";                  if debug_all then lprintf "{Random}";
2082                  let find_random max_uploaders =                  let find_random max_uploaders =
2083                    let list = ref [] in                    let list = ref [] in
# Line 2097  better work at the beginning if the firs Line 2097  better work at the beginning if the firs
2097                        raise (BlockFound (array.(                        raise (BlockFound (array.(
2098                              random_int (Array.length array))))                              random_int (Array.length array))))
2099                  in                  in
2100                    
2101                  find_random max_nuploaders                  find_random max_nuploaders
2102    
2103  (************* Fall back on linear download if nothing worked *)  (************* Fall back on linear download if nothing worked *)
2104                  
2105                in                in
2106                iter_max_uploaders 1;                iter_max_uploaders 1;
2107                iter_max_uploaders max_clients_per_block;                iter_max_uploaders max_clients_per_block;
2108                iter_max_uploaders max_int;                iter_max_uploaders max_int;
2109                raise Not_found                raise Not_found
2110              with              with
2111                BlockFound n ->                BlockFound n ->
2112                  if debug_all then lprintf "\nBlockFound %d\n"                  if debug_all then lprintf "\nBlockFound %d\n"
2113                      up.up_complete_blocks.(n);                      up.up_complete_blocks.(n);
2114                  permute_and_return up n                  permute_and_return up n
2115            end else            end else
2116            LinearStrategy.select_block up            LinearStrategy.select_block up
2117    with Not_found ->    with Not_found ->
2118          
2119        (* print_s "NO BLOCK FOUND" s; *)        (* print_s "NO BLOCK FOUND" s; *)
2120        raise Not_found        raise Not_found
2121          
2122      (*************************************************************************)      (*************************************************************************)
2123  (*                                                                       *)  (*                                                                       *)
2124  (*                         find_block                                    *)  (*                         find_block                                    *)
# Line 2126  better work at the beginning if the firs Line 2126  better work at the beginning if the firs
2126  (*************************************************************************)  (*************************************************************************)
2127    
2128  let find_block up =  let find_block up =
2129    try          try
2130      if debug_all then begin      if debug_all then begin
2131          lprintf "C: ";          lprintf "C: ";
2132          for i = 0 to up.up_ncomplete - 1 do          for i = 0 to up.up_ncomplete - 1 do
2133            lprintf "%d " up.up_complete_blocks.(i)            lprintf "%d " up.up_complete_blocks.(i)
2134          done;          done;
2135        end;        end;
2136        
2137      let t = up.up_t in      let t = up.up_t in
2138      let s = t.t_s in      let s = t.t_s in
2139      match file_state t.t_file with      match file_state t.t_file with
2140      | FilePaused      | FilePaused
2141      | FileAborted _      | FileAborted _
2142      | FileCancelled -> raise Not_found      | FileCancelled -> raise Not_found
2143      | _ ->      | _ ->
2144            
2145            
2146          (match up.up_block with          (match up.up_block with
2147              None -> ()              None -> ()
2148            | Some b ->            | Some b ->
# Line 2150  let find_block up = Line 2150  let find_block up =
2150                s.s_nuploading.(num) <- s.s_nuploading.(num) - 1;                s.s_nuploading.(num) <- s.s_nuploading.(num) - 1;
2151                up.up_block <- None;                up.up_block <- None;
2152          );          );
2153            
2154          let (b,block_begin,block_end) as result = select_block up in          let (b,block_begin,block_end) as result = select_block up in
2155          let num = b.block_num in          let num = b.block_num in
2156          s.s_nuploading.(num) <- s.s_nuploading.(num) + 1;          s.s_nuploading.(num) <- s.s_nuploading.(num) + 1;
# Line 2170  let find_block up = Line 2170  let find_block up =
2170  (*************************************************************************)  (*************************************************************************)
2171    
2172  let clean_ranges up =  let clean_ranges up =
2173      
2174    let rec iter list left =    let rec iter list left =
2175      match list with      match list with
2176        [] -> List.rev left        [] -> List.rev left
# Line 2198  let current_ranges up =  up.up_ranges Line 2198  let current_ranges up =  up.up_ranges
2198  (*                                                                       *)  (*                                                                       *)
2199  (*************************************************************************)  (*************************************************************************)
2200    
2201  let current_block up =    let current_block up =
2202    match up.up_block with    match up.up_block with
2203      None -> raise Not_found      None -> raise Not_found
2204    | Some b -> b    | Some b -> b
# Line 2223  let rec in_uploader_ranges r list = Line 2223  let rec in_uploader_ranges r list =
2223    
2224  let find_range up =  let find_range up =
2225    clean_ranges up;    clean_ranges up;
2226      
2227    let b =    let b =
2228      match up.up_block with      match up.up_block with
2229        None -> raise Not_found        None -> raise Not_found
2230      | Some b -> b      | Some b -> b
2231    in    in
2232    let r = b.block_ranges in    let r = b.block_ranges in
2233      
2234    let t = up.up_t in    let t = up.up_t in
2235      
2236    match file_state t.t_file with    match file_state t.t_file with
2237    | FilePaused    | FilePaused
2238    | FileAborted _    | FileAborted _
2239    | FileCancelled -> raise Not_found    | FileCancelled -> raise Not_found
2240    | _ ->    | _ ->
2241          
2242        let rec iter limit r =        let rec iter limit r =
2243    
2244  (* let use a very stupid heuristics: ask for the first non-used range.  (* let use a very stupid heuristics: ask for the first non-used range.
2245  we thus might put a lot of clients on the same range !  we thus might put a lot of clients on the same range !
2246  *)  *)
2247            
2248          if not (in_uploader_ranges r up.up_ranges) &&          if not (in_uploader_ranges r up.up_ranges) &&
2249            r.range_current_begin < r.range_end &&            r.range_current_begin < r.range_end &&
2250            r.range_current_begin >= up.up_block_begin &&            r.range_current_begin >= up.up_block_begin &&
# Line 2260  we thus might put a lot of clients on th Line 2260  we thus might put a lot of clients on th
2260            end else            end else
2261          match r.range_next with          match r.range_next with
2262            None -> raise Not_found            None -> raise Not_found
2263          | Some rr -> iter limit rr                    | Some rr -> iter limit rr
2264        in        in
2265        try        try
2266  (* first try to find ranges with 0 uploaders *)  (* first try to find ranges with 0 uploaders *)
# Line 2271  we thus might put a lot of clients on th Line 2271  we thus might put a lot of clients on th
2271              iter max_clients_per_block r              iter max_clients_per_block r
2272            with Not_found ->            with Not_found ->
2273  (* force maximal uploading otherwise to finish it *)  (* force maximal uploading otherwise to finish it *)
2274                iter max_int r                iter max_int r
2275    
2276  (*************************************************************************)  (*************************************************************************)
2277  (*                                                                       *)  (*                                                                       *)
# Line 2289  let range_range r = (r.range_current_beg Line 2289  let range_range r = (r.range_current_beg
2289    
2290  let received (up : uploader) (file_begin : Int64.t)  let received (up : uploader) (file_begin : Int64.t)
2291    (str:string) (string_begin:int) (string_len:int) =    (str:string) (string_begin:int) (string_len:int) =
2292      
2293    if string_len > 0 then    if string_len > 0 then
2294      let file_end = file_begin ++ (Int64.of_int string_len) in      let file_end = file_begin ++ (Int64.of_int string_len) in
2295        
2296      if !verbose_swarming then      if !verbose_swarming then
2297        lprintf "received on %s-%s\n"        lprintf "received on %s-%s\n"
2298          (Int64.to_string file_begin)          (Int64.to_string file_begin)
2299        (Int64.to_string file_end);        (Int64.to_string file_end);
2300    
2301  (* TODO: check that everything we received has been required *)  (* TODO: check that everything we received has been required *)
2302      let t = up.up_t in      let t = up.up_t in
2303      let s = t.t_s in      let s = t.t_s in
2304      try        try
2305          
2306        List.iter (fun (_,_,r) ->        List.iter (fun (_,_,r) ->
2307            if r.range_current_begin < file_end &&            if r.range_current_begin < file_end &&
2308              r.range_end > file_begin then begin              r.range_end > file_begin then begin
2309                  
2310                let file_end = min file_end r.range_end in                let file_end = min file_end r.range_end in
2311                let written_len = file_end -- r.range_current_begin in                let written_len = file_end -- r.range_current_begin in
2312                  
2313                begin                begin
2314                  match file_state t.t_file with                  match file_state t.t_file with
2315                  | FilePaused                  | FilePaused
2316                  | FileAborted _                  | FileAborted _
2317                  | FileCancelled -> ()                  | FileCancelled -> ()
2318                  | _ ->                  | _ ->
2319                        
2320                      let string_pos = string_begin +                      let string_pos = string_begin +
2321                          Int64.to_int (r.range_current_begin -- file_begin) in                          Int64.to_int (r.range_current_begin -- file_begin) in
2322                      let string_length = Int64.to_int written_len in                      let string_length = Int64.to_int written_len in
2323                        
2324                      if                      if
2325                        string_pos < 0 ||                        string_pos < 0 ||
2326                        string_pos < string_begin ||                        string_pos < string_begin ||
2327                        string_len < string_length then begin                        string_len < string_length then begin
2328                          if !verbose_hidden_errors then                          if !verbose_hidden_errors then
2329                          begin                          begin
2330                          lprintf "[ERROR CommonSwarming]: BAD WRITE\n";                          lprintf "[ERROR CommonSwarming]: BAD WRITE\n";
2331                          lprintf "   for range %Ld-%Ld (string_pos %d)\n"                          lprintf "   for range %Ld-%Ld (string_pos %d)\n"
2332                            r.range_begin r.range_end string_pos;                            r.range_begin r.range_end string_pos;
2333                            
2334                          lprintf "  received: file_pos:%Ld string:%d %d\n"                          lprintf "  received: file_pos:%Ld string:%d %d\n"
2335                            file_begin string_begin string_len;                            file_begin string_begin string_len;
2336                          lprintf "  ranges:\n";                          lprintf "  ranges:\n";
# Line 2340  let received (up : uploader) (file_begin Line 2340  let received (up : uploader) (file_begin
2340                                r.range_end;                                r.range_end;
2341                              (match r.range_next with                              (match r.range_next with
2342                                  None -> ()                                  None -> ()
2343                                | Some rr ->                                | Some rr ->
2344                                    lprintf "  next: %Ld" rr.range_begin);                                    lprintf "  next: %Ld" rr.range_begin);
2345                              (match r.range_prev with                              (match r.range_prev with
2346                                  None -> ()                                  None -> ()
2347                                | Some rr ->                                | Some rr ->
2348                                    lprintf "  prev: %Ld" rr.range_begin);                                    lprintf "  prev: %Ld" rr.range_begin);
2349                              lprintf "\n";                              lprintf "\n";
2350                              let b = r.range_block in                              let b = r.range_block in
2351                              lprintf "        block: %d[%c] %Ld-%Ld [%s]"                              lprintf "        block: %d[%c] %Ld-%Ld [%s]"
2352                                b.block_num                                b.block_num
2353                                s.s_verified_bitmap.[b.block_num]                                s.s_verified_bitmap.[b.block_num]
2354                                b.block_begin b.block_end                                b.block_begin b.block_end
2355                                (match s.s_blocks.(b.block_num) with                                (match s.s_blocks.(b.block_num) with
# Line 2372  let received (up : uploader) (file_begin Line 2372  let received (up : uploader) (file_begin
2372                          [] -> assert false                          [] -> assert false
2373                        | t :: _ when t.t_primary ->                        | t :: _ when t.t_primary ->
2374                            file_write t.t_file                            file_write t.t_file
2375                              r.range_current_begin                                r.range_current_begin
2376                              str string_pos string_length;                              str string_pos string_length;
2377                        | _ -> ()                        | _ -> ()
2378                end;                end;
2379                range_received (Some t) r r.range_current_begin file_end;                range_received (Some t) r r.range_current_begin file_end;
2380                  
2381              end              end
2382        ) up.up_ranges;        ) up.up_ranges;
2383        clean_ranges up        clean_ranges up
2384      with e ->      with e ->
2385          raise e          raise e
2386      
2387            
2388  (*************************************************************************)  (*************************************************************************)
2389  (*                                                                       *)  (*                                                                       *)
2390  (*                         present_chunks                                *)  (*                         present_chunks                                *)
# Line 2394  let received (up : uploader) (file_begin Line 2394  let received (up : uploader) (file_begin
2394  let present_chunks s =  let present_chunks s =
2395    let nblocks = Array.length s.s_blocks in    let nblocks = Array.length s.s_blocks in
2396  (*  lprintf "present_chunks...%d blocks\n" nblocks; *)  (*  lprintf "present_chunks...%d blocks\n" nblocks; *)
2397      
2398    let rec iter_block_out i block_begin list =    let rec iter_block_out i block_begin list =
2399      if debug_present_chunks then      if debug_present_chunks then
2400        lprintf "iter_block_out %d bb: %s\n"        lprintf "iter_block_out %d bb: %s\n"
2401          i          i
2402          (Int64.to_string block_begin);          (Int64.to_string block_begin);
2403        
2404      if i = nblocks then List.rev list else      if i = nblocks then List.rev list else
2405      let block_end = compute_block_end s i in      let block_end = compute_block_end s i in
2406      match s.s_blocks.(i) with      match s.s_blocks.(i) with
# Line 2411  let present_chunks s = Line 2411  let present_chunks s =
2411          iter_block_in (i+1) block_end block_begin list          iter_block_in (i+1) block_end block_begin list
2412      | PartialBlock b ->      | PartialBlock b ->
2413          iter_range_out i block_end block_begin b.block_ranges  list          iter_range_out i block_end block_begin b.block_ranges  list
2414      
2415    and iter_block_in i block_begin chunk_begin list =    and iter_block_in i block_begin chunk_begin list =
2416      if debug_present_chunks then      if debug_present_chunks then
2417        lprintf "iter_block_in %d bb: %s cb:%s \n"        lprintf "iter_block_in %d bb: %s cb:%s \n"
2418          i          i
2419          (Int64.to_string block_begin)          (Int64.to_string block_begin)
2420        (Int64.to_string chunk_begin)        (Int64.to_string chunk_begin)
2421        ;        ;
2422        
2423      if i = nblocks then      if i = nblocks then
2424        let list = (chunk_begin, s.s_size) :: list in        let list = (chunk_begin, s.s_size) :: list in
2425        List.rev list        List.rev list
2426      else      else
# Line 2431  let present_chunks s = Line 2431  let present_chunks s =
2431      | CompleteBlock | VerifiedBlock ->      | CompleteBlock | VerifiedBlock ->
2432          iter_block_in (i+1) block_end chunk_begin list          iter_block_in (i+1) block_end chunk_begin list
2433      | PartialBlock b ->      | PartialBlock b ->
2434          iter_range_in i block_end          iter_range_in i block_end
2435            chunk_begin block_begin b.block_ranges list            chunk_begin block_begin b.block_ranges list
2436      
2437    and iter_range_out i block_end block_begin r list =    and iter_range_out i block_end block_begin r list =
2438      if debug_present_chunks then      if debug_present_chunks then
2439        lprintf "iter_range_out %d nb: %s bb:%s\n"        lprintf "iter_range_out %d nb: %s bb:%s\n"
2440          i          i
2441          (Int64.to_string block_end)          (Int64.to_string block_end)
2442        (Int64.to_string block_begin)        (Int64.to_string block_begin)
2443        ;        ;
2444        
2445      if r.range_begin > block_begin then      if r.range_begin > block_begin then
2446        iter_range_in i block_end block_begin r.range_begin r list        iter_range_in i block_end block_begin r.range_begin r list
2447      else      else
2448        
2449      if r.range_current_begin > block_begin then begin      if r.range_current_begin > block_begin then begin
2450          if r.range_current_begin < r.range_end then          if r.range_current_begin < r.range_end then
2451            let list = (r.range_begin, r.range_current_begin) :: list in            let list = (r.range_begin, r.range_current_begin) :: list in
# Line 2453  let present_chunks s = Line 2453  let present_chunks s =
2453              None ->              None ->
2454                iter_block_out (i+1) block_end list                iter_block_out (i+1) block_end list
2455            | Some rr ->            | Some rr ->
2456                iter_range_out i block_end r.range_end rr list                              iter_range_out i block_end r.range_end rr list
2457          else          else
2458          match r.range_next with          match r.range_next with
2459            None ->            None ->
2460              iter_block_in (i+1) block_end r.range_begin list              iter_block_in (i+1) block_end r.range_begin list
2461          | Some rr ->          | Some rr ->
2462              iter_range_in i block_end              iter_range_in i block_end
2463                r.range_begin r.range_end rr list                                r.range_begin r.range_end rr list
2464        end else        end else
2465      match r.range_next with      match r.range_next with
2466        None ->        None ->
2467          iter_block_out (i+1) block_end list          iter_block_out (i+1) block_end list
2468      | Some rr ->      | Some rr ->
2469          iter_range_out i block_end r.range_end rr list          iter_range_out i block_end r.range_end rr list
2470      
2471      
2472    and iter_range_in i block_end chunk_begin chunk_end r list =    and iter_range_in i block_end chunk_begin chunk_end r list =
2473      if debug_present_chunks then      if debug_present_chunks then
2474        lprintf "iter_range_in %d bn: %s cb:%s ce: %s\n"        lprintf "iter_range_in %d bn: %s cb:%s ce: %s\n"
2475          i          i
2476          (Int64.to_string block_end)          (Int64.to_string block_end)
2477        (Int64.to_string chunk_begin)        (Int64.to_string chunk_begin)
2478        (Int64.to_string chunk_end) ;        (Int64.to_string chunk_end) ;
2479        
2480      if r.range_current_begin < r.range_end then      if r.range_current_begin < r.range_end then
2481        let list = (chunk_begin, r.range_current_begin) :: list in        let list = (chunk_begin, r.range_current_begin) :: list in
2482        match r.range_next with        match r.range_next with
# Line 2499  let present_chunks s = Line 2499  let present_chunks s =
2499  (*                                                                       *)  (*                                                                       *)
2500  (*                         propagate_chunk                               *)  (*                         propagate_chunk                               *)
2501  (*                                                                       *)  (*                                                                       *)
2502  (*************************************************************************)  (*************************************************************************)
2503    
2504  let propagate_chunk t1 ts pos1 size =  let propagate_chunk t1 ts pos1 size =
2505      
2506    (*    (*
2507    List.iter (fun (t2, i2, pos2) ->    List.iter (fun (t2, i2, pos2) ->
2508        lprintf "Should propagate chunk from %s %Ld to %s %Ld [%Ld]\n"        lprintf "Should propagate chunk from %s %Ld to %s %Ld [%Ld]\n"
2509          (file_best_name t1.t_file) pos1          (file_best_name t1.t_file) pos1
2510          (file_best_name t2.t_file) pos2 size;          (file_best_name t2.t_file) pos2 size;
2511        Unix32.copy_chunk (file_fd t1.t_file)  (file_fd t2.t_file)        Unix32.copy_chunk (file_fd t1.t_file)  (file_fd t2.t_file)
# Line 2516  let propagate_chunk t1 ts pos1 size = Line 2516  let propagate_chunk t1 ts pos1 size =
2516    ) ts    ) ts
2517  *)  *)
2518    ()    ()
2519      
2520  (*************************************************************************)  (*************************************************************************)
2521  (*                                                                       *)  (*                                                                       *)
2522  (*                         duplicate_chunks                              *)  (*                         duplicate_chunks                              *)
2523  (*                                                                       *)  (*                                                                       *)
2524  (*************************************************************************)  (*************************************************************************)
2525    
2526  (* This is the least aggressive version. I was thinking of computing  (* This is the least aggressive version. I was thinking of computing
2527  checksums for all possible schemas for all files, to be able to  checksums for all possible schemas for all files, to be able to
2528  move chunks from/to BT files from/to ED2k files. *)  move chunks from/to BT files from/to ED2k files. *)
2529      
2530  let duplicate_chunks () =  let duplicate_chunks () =
2531    (*    (*
2532    let chunks = Hashtbl.create 100 in    let chunks = Hashtbl.create 100 in
# Line 2539  let duplicate_chunks () = Line 2539  let duplicate_chunks () =
2539              } in              } in
2540            let (has, has_not) = try            let (has, has_not) = try
2541                Hashtbl.find chunks c                Hashtbl.find chunks c
2542              with _ ->              with _ ->
2543                  let sw = (ref [], ref []) in                  let sw = (ref [], ref []) in
2544                  Hashtbl.add chunks c sw;                  Hashtbl.add chunks c sw;
2545                  sw                  sw
# Line 2559  let duplicate_chunks () = Line 2559  let duplicate_chunks () =
2559    ) chunks    ) chunks
2560  *)  *)
2561    ()    ()
2562      
2563  (*************************************************************************)  (*************************************************************************)
2564  (*                                                                       *)  (*                                                                       *)
2565  (*                         set_checksums                                 *)  (*                         set_checksums                                 *)
2566  (*                                                                       *)  (*                                                                       *)
2567  (*************************************************************************)  (*************************************************************************)
2568    
2569    
     
2570  (* TODO: where is this used ? check that the fact of using the UID for  (* TODO: where is this used ? check that the fact of using the UID for
2571    small files does not create any problem. *)    small files does not create any problem. *)
2572  let get_checksums t =  let get_checksums t =
# Line 2574  let get_checksums t = Line 2574  let get_checksums t =
2574      Verification tab -> tab      Verification tab -> tab
2575    | _ -> [||]    | _ -> [||]
2576    
2577          
2578          
2579  (*************************************************************************)  (*************************************************************************)
2580  (*                                                                       *)  (*                                                                       *)
2581  (*                         primary (internal)                            *)  (*                         primary (internal)                            *)
# Line 2583  let get_checksums t = Line 2583  let get_checksums t =
2583  (*************************************************************************)  (*************************************************************************)
2584    
2585  let primary t = t.t_primary  let primary t = t.t_primary
2586          
2587  (*************************************************************************)  (*************************************************************************)
2588  (*                                                                       *)  (*                                                                       *)
2589  (*                         set_verified_bitmap                           *)  (*                         set_verified_bitmap                           *)
# Line 2592  let primary t = t.t_primary Line 2592  let primary t = t.t_primary
2592    
2593  let set_verified_bitmap primary t bitmap =  let set_verified_bitmap primary t bitmap =
2594  (*  t.t_verified_bitmap <- bitmap; *)  (*  t.t_verified_bitmap <- bitmap; *)
2595      
2596    for i = 0 to String.length bitmap - 1 do    for i = 0 to String.length bitmap - 1 do
2597        
2598      match bitmap.[i] with      match bitmap.[i] with
2599      | '2' ->      | '2' ->
2600          if t.t_converted_verified_bitmap.[i] < '2' then begin          if t.t_converted_verified_bitmap.[i] < '2' then begin
2601              t.t_ncomplete_blocks <- t.t_ncomplete_blocks + 1;              t.t_ncomplete_blocks <- t.t_ncomplete_blocks + 1;
2602              t.t_converted_verified_bitmap.[i] <- '2'              t.t_converted_verified_bitmap.[i] <- '2'
2603            end            end
2604        
2605      | '3' ->      | '3' ->
2606  (*        lprintf "Setting 3 on %d\n" i;        *)  (*        lprintf "Setting 3 on %d\n" i;        *)
2607          t.t_converted_verified_bitmap.[i] <- '3';          t.t_converted_verified_bitmap.[i] <- '3';
# Line 2610  let set_verified_bitmap primary t bitmap Line 2610  let set_verified_bitmap primary t bitmap
2610            List.iter (fun i ->            List.iter (fun i ->
2611  (*              lprintf "Should set %d\n" i; *)  (*              lprintf "Should set %d\n" i; *)
2612                match s.s_blocks.(i) with                match s.s_blocks.(i) with
2613                  CompleteBlock ->                  CompleteBlock ->
2614  (*                  lprintf "CompleteBlock\n"; *)  (*                  lprintf "CompleteBlock\n"; *)
2615                    set_verified_block s i                    set_verified_block s i
2616                | EmptyBlock | PartialBlock _ ->                | EmptyBlock | PartialBlock _ ->
# Line 2618  let set_verified_bitmap primary t bitmap Line 2618  let set_verified_bitmap primary t bitmap
2618                    set_completed_block None s i;                    set_completed_block None s i;
2619  (*                  lprintf "set_verified_block\n"; *)  (*                  lprintf "set_verified_block\n"; *)
2620                    set_verified_block s i                    set_verified_block s i
2621                | VerifiedBlock ->                | VerifiedBlock ->
2622  (*                  lprintf "Block already verified\n" *)  (*                  lprintf "Block already verified\n" *)
2623                    ()                    ()
2624            ) t.t_t2s_blocks.(i);            ) t.t_t2s_blocks.(i);
2625            if t.t_converted_verified_bitmap.[i] <> '3' then            if t.t_converted_verified_bitmap.[i] <> '3' then
2626              lprintf "FIELD AS BEEN CLEARED\n"              lprintf "FIELD AS BEEN CLEARED\n"
2627      | _ -> ()      | _ -> ()
2628    done          done
2629      
2630  (*************************************************************************)  (*************************************************************************)
2631  (*                                                                       *)  (*                                                                       *)
2632  (*                         verified_bitmap                               *)  (*                         verified_bitmap                               *)
# Line 2641  let verified_bitmap t = t.t_converted_ve Line 2641  let verified_bitmap t = t.t_converted_ve
2641  (*                                                                       *)  (*                                                                       *)
2642  (*************************************************************************)  (*************************************************************************)
2643    
2644  let set_verifier t f =  let set_verifier t f =
2645    t.t_verifier <- f;    t.t_verifier <- f;
2646  (* TODO: check that false as primary is a good value to start with *)  (* TODO: check that false as primary is a good value to start with *)
2647    set_verified_bitmap false t t.t_converted_verified_bitmap    set_verified_bitmap false t t.t_converted_verified_bitmap
# Line 2652  let set_verifier t f = Line 2652  let set_verifier t f =
2652  (*                                                                       *)  (*                                                                       *)
2653  (*************************************************************************)  (*************************************************************************)
2654    
2655  let set_verified t f =  let set_verified t f =
2656    t.t_verified <- f    t.t_verified <- f
2657    
2658  (*************************************************************************)  (*************************************************************************)
# Line 2669  let downloaded t = file_downloaded t.t_f Line 2669  let downloaded t = file_downloaded t.t_f
2669  (*                                                                       *)  (*                                                                       *)
2670  (*************************************************************************)  (*************************************************************************)
2671    
2672  let block_num t b =  let block_num t b =
2673    let n = t.t_s2t_blocks.(b.block_num) in    let n = t.t_s2t_blocks.(b.block_num) in
2674    n    n
2675    
# Line 2683  let partition_size t = String.length t.t Line 2683  let partition_size t = String.length t.t
2683    
2684  let uploader_swarmer up = up.up_t  let uploader_swarmer up = up.up_t
2685    
2686      
2687  (*************************************************************************)  (*************************************************************************)
2688  (*                                                                       *)  (*                                                                       *)
2689  (*                         availability                                  *)  (*                         availability                                  *)
# Line 2691  let uploader_swarmer up = up.up_t Line 2691  let uploader_swarmer up = up.up_t
2691  (*************************************************************************)  (*************************************************************************)
2692    
2693  let availability t =  let availability t =
2694      
2695    let s = t.t_s in    let s = t.t_s in
2696    let len = String.length t.t_converted_verified_bitmap in    let len = String.length t.t_converted_verified_bitmap in
2697    let str = String.make len '\000' in    let str = String.make len '\000' in
2698    for i = 0 to len - 1 do    for i = 0 to len - 1 do
2699      str.[i] <- char_of_int (      str.[i] <- char_of_int (
2700        let v = List2.min        let v = List2.min
2701            (List.map (fun i -> s.s_availability.(i)) t.t_t2s_blocks.(i)) in            (List.map (fun i -> s.s_availability.(i)) t.t_t2s_blocks.(i)) in
2702        if v < 0 then 0 else        if v < 0 then 0 else
2703        if v > 200 then 200 else v)        if v > 200 then 200 else v)
# Line 2711  let availability t = Line 2711  let availability t =
2711  (*************************************************************************)  (*************************************************************************)
2712    
2713  (*return true if s is interesting for p1  (*return true if s is interesting for p1
2714      NB: works when s is a mask of 0s(absent bloc) and 1s(present bloc)      NB: works when s is a mask of 0s(absent bloc) and 1s(present bloc)
2715      p1 can be a string 0(absent) 1(partial) 2(present unverified) or      p1 can be a string 0(absent) 1(partial) 2(present unverified) or
2716        3(present verified)        3(present verified)
2717                          s : 00001111                          s : 00001111
2718                         p1 : 01230123                         p1 : 01230123
# Line 2733  let value_to_int64_pair v = Line 2733  let value_to_int64_pair v =
2733    match v with    match v with
2734      List [v1;v2] | SmallList [v1;v2] ->      List [v1;v2] | SmallList [v1;v2] ->
2735        (value_to_int64 v1, value_to_int64 v2)        (value_to_int64 v1, value_to_int64 v2)
2736    | _ ->    | _ ->
2737        failwith "Options: Not an int32 pair"        failwith "Options: Not an int32 pair"
2738          
2739  (*************************************************************************)  (*************************************************************************)
2740  (*                                                                       *)  (*                                                                       *)
2741  (*                         WRAPPERS                                      *)  (*                         WRAPPERS                                      *)
# Line 2747  let set_absent t = set_absent t.t_s Line 2747  let set_absent t = set_absent t.t_s
2747  let present_chunks t = present_chunks t.t_s  let present_chunks t = present_chunks t.t_s
2748  let print_t str t = print_s str t.t_s  let print_t str t = print_s str t.t_s
2749  let print_uploaders t = print_uploaders t.t_s  let print_uploaders t = print_uploaders t.t_s
2750      
2751  (*************************************************************************)  (*************************************************************************)
2752  (*                                                                       *)  (*                                                                       *)
2753  (*                         value_to_swarmer                              *)  (*                         value_to_swarmer                              *)
2754  (*                                                                       *)  (*                                                                       *)
2755  (*************************************************************************)  (*************************************************************************)
2756    
2757  let value_to_swarmer t assocs =  let value_to_swarmer t assocs =
2758    let get_value name conv = conv (List.assoc name assocs) in    let get_value name conv = conv (List.assoc name assocs) in
2759      
2760      
2761    let primary =    let primary =
2762      try get_value "file_primary" value_to_bool with _ -> true      try get_value "file_primary" value_to_bool with _ -> true
2763    in    in
2764      
2765    (try    (try
2766        let file_name = get_value "file_swarmer" value_to_string in        let file_name = get_value "file_swarmer" value_to_string in
2767        let s =        let s =
2768          HS.find swarmers_by_name { dummy_swarmer with s_filename = file_name }          HS.find swarmers_by_name { dummy_swarmer with s_filename = file_name }
2769        in        in
2770        associate primary t s;        associate primary t s;
2771  (* TODO: make as many checks as possible to ensure the file and the swarmers  (* TODO: make as many checks as possible to ensure the file and the swarmers
2772    are correctly associed. *)    are correctly associed. *)
2773      with Not_found -> ());      with Not_found -> ());
2774      
2775    let set_bitmap =    let set_bitmap =
2776      let mtime = try file_mtime t.t_file with _ -> 0. in      let mtime = try file_mtime t.t_file with _ -> 0. in
2777      let old_mtime =      let old_mtime =
2778        try        try
2779          value_to_float (List.assoc "file_mtime" assocs)          value_to_float (List.assoc "file_mtime" assocs)
2780        with Not_found -> mtime        with Not_found -> mtime
2781      in      in
2782      old_mtime = mtime      old_mtime = mtime
# Line 2790  it is verified as soon as possible. *) Line 2790  it is verified as soon as possible. *)
2790        with Not_found ->        with Not_found ->
2791            set_verified_bitmap primary t            set_verified_bitmap primary t
2792              (get_value  "file_all_chunks" value_to_string)              (get_value  "file_all_chunks" value_to_string)
2793        
2794      with e ->      with e ->
2795          lprintf "Exception %s while loading bitmap\n"          lprintf "Exception %s while loading bitmap\n"
2796            (Printexc2.to_string e);            (Printexc2.to_string e);
2797    );    );
2798    
2799    (*    (*
2800    lprintf "set_verified_bitmap: t = %s\n" t.t_converted_verified_bitmap;    lprintf "set_verified_bitmap: t = %s\n" t.t_converted_verified_bitmap;
2801    lprintf "set_verified_bitmap: s = %s\n" t.t_s.s_verified_bitmap;    lprintf "set_verified_bitmap: s = %s\n" t.t_s.s_verified_bitmap;
2802  *)  *)
2803      
2804    if primary then begin    if primary then begin
2805        if !verbose then lprintf "Loading present...\n";        if !verbose then lprintf "Loading present...\n";
2806        let present = try        let present = try
2807            let present =            let present =
2808              (get_value "file_present_chunks"              (get_value "file_present_chunks"
2809                  (value_to_list value_to_int64_pair))                  (value_to_list value_to_int64_pair))
2810            in            in
2811            set_present t present;            set_present t present;
2812            present            present
2813          with e ->          with e ->
2814              lprintf "Exception %s while set present\n"              lprintf "Exception %s while set present\n"
2815                (Printexc2.to_string e);                        (Printexc2.to_string e);
2816              []              []
2817        in        in
2818        if !verbose then lprintf "Downloaded after present %Ld\n" (downloaded t);        if !verbose then lprintf "Downloaded after present %Ld\n" (downloaded t);
2819          
2820        if !verbose then lprintf "Loading absent...\n";        if !verbose then lprintf "Loading absent...\n";
2821        (try        (try
2822            set_absent t            set_absent t
2823              (get_value "file_absent_chunks"              (get_value "file_absent_chunks"
2824                (value_to_list value_to_int64_pair));                (value_to_list value_to_int64_pair));
2825          with e ->          with e ->
2826              if !verbose_hidden_errors then lprintf "Exception %s while set absent\n"              if !verbose_hidden_errors then lprintf "Exception %s while set absent\n"
2827                (Printexc2.to_string e);                        (Printexc2.to_string e);
2828        );        );
2829        if !verbose then lprintf "Downloaded after absent %Ld\n" (downloaded t);        if !verbose then lprintf "Downloaded after absent %Ld\n" (downloaded t);
2830        (try        (try
2831            let d = get_value "file_downloaded" value_to_int64 in            let d = get_value "file_downloaded" value_to_int64 in
2832              
2833            if d <> downloaded t && !verbose_hidden_errors then begin            if d <> downloaded t && !verbose_hidden_errors then begin
2834                lprintf "ERROR: CommonSwarming: stored downloaded value not restored  !!! (%Ld/%Ld)\n" (downloaded t) d;                lprintf "ERROR: CommonSwarming: stored downloaded value not restored  !!! (%Ld/%Ld)\n" (downloaded t) d;
2835                lprintf "ERROR: CommonSwarming: present:\n";                lprintf "ERROR: CommonSwarming: present:\n";
2836                List.iter (fun (x,y) ->                List.iter (fun (x,y) ->
2837                    lprintf "     (%Ld,%Ld);\n" x y                      lprintf "     (%Ld,%Ld);\n" x y
2838                ) present;                ) present;
2839                  
2840                let p = present_chunks t in                let p = present_chunks t in
2841                lprintf "ERROR: CommonSwarming: present now:\n";                lprintf "ERROR: CommonSwarming: present now:\n";
2842                  
2843                let total = ref zero in                let total = ref zero in
2844                List.iter (fun (x,y) ->                List.iter (fun (x,y) ->
2845                    lprintf "     (%Ld,%Ld);\n" x y;                    lprintf "     (%Ld,%Ld);\n" x y;
# Line 2850  it is verified as soon as possible. *) Line 2850  it is verified as soon as possible. *)
2850                if p = present then begin                if p = present then begin
2851                    lprintf "ERROR: both appear to be the same !!!\n";                    lprintf "ERROR: both appear to be the same !!!\n";
2852                  end;                  end;
2853                  
2854                  
2855    
2856  (*          exit 2 *)  (*          exit 2 *)
2857              end              end
2858            
2859          with e -> ());          with e -> ());
2860      end;      end;
2861    
# Line 2866  it is verified as soon as possible. *) Line 2866  it is verified as soon as possible. *)
2866        t.t_last_seen <- Array.of_list last_seen        t.t_last_seen <- Array.of_list last_seen
2867      with _ -> ());      with _ -> ());
2868  *)  *)
2869      
2870    ()          ()
2871    
2872  (*************************************************************************)  (*************************************************************************)
2873  (*                                                                       *)  (*                                                                       *)
# Line 2875  it is verified as soon as possible. *) Line 2875  it is verified as soon as possible. *)
2875  (*                                                                       *)  (*                                                                       *)
2876  (*************************************************************************)  (*************************************************************************)
2877    
2878  let set_verified_bitmap t bitmap =  let set_verified_bitmap t bitmap =
2879    set_verified_bitmap (primary t) t bitmap    set_verified_bitmap (primary t) t bitmap
2880      
2881  (*************************************************************************)  (*************************************************************************)
2882  (*                                                                       *)  (*                                                                       *)
2883  (*                         swarmer_to_value                              *)  (*                         swarmer_to_value                              *)
2884  (*                                                                       *)  (*                                                                       *)
2885  (*************************************************************************)  (*************************************************************************)
2886    
2887  let swarmer_to_value t other_vals =  let swarmer_to_value t other_vals =
2888    ("file_primary", bool_to_value (primary t)) ::    ("file_primary", bool_to_value (primary t)) ::
2889    ("file_swarmer", string_to_value t.t_s.s_filename) ::    ("file_swarmer", string_to_value t.t_s.s_filename) ::
2890    ("file_mtime", float_to_value (try file_mtime t.t_file with _ -> 0.)) ::    ("file_mtime", float_to_value (try file_mtime t.t_file with _ -> 0.)) ::
2891    ("file_chunks", string_to_value (verified_bitmap t)) ::    ("file_chunks", string_to_value (verified_bitmap t)) ::
2892    ("file_present_chunks", List    ("file_present_chunks", List
2893        (List.map (fun (i1,i2) ->        (List.map (fun (i1,i2) ->
2894            SmallList [int64_to_value i1; int64_to_value i2])            SmallList [int64_to_value i1; int64_to_value i2])
2895        (present_chunks t))) ::        (present_chunks t))) ::
2896    ("file_downloaded", int64_to_value (downloaded t)) ::    ("file_downloaded", int64_to_value (downloaded t)) ::
2897      
2898    ("file_chunks_age", List (Array.to_list    ("file_chunks_age", List (Array.to_list
2899          (Array.map int_to_value t.t_last_seen))) ::          (Array.map int_to_value t.t_last_seen))) ::
2900      
2901    other_vals    other_vals
2902    
2903  (*************************************************************************)  (*************************************************************************)
# Line 2921  let verify_one_chunk s = Line 2921  let verify_one_chunk s =
2921    ) s.s_networks;    ) s.s_networks;
2922  (*  lprintf "verify_one_chunk: nothing done\n"; *)  (*  lprintf "verify_one_chunk: nothing done\n"; *)
2923    ()    ()
2924      
2925  (*************************************************************************)  (*************************************************************************)
2926  (*                                                                       *)  (*                                                                       *)
2927  (*                         verify_some_chunks                            *)  (*                         verify_some_chunks                            *)
# Line 2942  let verify_some_chunks () = Line 2942  let verify_some_chunks () =
2942    
2943  let verify_one_chunk t =  let verify_one_chunk t =
2944    verify_one_chunk t.t_s    verify_one_chunk t.t_s
2945      
2946  (*************************************************************************)  (*************************************************************************)
2947  (*                                                                       *)  (*                                                                       *)
2948  (*                         merge                                         *)  (*                         merge                                         *)
2949  (*                                                                       *)  (*                                                                       *)
2950  (*************************************************************************)  (*************************************************************************)
2951    
2952  let merge f1 f2 =  let merge f1 f2 =
2953      
2954    let s1 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f1 } in    let s1 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f1 } in
2955    let s2 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f2 } in    let s2 = HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f2 } in
2956      
2957    if s1 == s2 then    if s1 == s2 then
2958      failwith "Files are already sharing their swarmer";      failwith "Files are already sharing their swarmer";
2959      
2960    if s1.s_size <> s2.s_size then    if s1.s_size <> s2.s_size then
2961      failwith "Files don't have the same size";      failwith "Files don't have the same size";
2962      
2963    let t2 = match s2.s_networks with    let t2 = match s2.s_networks with
2964        [t] -> t        [t] -> t
2965      | list ->      | list ->
2966          lprintf "s_networks: %d files\n" (List.length list);          lprintf "s_networks: %d files\n" (List.length list);
2967          failwith "Second file is already merged with other files"          failwith "Second file is already merged with other files"
2968    in    in
2969      
2970    let t1 =    let t1 =
2971      match s1.s_networks with      match s1.s_networks with
2972        [] -> assert false        [] -> assert false
2973      | t1 :: _ ->      | t1 :: _ ->
2974          match t1.t_verifier with          match t1.t_verifier with
2975            NoVerification ->            NoVerification ->
2976              failwith "Cannot use first file as a primary for swarming (no verification scheme)"              failwith "Cannot use first file as a primary for swarming (no verification scheme)"
2977          | _ -> t1          | _ -> t1
2978    in    in
2979      
2980    begin    begin
2981      List.iter (fun (s, filename) ->      List.iter (fun (s, filename) ->
2982          for i = 0 to Array.length s.s_nuploading -  1 do          for i = 0 to Array.length s.s_nuploading -  1 do
# Line 2987  let merge f1 f2 = Line 2987  let merge f1 f2 =
2987        s1, "First file";        s1, "First file";
2988        s2, "Second file" ];        s2, "Second file" ];
2989    end;    end;
2990      
2991  (* replace T2 swarmer *)  (* replace T2 swarmer *)
2992    associate false t2 t1.t_s    associate false t2 t1.t_s
2993      
2994  (*************************************************************************)  (*************************************************************************)
2995  (*                                                                       *)  (*                                                                       *)
2996  (*                         has_secondaries                               *)  (*                         has_secondaries                               *)
# Line 2999  let merge f1 f2 = Line 2999  let merge f1 f2 =
2999    
3000  let has_secondaries t =  let has_secondaries t =
3001    primary t && List.length t.t_s.s_networks > 1    primary t && List.length t.t_s.s_networks > 1
3002      
3003  (*************************************************************************)  (*************************************************************************)
3004  (*                                                                       *)  (*                                                                       *)
3005  (*                         subfiles                                      *)  (*                         subfiles                                      *)
# Line 3008  let has_secondaries t = Line 3008  let has_secondaries t =
3008        
3009  let subfiles t =  let subfiles t =
3010    List.map (fun t -> t.t_file) t.t_s.s_networks        List.map (fun t -> t.t_file) t.t_s.s_networks    
3011      
3012  (*************************************************************************)  (*************************************************************************)
3013  (*                                                                       *)  (*                                                                       *)
3014  (*                         SwarmerOption                                 *)  (*                         SwarmerOption                                 *)
3015  (*                                                                       *)  (*                                                                       *)
3016  (*************************************************************************)  (*************************************************************************)
3017      
3018  module SwarmerOption = struct  module SwarmerOption = struct
3019        
3020      let value_to_swarmer v =      let value_to_swarmer v =
3021        match v with        match v with
3022          Module assocs ->          Module assocs ->
# Line 3024  module SwarmerOption = struct Line 3024  module SwarmerOption = struct
3024            let file_size = get_value "file_size" value_to_int64 in            let file_size = get_value "file_size" value_to_int64 in
3025            let file_name = get_value "file_name" value_to_string in            let file_name = get_value "file_name" value_to_string in
3026            let s = create_swarmer file_name file_size edonkey_range_size in            let s = create_swarmer file_name file_size edonkey_range_size in
3027            let block_sizes = get_value "file_chunk_sizes"            let block_sizes = get_value "file_chunk_sizes"
3028                (value_to_list value_to_int64) in                (value_to_list value_to_int64) in
3029            List.iter (fun bsize ->            List.iter (fun bsize ->
3030                split_blocks s bsize                split_blocks s bsize
3031            ) block_sizes;            ) block_sizes;
3032            s            s
3033              
3034        | _ -> assert false        | _ -> assert false
3035              
3036      let swarmer_to_value s =      let swarmer_to_value s =
3037        Module [        Module [
3038          ("file_size", int64_to_value s.s_size);          ("file_size", int64_to_value s.s_size);
# Line 3041  module SwarmerOption = struct Line 3041  module SwarmerOption = struct
3041          ("file_chunk_sizes", list_to_value int64_to_value          ("file_chunk_sizes", list_to_value int64_to_value
3042              (List.map (fun t -> t.t_block_size) s.s_networks));              (List.map (fun t -> t.t_block_size) s.s_networks));
3043          ]          ]
3044        
3045      let t =      let t =
3046        define_option_class "Swarmer" value_to_swarmer swarmer_to_value        define_option_class "Swarmer" value_to_swarmer swarmer_to_value
3047        
3048    end    end
3049      
3050  (*************************************************************************)  (*************************************************************************)
3051  (*                                                                       *)  (*                                                                       *)
3052  (*                         check_swarmer                                 *)  (*                         check_swarmer                                 *)
# Line 3059  let check_swarmer s = Line 3059  let check_swarmer s =
3059        [] -> ()        [] -> ()
3060      | t :: tail ->      | t :: tail ->
3061          assert  t.t_primary;          assert  t.t_primary;
3062            
3063          for i = 0 to t.t_nchunks - 1 do          for i = 0 to t.t_nchunks - 1 do
3064            List.iter (fun j ->            List.iter (fun j ->
3065                if t.t_converted_verified_bitmap.[i] = '3' then begin                if t.t_converted_verified_bitmap.[i] = '3' then begin
# Line 3072  let check_swarmer s = Line 3072  let check_swarmer s =
3072                  end                  end
3073            ) t.t_t2s_blocks.(i)            ) t.t_t2s_blocks.(i)
3074          done;          done;
3075            
3076          let fd = file_fd t.t_file in          let fd = file_fd t.t_file in
3077            
3078          List.iter (fun t ->          List.iter (fun t ->
3079              assert (not t.t_primary);              assert (not t.t_primary);
3080              assert (file_fd t.t_file == fd);              assert (file_fd t.t_file == fd);
3081                
3082              for i = 0 to t.t_nchunks - 1 do              for i = 0 to t.t_nchunks - 1 do
3083                List.iter (fun j ->                List.iter (fun j ->
3084                    if t.t_converted_verified_bitmap.[i] = '3' then begin                    if t.t_converted_verified_bitmap.[i] = '3' then begin
3085                        if s.s_verified_bitmap.[j] <> '3' then                        if s.s_verified_bitmap.[j] <> '3' then
3086                          failwith "3 in secondary without 3 in primary";                          failwith "3 in secondary without 3 in primary";
3087                      end                      end
3088                    else                    else
# Line 3091  let check_swarmer s = Line 3091  let check_swarmer s =
3091                          failwith "2 in secondary without 3 in primary";                          failwith "2 in secondary without 3 in primary";
3092                      end                      end
3093                ) t.t_t2s_blocks.(i)                ) t.t_t2s_blocks.(i)
3094              done;                        done;
3095          ) tail          ) tail
3096    with e ->    with e ->
3097        print_s "ERROR"s;        print_s "ERROR"s;
3098        raise e        raise e
3099      
3100  (*************************************************************************)  (*************************************************************************)
3101  (*                                                                       *)  (*                                                                       *)
3102  (*                         Option swarmers                               *)  (*                         Option swarmers                               *)
3103  (*                                                                       *)  (*                                                                       *)
3104  (*************************************************************************)  (*************************************************************************)
3105      
3106  let swarmers =  let swarmers =
3107    define_option CommonComplexOptions.swarmers_section    define_option CommonComplexOptions.swarmers_section
3108      ["swarmers"] "All the swarmers used" (list_option SwarmerOption.t) []      ["swarmers"] "All the swarmers used" (list_option SwarmerOption.t) []
3109      
3110  (*************************************************************************)  (*************************************************************************)
3111  (*                                                                       *)  (*                                                                       *)
3112  (*                         Options hooks                                 *)  (*                         Options hooks                                 *)
3113  (*                                                                       *)  (*                                                                       *)
3114  (*************************************************************************)  (*************************************************************************)
3115      
3116  let _ =  let _ =
3117    set_after_save_hook files_ini (fun _ -> swarmers =:= []);    set_after_save_hook files_ini (fun _ -> swarmers =:= []);
3118    set_before_save_hook files_ini (fun _ ->    set_before_save_hook files_ini (fun _ ->
3119        let list = ref [] in        let list = ref [] in
3120        HS.iter (fun s ->        HS.iter (fun s ->
3121            if s.s_networks <> [] then            if s.s_networks <> [] then
3122            list := s :: !list) swarmers_by_name;            list := s :: !list) swarmers_by_name;
3123        swarmers =:= !list        swarmers =:= !list
3124    );    );
3125    set_after_load_hook files_ini (fun _ ->    set_after_load_hook files_ini (fun _ ->
3126        List.iter (fun s ->        List.iter (fun s ->
3127            check_swarmer s;            check_swarmer s;
3128        ) !!swarmers;        ) !!swarmers;
3129          
3130        swarmers =:= [])        swarmers =:= [])
3131      
3132      
3133  (*************************************************************************)  (*************************************************************************)
3134  (*                                                                       *)  (*                                                                       *)
3135  (*                         MAIN                                          *)  (*                         MAIN                                          *)
# Line 3137  let _ = Line 3137  let _ =
3137  (*************************************************************************)  (*************************************************************************)
3138    
3139  (* Compute an approximation of the storage used by this module *)  (* Compute an approximation of the storage used by this module *)
3140        
3141  let _ =  let _ =
3142    BasicSocket.add_infinite_timer 300. duplicate_chunks;    BasicSocket.add_infinite_timer 300. duplicate_chunks;
3143    Heap.add_memstat "CommonSwarming2" (fun level buf ->    Heap.add_memstat "CommonSwarming2" (fun level buf ->
3144        let counter = ref 0 in        let counter = ref 0 in
3145        let nchunks = ref 0 in        let nchunks = ref 0 in
3146        let nblocks = ref 0 in        let nblocks = ref 0 in
3147        let nranges = ref 0 in        let nranges = ref 0 in
3148        HS.iter (fun s ->        HS.iter (fun s ->
3149            let n = String.length s.s_verified_bitmap in            let n = String.length s.s_verified_bitmap in
3150            nchunks := !nchunks + n;            nchunks := !nchunks + n;
3151              
3152            Array.iter (fun b ->            Array.iter (fun b ->
3153                match b with                match b with
3154                | PartialBlock b ->                | PartialBlock b ->
3155                    incr nblocks;                    incr nblocks;
3156                    iter_block_ranges (fun _ -> incr nranges) b                    iter_block_ranges (fun _ -> incr nranges) b
3157                | _ -> ()                                    | _ -> ()
3158            ) s.s_blocks;            ) s.s_blocks;
3159              
3160            incr counter            incr counter
3161        ) swarmers_by_name;        ) swarmers_by_name;
3162        let block_storage = 64 * !nblocks in        let block_storage = 64 * !nblocks in
3163          
3164        Printf.bprintf buf "  Swarmers: %d\n" !counter;        Printf.bprintf buf "  Swarmers: %d\n" !counter;
3165        Printf.bprintf buf "    nchunks: %d nblocks: %d nranges: %d\n"        Printf.bprintf buf "    nchunks: %d nblocks: %d nranges: %d\n"
3166          !nchunks !nblocks !nranges;          !nchunks !nblocks !nranges;
3167        Printf.bprintf buf "  Storage (without blocks): %d bytes\n"        Printf.bprintf buf "  Storage (without blocks): %d bytes\n"
3168          ( !counter * 108 +          ( !counter * 108 +
3169            !nchunks * 17 +            !nchunks * 17 +
3170            !nblocks * 64 +            !nblocks * 64 +
3171            !nranges * 84);            !nranges * 84);
3172          
3173        let counter = ref 0 in        let counter = ref 0 in
3174        let storage = ref 0 in        let storage = ref 0 in
3175        HU.iter (fun up ->        HU.iter (fun up ->
3176            storage := !storage + 76 +            storage := !storage + 76 +
3177              Array.length up.up_complete_blocks * 4 +              Array.length up.up_complete_blocks * 4 +
3178              List.length up.up_ranges * (12 + 16 + 12 + 12 +  4) +              List.length up.up_ranges * (12 + 16 + 12 + 12 +  4) +
3179              Array.length up.up_partial_blocks * (16 + 12 + 12) +              Array.length up.up_partial_blocks * (16 + 12 + 12) +
# Line 3188  let _ = Line 3188  let _ =
3188        Printf.bprintf buf "  Storage: %d bytes\n" !storage;        Printf.bprintf buf "  Storage: %d bytes\n" !storage;
3189    )    )
3190    
3191  let check_finished t =  let check_finished t =
3192    try    try
3193      let file = t.t_file in      let file = t.t_file in
3194      match file_state file with      match file_state file with
# Line 3197  let check_finished t = Line 3197  let check_finished t =
3197          let bitmap = verified_bitmap t in          let bitmap = verified_bitmap t in
3198          for i = 0 to String.length bitmap - 1 do          for i = 0 to String.length bitmap - 1 do
3199            if bitmap.[i] <> '3' then raise Not_found;            if bitmap.[i] <> '3' then raise Not_found;
3200          done;            done;
3201          if file_size file <> downloaded t then          if file_size file <> downloaded t then
3202            lprintf "Downloaded size differs after complete verification\n";            lprintf "Downloaded size differs after complete verification\n";
3203          true          true
3204    with _ -> false          with _ -> false
3205          
3206      
3207  end  end
3208    
3209    
3210  (*************************************************************************)  (*************************************************************************)
# Line 3219  end Line 3219  end
3219    
3220  (*  (*
3221  module Check = struct  module Check = struct
3222        
3223      type f = {      type f = {
3224          file_fd : Unix32.t;          file_fd : Unix32.t;
3225          file_num : int;          file_num : int;
# Line 3228  module Check = struct Line 3228  module Check = struct
3228          mutable file_downloaded : int64;          mutable file_downloaded : int64;
3229          file_nchunks : int;          file_nchunks : int;
3230        }        }
3231        
3232      let ndownloaders = 10      let ndownloaders = 10
3233      let seed = 4475      let seed = 4475
3234      let file = "test_download.tmp"            let file = "test_download.tmp"
3235      let range_size = Int64.of_int 150      let range_size = Int64.of_int 150
3236      let block_sizes = [| 1000; 400; 299 |]      let block_sizes = [| 1000; 400; 299 |]
3237      let block_sizes = Array.map Int64.of_int block_sizes      let block_sizes = Array.map Int64.of_int block_sizes
3238        
3239      let file_check_fd = Unix32.create_diskfile file Unix32.rw_flag 0o444      let file_check_fd = Unix32.create_diskfile file Unix32.rw_flag 0o444
3240        
3241      module S = Make(struct      module S = Make(struct
3242              
3243            module CommonTypes = struct            module CommonTypes = struct
3244                type file = f                type file = f
3245                type client = int                type client = int
3246              end              end
3247              
3248              
3249            module CommonFile = struct            module CommonFile = struct
3250                let file_num f = f.file_num                let file_num f = f.file_num
3251                let file_size f = f.file_size                let file_size f = f.file_size
3252                let file_downloaded f = f.file_downloaded                let file_downloaded f = f.file_downloaded
3253                let add_file_downloaded f s =                let add_file_downloaded f s =
3254                  f.file_downloaded <- f.file_downloaded ++ s                  f.file_downloaded <- f.file_downloaded ++ s
3255  (*                lprintf "File %d downloaded : %Ld\n"  (*                lprintf "File %d downloaded : %Ld\n"
3256                    f.file_num f.file_downloaded *)                    f.file_num f.file_downloaded *)
3257                  
3258                let file_best_name f = f.file_name                let file_best_name f = f.file_name
3259                let file_verify file m fpos epos =                let file_verify file m fpos epos =
3260                  let len = epos -- fpos in                  let len = epos -- fpos in
3261                  let len = Int64.to_int len in                  let len = Int64.to_int len in
3262                  let s = String.create len in                  let s = String.create len in
# Line 3273  module Check = struct Line 3273  module Check = struct
3273  (*                     if !exit_on_error then exit 2; *)  (*                     if !exit_on_error then exit 2; *)
3274                    end;                    end;
3275                  result                  result
3276                  
3277                let file_mtime file = 0.                let file_mtime file = 0.
3278                  
3279                let file_write f fpos s spos len =                let file_write f fpos s spos len =
3280                  lprintf "file_write: WRITE %d\n" len;                  lprintf "file_write: WRITE %d\n" len;
3281                  Unix32.write f.file_fd fpos s spos len;                  Unix32.write f.file_fd fpos s spos len;
3282                  let ss = String.create len in                  let ss = String.create len in
# Line 3284  module Check = struct Line 3284  module Check = struct
3284                  Unix32.read file_check_fd fpos ss 0 len;                  Unix32.read file_check_fd fpos ss 0 len;
3285                  if ss <> (String.sub s spos len) then                  if ss <> (String.sub s spos len) then
3286                    lprintf "Writting bad content !\n"                    lprintf "Writting bad content !\n"
3287                  
3288                let file_copy _ _ _ _ _ = ()                let file_copy _ _ _ _ _ = ()
3289                let file_state file = FileDownloading                let file_state file = FileDownloading
3290                let set_file_last_seen _ _ = ()                let set_file_last_seen _ _ = ()
3291              end              end
3292              
3293            module CommonClient = struct            module CommonClient = struct
3294                let client_num c = c                let client_num c = c
3295              end              end
3296            
3297            
3298          end)          end)
3299        
3300        
3301      let nfiles = Array.length block_sizes      let nfiles = Array.length block_sizes
3302      let file_size = Unix32.getsize file true      let file_size = Unix32.getsize file true
3303      (* I know this module is commented out, but change it anyway *)      (* I know this module is commented out, but change it anyway *)
3304        
3305      let _ =      let _ =
3306          
3307        Random.init 0;        Random.init 0;
3308        let first_seed = 21 in        let first_seed = 21 in
3309        let last_seed = 200 in        let last_seed = 200 in
# Line 3313  module Check = struct Line 3313  module Check = struct
3313          if i >= first_seed then          if i >= first_seed then
3314            seeds := seed :: !seeds;            seeds := seed :: !seeds;
3315        done;        done;
3316          
3317        List.iter (fun seed ->        List.iter (fun seed ->
3318            Random.init seed;            Random.init seed;
3319              
3320            let kernel = S.create_swarmer file_size range_size in            let kernel = S.create_swarmer file_size range_size in
3321            let temp_filename =            let temp_filename =
3322              let filename = Printf.sprintf "temp/toto"  in              let filename = Printf.sprintf "temp/toto"  in
3323              (try Sys.remove filename with _ -> ());              (try Sys.remove filename with _ -> ());
3324              filename              filename
3325            in            in
3326              
3327            let files = Array.init nfiles (fun i ->            let files = Array.init nfiles (fun i ->
3328                  lprintf "Creating swarmer %d\n" i;                  lprintf "Creating swarmer %d\n" i;
3329                    
3330                  let block_size = block_sizes.(i) in                  let block_size = block_sizes.(i) in
3331                  let nchunks = Int64.to_int (Int64.div                  let nchunks = Int64.to_int (Int64.div
3332                        (Int64.sub file_size Int64.one) block_size) + 1 in                        (Int64.sub file_size Int64.one) block_size) + 1 in
3333                    
3334                  let file = {                  let file = {
3335                      file_fd = Unix32.create_diskfile temp_filename Unix32.rw_flag 0o666;                      file_fd = Unix32.create_diskfile temp_filename Unix32.rw_flag 0o666;
3336                      file_num = i;                      file_num = i;
# Line 3344  module Check = struct Line 3344  module Check = struct
3344                  let swarmer = S.create kernel file block_size in                  let swarmer = S.create kernel file block_size in
3345                  S.set_checksums (Some swarmer) (Array.create nchunks (Ed2k Md4.null));                  S.set_checksums (Some swarmer) (Array.create nchunks (Ed2k Md4.null));
3346                  swarmer)                  swarmer)
3347            in                        in
3348            lprintf "Swarmers created\n";            lprintf "Swarmers created\n";
3349            S.print_t "--" files.(0);            S.print_t "--" files.(0);
3350              
3351            let check_finished swarmer =            let check_finished swarmer =
3352              try              try
3353                let bitmap = S.verified_bitmap swarmer in                let bitmap = S.verified_bitmap swarmer in
3354                for i = 0 to String.length bitmap - 1 do                for i = 0 to String.length bitmap - 1 do
3355                  if bitmap.[i] <> '3' then raise Not_found;                  if bitmap.[i] <> '3' then raise Not_found;
3356                done;                  done;
3357                if file_size <> S.downloaded swarmer then                if file_size <> S.downloaded swarmer then
3358                  lprintf "Downloaded size differs after complete verification (%Ld - %Ld)\n" file_size (S.downloaded swarmer);                  lprintf "Downloaded size differs after complete verification (%Ld - %Ld)\n" file_size (S.downloaded swarmer);
3359                raise Exit                raise Exit
3360              with Not_found -> ()                                with Not_found -> ()
3361            in            in
3362              
3363            let downloaders_counter = ref 0 in            let downloaders_counter = ref 0 in
3364              
3365            let downloader swarmer =            let downloader swarmer =
3366              incr downloaders_counter;              incr downloaders_counter;
3367              let d = !downloaders_counter in              let d = !downloaders_counter in
3368              lprintf "Creating downloader %d\n" d;              lprintf "Creating downloader %d\n" d;
3369                
3370              let nchunks = S.partition_size swarmer in              let nchunks = S.partition_size swarmer in
3371              let bitmap = String2.init nchunks (fun i ->              let bitmap = String2.init nchunks (fun i ->
3372                    if (i lxor d) land 1 = 1 then '1' else '0') in                    if (i lxor d) land 1 = 1 then '1' else '0') in
# Line 3374  module Check = struct Line 3374  module Check = struct
3374                  (AvailableCharBitmap bitmap) in                  (AvailableCharBitmap bitmap) in
3375              let block = ref None in              let block = ref None in
3376              let ranges = ref [] in              let ranges = ref [] in
3377                
3378              let receive_range () =              let receive_range () =
3379                match !ranges with                match !ranges with
3380                  [] -> assert false                  [] -> assert false
3381                | (x,y,r) :: rs ->                | (x,y,r) :: rs ->
3382                      
3383                    let maxlen = y -- x in                    let maxlen = y -- x in
3384                    let maxlen = Int64.to_int maxlen in                    let maxlen = Int64.to_int maxlen in
3385                    if maxlen = 0 then begin                    if maxlen = 0 then begin
# Line 3389  module Check = struct Line 3389  module Check = struct
3389                    let len = max (Random.int maxlen) 1 in                    let len = max (Random.int maxlen) 1 in
3390                    if len = maxlen then                    if len = maxlen then
3391                      ranges := rs                      ranges := rs
3392                    else                    else
3393                      ranges := (x ++ Int64.of_int len, y, r) :: rs;                      ranges := (x ++ Int64.of_int len, y, r) :: rs;
3394                      
3395                    let s = String.create len in                    let s = String.create len in
3396                    lprintf "(%d) reading %Ld %d\n" d x len;                    lprintf "(%d) reading %Ld %d\n" d x len;
3397                    Unix32.read file_check_fd x s 0 len;                    Unix32.read file_check_fd x s 0 len;
3398                      
3399                    if Random.int 100 = 0 then begin                    if Random.int 100 = 0 then begin
3400                        lprintf "CORRUPTING data at %Ld\n" x;                        lprintf "CORRUPTING data at %Ld\n" x;
3401                        s.[0] <- '\000';                        s.[0] <- '\000';
3402                      end;                      end;
3403                      
3404                    lprintf "(%d) received %Ld %d\n" d x len;                    lprintf "(%d) received %Ld %d\n" d x len;
3405                    S.received up x s 0 len;                                S.received up x s 0 len;
3406                    check_finished swarmer                                check_finished swarmer
3407              in              in
3408              let ask_range () =              let ask_range () =
3409                try                try
3410                  let rec iter () =                  let rec iter () =
3411                    match !block with                    match !block with
3412                      None ->                      None ->
3413                          
3414                        lprintf "(%d) find_block\n" d;                        lprintf "(%d) find_block\n" d;
3415                        let b = S.find_block up in                        let b = S.find_block up in
3416                        block := Some b;                        block := Some b;
3417                        iter ()                        iter ()
3418                      
3419                    | Some b ->                    | Some b ->
3420                          
3421                        try                        try
3422                          lprintf "(%d) find_range\n" d;                          lprintf "(%d) find_range\n" d;
3423                          let (x,y,r) = S.find_range up in                          let (x,y,r) = S.find_range up in
3424                          lprintf "(%d) asked %Ld-%Ld\n" d x y;                          lprintf "(%d) asked %Ld-%Ld\n" d x y;
3425                          ranges := !ranges @ [x,y,r]                          ranges := !ranges @ [x,y,r]
3426                          
3427                        with Not_found ->                        with Not_found ->
3428                            block := None;                            block := None;
3429                            iter ()                            iter ()
3430                  in                  in
3431                  iter ()                  iter ()
3432                with Not_found ->                with Not_found ->
3433                    lprintf "(%d) Unable to find a block to download\n" d;                    lprintf "(%d) Unable to find a block to download\n" d;
3434                    S.compute_bitmap swarmer;                    S.compute_bitmap swarmer;
3435                    check_finished swarmer                                check_finished swarmer
3436              in              in
3437              (fun receive ->              (fun receive ->
3438                  lprintf "downloader %d %d for seed %d\n" d receive seed;                  lprintf "downloader %d %d for seed %d\n" d receive seed;
3439                  let nranges = List.length !ranges in                  let nranges = List.length !ranges in
3440                  if receive = 1 && nranges > 0 then receive_range () else                  if receive = 1 && nranges > 0 then receive_range () else
3441                  if receive = 0 && nranges < 3 then ask_range () else                  if receive = 0 && nranges < 3 then ask_range () else
3442                  if nranges < 3 then ask_range () else                  if nranges < 3 then ask_range () else
3443                  if nranges > 0 then receive_range ();                  if nranges > 0 then receive_range ();
3444                    
3445                  lprintf "downloader done\n";                  lprintf "downloader done\n";
3446              )              )
3447            in                in
3448            lprintf "Downloaders created\n";            lprintf "Downloaders created\n";
3449            let downloaders = Array.init ndownloaders (fun _ ->            let downloaders = Array.init ndownloaders (fun _ ->
3450                  downloader files.(Random.int nfiles)) in                  downloader files.(Random.int nfiles)) in
3451            try            try
3452              lprintf "Start loop\n";              lprintf "Start loop\n";
3453              while true do              while true do
3454                downloaders.(Random.int ndownloaders) (Random.int 2)                downloaders.(Random.int ndownloaders) (Random.int 2)
3455              done              done
3456            with Exit ->            with Exit ->
3457                lprintf "File correctly downloaded\n";                lprintf "File correctly downloaded\n";
3458        ) !seeds ;        ) !seeds ;
3459        exit 0        exit 0

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26