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 |
|
|
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. |
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. |
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 |
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 |
|
|
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 |
|
|
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 |
(*************************************************************************) |
(*************************************************************************) |
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 = []; |
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 |
|
|
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 |
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 *) |
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; |
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) *) |
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; |
329 |
} |
} |
330 |
in |
in |
331 |
r |
r |
332 |
|
|
333 |
(*************************************************************************) |
(*************************************************************************) |
334 |
(* *) |
(* *) |
335 |
(* cut_ranges (internal) *) |
(* cut_ranges (internal) *) |
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) *) |
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 |
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) *) |
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 |
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; |
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; |
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, |
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 |
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 -> |
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) |
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; |
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 -> |
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 |
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) *) |
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; |
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; |
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 |
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 |
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); |
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); |
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 *) |
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 |
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 |
(*************************************************************************) |
(*************************************************************************) |
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 *) |
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 |
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 |
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 = |
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 |
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 |
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) *) |
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 |
| _ -> |
| _ -> |
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 -> () |
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'; |
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 |
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 |
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 |
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 |
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 |
1204 |
with VerifierNotReady -> () |
with VerifierNotReady -> () |
1205 |
end |
end |
1206 |
|
|
1207 |
|
|
1208 |
(*************************************************************************) |
(*************************************************************************) |
1209 |
(* *) |
(* *) |
1210 |
(* must_verify_chunk (internal) *) |
(* must_verify_chunk (internal) *) |
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 |
|
|
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 |
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 *) |
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; |
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 |
|
|
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; |
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; |
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 |
1372 |
| Some rr -> f rr |
| Some rr -> f rr |
1373 |
*) |
*) |
1374 |
|
|
1375 |
|
|
1376 |
(*************************************************************************) |
(*************************************************************************) |
1377 |
(* *) |
(* *) |
1378 |
(* add_all_downloaded *) |
(* add_all_downloaded *) |
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 |
|
|
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 |
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 |
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; *) |
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) *) |
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 |
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 |
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 |
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 |
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 |
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; |
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 |
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 |
|
|
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" |
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 |
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 |
|
|
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) *) |
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; |
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 |
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 |
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) *) |
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 |
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 |
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 *) |
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 |
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 |
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 |
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 |
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 *) |
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 -> |
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; |
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 |
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 |
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 && |
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 *) |
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 |
(* *) |
(* *) |
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"; |
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 |
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 *) |
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 |
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 |
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 |
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 |
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) |
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 |
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 |
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 = |
2574 |
Verification tab -> tab |
Verification tab -> tab |
2575 |
| _ -> [||] |
| _ -> [||] |
2576 |
|
|
2577 |
|
|
2578 |
|
|
2579 |
(*************************************************************************) |
(*************************************************************************) |
2580 |
(* *) |
(* *) |
2581 |
(* primary (internal) *) |
(* primary (internal) *) |
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 *) |
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'; |
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 _ -> |
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 *) |
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 |
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 |
(*************************************************************************) |
(*************************************************************************) |
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 |
|
|
2683 |
|
|
2684 |
let uploader_swarmer up = up.up_t |
let uploader_swarmer up = up.up_t |
2685 |
|
|
2686 |
|
|
2687 |
(*************************************************************************) |
(*************************************************************************) |
2688 |
(* *) |
(* *) |
2689 |
(* availability *) |
(* availability *) |
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) |
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 |
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 *) |
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 |
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; |
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 |
|
|
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 |
(* *) |
(* *) |
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 |
(*************************************************************************) |
(*************************************************************************) |
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 *) |
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 |
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 *) |
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 *) |
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 -> |
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); |
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 *) |
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 |
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 |
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 *) |
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) + |
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 |
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 |
(*************************************************************************) |
(*************************************************************************) |
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; |
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 |
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 |
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 |
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; |
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 |
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 |
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 |