File: key.ml

package info (click to toggle)
sks 1.1.6-14
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 2,296 kB
  • sloc: ml: 15,228; ansic: 1,069; sh: 358; makefile: 347
file content (158 lines) | stat: -rw-r--r-- 5,018 bytes parent folder | download | duplicates (5)
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
(***********************************************************************)
(* key.ml - Basic key-related operations                               *)
(*                                                                     *)
(* 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 Packet
module Set = PSet.Set

exception Bug of string


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

let rec pos_next_rec ps partial =
  match SStream.peek ps with
      None -> Some (List.rev partial)
    | Some (_,packet) ->
        if packet.packet_type = Public_Key_Packet
        then Some (List.rev partial)
        else (
          SStream.junk ps;
          pos_next_rec ps (packet::partial)
        )

let pos_next ps =
  match SStream.peek ps with
      None -> None
    | Some (pos,pack) ->
        SStream.junk ps;
        match pos_next_rec ps [pack] with
            Some key -> Some (pos,key)
          | None -> None

let pos_get ps =
  match pos_next ps with
      None -> raise Not_found
    | Some key -> key

let pos_next_of_channel cin =
  let ps =
    SStream.make (fun () -> (try Some (ParsePGP.offset_read_packet cin)
                             with End_of_file -> None))
  in
  (fun () -> pos_next ps)

let pos_get_of_channel cin =
  let ps =
    SStream.make (fun () -> (try Some (ParsePGP.offset_read_packet cin)
                             with End_of_file -> None))
  in
  (fun () -> pos_get ps)

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

let rec next_rec ps partial =
  match SStream.peek ps with
      None -> Some (List.rev partial)
    | Some packet ->
        if packet.packet_type = Public_Key_Packet
        then Some (List.rev partial)
        else (
          SStream.junk ps;
          next_rec ps (packet::partial)
        )

let next ps =
  match SStream.peek ps with
      None -> None
    | Some pack ->
        SStream.junk ps;
        next_rec ps [pack]

let get ps =
  match next ps with
      None -> raise Not_found
    | Some key -> key

let next_of_channel cin =
  let ps =
    SStream.make (fun () -> (try Some (ParsePGP.read_packet cin)
                             with End_of_file -> None))
  in
  (fun () -> next ps)

let get_of_channel cin =
  let ps =
    SStream.make (fun () -> (try Some (ParsePGP.read_packet cin)
                             with End_of_file -> None))
  in
  (fun () -> get ps)


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

let rec get_ids key = match key with
    [] -> []
  | packet::tail ->
      if packet.packet_type = User_ID_Packet
      then packet.packet_body::(get_ids tail)
      else get_ids tail

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

let write key cout =
  List.iter ~f:(fun packet -> write_packet packet cout) key

let to_string key =
  let cout = Channel.new_buffer_outc 0 in
  write key cout;
  cout#contents

let of_string keystr =
  let cin = new Channel.string_in_channel keystr 0 in
  match next_of_channel cin () with
      None -> raise (Bug "key should have appeared")
    | Some key -> key

let of_string_multiple keystr =
  let cin = new Channel.string_in_channel keystr 0 in
  let next = next_of_channel cin in
  let rec loop () =
    match next () with
        None -> []
      | Some key -> key::(loop ())
  in
  loop ()

let to_string_multiple keys =
  let cout = Channel.new_buffer_outc 0 in
  List.iter ~f:(fun key -> write key cout) keys;
  cout#contents

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

let to_words key =
  let userids = get_ids key in
  let wordsets = List.map ~f:Utils.extract_word_set userids in
  Set.elements (List.fold_left ~init:Set.empty ~f:Set.union
                  wordsets)