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
|
(***********************************************************************)
(* incdump.ml - creates keydump consisting of recently added keys *)
(* *)
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
(* 2011, 2012, 2013 Yaron Minsky and Contributors *)
(* Copyright (C) 2004 Peter Palfrader *)
(* *)
(* 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
open Packet
module Set = PSet.Set
let settings = {
Keydb.withtxn = !Settings.transactions;
Keydb.cache_bytes = !Settings.cache_bytes;
Keydb.pagesize = !Settings.pagesize;
Keydb.keyid_pagesize = !Settings.keyid_pagesize;
Keydb.meta_pagesize = !Settings.meta_pagesize;
Keydb.subkeyid_pagesize = !Settings.subkeyid_pagesize;
Keydb.time_pagesize = !Settings.time_pagesize;
Keydb.tqueue_pagesize = !Settings.tqueue_pagesize;
Keydb.word_pagesize = !Settings.word_pagesize;
Keydb.dbdir = Lazy.force Settings.dbdir;
Keydb.dumpdir = Lazy.force Settings.dumpdir;
}
module Keydb = Keydb.Unsafe
let dump_database timestamp fname =
let maxsize = 250_000 in
let log = Keydb.reverse_logquery ~maxsize timestamp in
if List.length log = 0 then
printf "No changes since timestamp\n"
else
let file = open_out fname in
let run () =
let newkeys = List.fold_left log ~init:Set.empty
~f:(fun set (_,change) -> match change with
Add hash -> Set.add hash set
| Delete hash -> Set.remove hash set)
in
printf "%d new keys in log.\n%!" (Set.cardinal newkeys);
Set.iter newkeys
~f:(fun hash ->
try
let keystring = Keydb.get_keystring_by_hash hash in
output_string file keystring;
with
e ->
eprintf "Error fetching keystring from hash %s: %s\n%!"
(Utils.hexstring hash)
(Printexc.to_string e)
)
in
protect ~f:run ~finally:(fun () -> close_out file)
let run () =
List.iter !Settings.anonlist
~f:(fun x -> printf "\"%s\" " x);
printf "\n%!";
match !Settings.anonlist with
| timestamp::tl ->
let name = match tl with
| [] -> "incdump.pgp"
| [name] -> name
| _ -> raise (Argument_error "too many arguments")
in
printf "saving to file %s\n%!" name;
set_logfile "incdump";
perror "Running SKS %s%s" Common.version Common.version_suffix;
Keydb.open_dbs settings;
protect ~f:(fun () ->
let timestamp = float_of_string timestamp in
dump_database timestamp name )
~finally:(fun () -> Keydb.close_dbs ())
| _ ->
raise (Argument_error "no timestamp provided")
|
