1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
|
(***********************************************************************)
(* recoverList.ml - Code for managing reconserver's recover list, i.e. *)
(* the list of keys that need to be recovered from *)
(* other hosts. *)
(* *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(* 2011, 2012, 2013 Yaron Minsky and Contributors *)
(* *)
(* This file is part of SKS. SKS is free software; you can *)
(* redistribute it and/or modify it under the terms of the GNU General *)
(* Public License as published by the Free Software Foundation; either *)
(* version 2 of the License, or (at your option) any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA or see <http://www.gnu.org/licenses/>. *)
(***********************************************************************)
open StdLabels
open MoreLabels
open Printf
open Common
(** Queue of bundles of hashes to be recovered*)
type recover_element = string list * Unix.sockaddr
let hash_bundle_size = !Settings.http_fetch_size
let recover_list = (Queue.create () : recover_element Queue.t)
let gossip_disabled_var = ref false
let gossip_disabled () =
not (Queue.is_empty recover_list) || !gossip_disabled_var
let disable_gossip () =
plerror 5 "Disabling gossip";
gossip_disabled_var := true
let enable_gossip () =
plerror 5 "Enabling gossip";
gossip_disabled_var := false
(******************************************************)
let rec n_split list n = match (n,list) with
(0,_) | (_,[]) -> ([],list)
| (_,hd::tl) ->
let (first,rest) = n_split tl (n - 1) in
(hd::first,rest)
let size_split list size =
let rec loop list accum =
match n_split list size with
| ([],[]) -> List.rev accum
| (first,rest) -> loop rest (first::accum)
in
loop list []
let print_hashes source hashes =
if List.length hashes = 0
then plerror 4 "No hashes recovered from %s" source
else if List.length hashes <= 10 then (
plerror 3 "%d hashes recovered from %s" (List.length hashes) source;
List.iter hashes
~f:(fun hash -> plerror 3 "\t%s" (KeyHash.hexify hash));
) else
plerror 3 "%d hashes recovered from %s" (List.length hashes) source
(** converts a list of elements of ZZp to a sorted list of hashes *)
let hashconvert elements =
let hashes = List.rev_map ~f:ZZp.to_bytes elements in
let hashes = List.rev_map ~f:(fun hash -> RMisc.truncate hash
KeyHash.hash_bytes) hashes in
let hashes = List.sort ~cmp:compare hashes in
hashes
(** Dumps the hashes associated with the difference set to the named file *)
let log_diffs log_fname hashes =
if !Settings.log_diffs then
begin
let log_fname = Filename.concat !Settings.basedir log_fname in
let file = open_out log_fname in
protect ~f:(fun () -> List.iter hashes
~f:(fun h -> fprintf file "%s\n" (KeyHash.hexify h)))
~finally:(fun () -> close_out file)
end
let update_recover_list results partner_http_addr =
let hashes = hashconvert results in
let bundles = size_split hashes hash_bundle_size in
List.iter bundles ~f:(fun bundle ->
Queue.add (bundle,partner_http_addr)
recover_list);
if not (Queue.is_empty recover_list) then disable_gossip ()
|