File: sksdump.ml

package info (click to toggle)
sks 1.1.5-1~bpo70%2B1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy-backports
  • size: 2,076 kB
  • sloc: ml: 15,262; ansic: 1,069; makefile: 346; sh: 279
file content (161 lines) | stat: -rw-r--r-- 6,077 bytes parent folder | download | duplicates (2)
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
(***********************************************************************)
(* sksdump.ml - takes content of SKS keyserver and creates key dump    *)
(*              from that                                              *)
(*                                                                     *)
(* 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/>.                          *)
(***********************************************************************)

module F(M:sig end) =
struct
  open StdLabels
  open MoreLabels
  open Printf
  open Common
  open Packet

  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 should_dump skey = match skey with
    | Keydb.KeyString _ | Keydb.Key _ -> true
    | Keydb.Offset _  | Keydb.LargeOffset _ ->
        if !Settings.dump_new then false else true

  let rec write_to_file size stream cout =
    if size <= 0 then ()
    else
      match SStream.next stream with
        | None -> ()
        | Some (hash,string) ->
            let remain =
            try
              let skey = Keydb.skey_of_string string in
              if should_dump skey then
                let keystring = Keydb.keystring_of_skey skey in
                output_string cout keystring;
                size - 1
              else
                size
            with
                e ->
                  eplerror 1 e "Failed attempt to extract key %s"
                  (KeyHash.hexify hash);
                  size
            in
            write_to_file remain stream cout


  let write_to_fname size stream fname =
    printf "Dumping keys to file %s\n" fname;
    flush stdout;
    let file = open_out fname in
    protect ~f:(fun () -> write_to_file size stream file)
      ~finally:(fun () -> close_out file)
  
  let time_to_string time =
   let tm = Unix.localtime time in
    sprintf "%04d-%02d-%02d %02d:%02d:%02d"
    (1900 + tm.Unix.tm_year) (1 + tm.Unix.tm_mon) tm.Unix.tm_mday
    tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec


  let dump_database_create_metadata dumpdir name size ctr start_time =
   let fname = Filename.concat dumpdir (sprintf "metadata-%s.txt" name) in
   let numkey = Keydb.get_num_keys () in
   let c = ref 0  in
   let file = open_out fname in
   fprintf file "#Metadata-for: %s\n" !Settings.hostname;
   fprintf file "#Dump-started: %s\n" (time_to_string start_time);
   fprintf file "#Files-Count: %d\n" ctr;
   fprintf file "#Key-Count: %d\n" numkey;
   fprintf file "#Digest-algo: md5\n";
   while !c < ctr do 
     fprintf file "%s %s-%04d.pgp\n" (Digest.to_hex(
      Digest.file (Filename.concat dumpdir (sprintf "%s-%04d.pgp" name !c))))
      name !c;
     incr c
   done;
   fprintf file "#Dump-ended: %s\n" (time_to_string 
                                        (Unix.gettimeofday()));
   close_out file;
   ()
  
  let dump_database dumpdir size name =
   let (stream,close) = Keydb.create_hash_skey_stream () in
   let start_time = Unix.gettimeofday() in
   let () = if not (Sys.file_exists dumpdir) then
    Unix.mkdir dumpdir  0o700; in
   let run () =
    let ctr = ref 0 in
    while SStream.peek stream <> None do
     let fname =
      Filename.concat dumpdir (sprintf "%s-%04d.pgp" name !ctr) in
     write_to_fname size stream fname;
     incr ctr
    done;
    dump_database_create_metadata dumpdir name size !ctr start_time
    in
    protect ~f:run ~finally:close



  exception Argument_error

  (***************************************************************)

  let () = Sys.set_signal Sys.sigusr1 Sys.Signal_ignore
  let () = Sys.set_signal Sys.sigusr2 Sys.Signal_ignore

  (***************************************************************)

  let run () =
    try (
      match !Settings.anonlist with
        | size::dumpdir::tl ->
            let name = match tl with
              | [] -> "sks-dump"
              | [name] -> name
              | _ -> raise Argument_error
            in
            set_logfile "dump";
                perror "Running SKS %s%s" Common.version Common.version_suffix;
            Keydb.open_dbs settings;
            let size = int_of_string size in
            dump_database dumpdir size name
        | _ ->
            raise Argument_error
    ) with Argument_error ->
      eprintf "wrong number of arguments\n";
      eprintf "usage: sks dump numkeys dumpdir [dumpname]\n";
      flush stderr;
      exit (-1)
end