File: parsePGP.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 (368 lines) | stat: -rw-r--r-- 13,175 bytes parent folder | download | duplicates (3)
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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
(***********************************************************************)
(* parsePGP.ml                                                         *)
(*                                                                     *)
(* 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 Common
open Packet
open Printf

exception Overlong_mpi
exception Partial_body_length of int

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

(** parse new-style packet length *)
let parse_new_packet_length cin =
  let byte1 = cin#read_byte in
  if byte1 <= 191 then byte1  (* one-octet length *)
  else if byte1 <= 223  then (* two-octet length *)
    let byte2 = cin#read_byte in
    (byte1 - 192) lsl 8 + byte2 + 192
  else if byte1 = 255 then (* five-octet length *)
    let byte2 = cin#read_byte in
    let byte3 = cin#read_byte in
    let byte4 = cin#read_byte in
    let byte5 = cin#read_byte in
    (byte2 lsl 24) lor (byte3 lsl 16) lor (byte4 lsl 8) lor byte5
  else (* partial body length *)
    raise (Partial_body_length (1 lsl (byte1 land 0x1f)))

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

let read_packet cin =
  let packet_tag = cin#read_byte in
  if ((packet_tag lsr 7) land 1 <> 1)
  then failwith (sprintf "Bit 7 of packet tag was not 1 as expected: %x"
                   packet_tag);
  match (packet_tag lsr 6) land 1 with

      0 -> (* old format *)
        let content_tag = (packet_tag land 0b111100) lsr 2
        and length_type = packet_tag land 0b11
        in
        (match length_type with
             0 | 1 | 2 ->
               let length_length = 1 lsl length_type in
               let length_str = cin#read_string length_length in
               let length = Utils.int_from_bstring length_str
                              ~pos:0 ~len:length_length in
               { content_tag = content_tag;
                 packet_type = content_tag_to_ptype content_tag;
                 packet_length = length;
                 packet_body = cin#read_string length;
               }

           | 3 -> (* indeterminate length header --- extends to end of file *)
               failwith "Unexpected indeterminate length packet"
           | _ ->
               failwith "Unexpected length type"
        )

    | 1 -> (* new_format *)
        let content_tag = packet_tag land 0b111111 in
        let length = parse_new_packet_length cin in
        { (* packet_tag = packet_tag; *)
          content_tag = content_tag;
          packet_type = content_tag_to_ptype content_tag;
          packet_length = length;
          packet_body = cin#read_string length;
        }

    | _ -> raise (Bug "ParsePGP.read_packet: expected 0/1 value")


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

let offset_read_packet cin =
  let offset = LargeFile.pos_in cin#inchan in
  let packet = read_packet cin in
  (offset,packet)

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

let offset_length_read_packet cin =
  let offset = pos_in cin#inchan in
  let packet = read_packet cin in
  let final_offset = pos_in cin#inchan in
  (packet,offset,final_offset - offset)

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

let read_mpi cin =
  let byte1 = cin#read_byte in
  try
    let byte2 = cin#read_byte in
    let length = (byte1 lsl 8) + byte2 in
    let data = cin#read_string
                 ((length + 7)/8)
    in
    { mpi_bits = length; mpi_data = data }
  with
      End_of_file -> raise Overlong_mpi

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

let read_mpis cin =
  let rec loop list =
    match (try (Some (read_mpi cin))
           with End_of_file -> None)
    with
      | Some mpi -> loop (mpi::list)
      | None -> List.rev list
  in
  loop []

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

(* RFC6637:
   The following algorithm-specific packets are added to Section 5.5.2
   of [RFC4880], "Public-Key Packet Formats", to support ECDH and ECDSA.
 *)

(* OIDs defined in 11. ECC Curve OID of RFC6637 *)
let oid_to_psize oid =
   let psize = match oid with
     | "\x2b\x81\x04\x00\x23" -> 521         		(* nistp521 *)
     | "\x2b\x81\x04\x00\x22" -> 384         		(* nistp384 *)
     | "\x2a\x86\x48\xce\x3d\x03\x01\x07" -> 256   	(* nistp256 *)
     | "\x2b\x24\x03\x03\x02\x08\x01\x01\x07" -> 256 	(* brainpoolP256r1 *)
     | "\x2b\x24\x03\x03\x02\x08\x01\x01\x0b" -> 384 	(* brainpoolP384r1 *)
     | "\x2b\x24\x03\x03\x02\x08\x01\x01\x0d" -> 512 	(* brainpoolP512r1 *)
     | "\x2b\x81\x04\x00\x0a" -> 256         		(* secp256k1 *)
     | "\x2b\x06\x01\x04\x01\xda\x47\x0f\x01" -> 256	(* Ed25519 *)  
     | "\x2b\x06\x01\x04\x01\x97\x55\x01\x05\x01" -> 256 (* cv25519 *)
     | _ -> failwith "Unknown OID"
   in
   psize


let parse_ecdh_pubkey cin =
   let length = cin#read_int_size 1 in
   let oid = cin#read_string length in
   let mpi = read_mpi cin in
   let kdf_length = cin#read_int_size 1 in
   let kdf_res = cin#read_int_size 1 in
   let kdf_hash = cin#read_int_size 1 in
   let kdf_algid = cin#read_int_size 1 in
   plerror 10 "KDF_length: %d, KDF_res %d hash %d algid %d" kdf_length kdf_res kdf_hash kdf_algid;
   let psize = oid_to_psize oid
   in
   (mpi, psize)

 (* Algorithm specific fields for ECDSA and EdDSA *)
 let parse_ecdsa_pubkey cin =
   let length = cin#read_int_size 1 in
   let oid = cin#read_string length in
   let psize = oid_to_psize oid
   in
   psize

let parse_pubkey_info packet =
  let cin = new Channel.string_in_channel packet.packet_body 0 in
  let version = cin#read_byte in
  let creation_time = cin#read_int64_size 4 in
  let (algorithm,mpi,expiration, psize) =
    match version with
      | 4 ->
      let algorithm = cin#read_byte in
      let (tmpmpi, tmpsize) =  match algorithm with
        | 18 -> parse_ecdh_pubkey cin
        | 19 | 22 -> ( {mpi_bits = 0; mpi_data = ""}, (parse_ecdsa_pubkey cin))
        | _ -> ( {mpi_bits = 0; mpi_data = ""} , -1 )
      in
      let mpis = match algorithm with
       | 18 -> tmpmpi
       | _ -> let mmpis = read_mpis cin in List.hd mmpis
      in
      (algorithm,mpis,None, tmpsize)
      | 2 | 3 ->
      let expiration = cin#read_int_size 2 in
      let algorithm = cin#read_byte in
      let mpis = read_mpis cin in
      let mpi = List.hd mpis in
      (algorithm,mpi,Some expiration, -1)
      | _ -> failwith (sprintf "Unexpected pubkey version: %d" version)
  in
  { pk_version = version;
    pk_ctime = creation_time;
    pk_expiration = (match expiration with Some 0 -> None | x -> x);
    pk_alg = algorithm;
    pk_keylen = (match algorithm with |18|19|22 -> psize | _ -> mpi.mpi_bits);
  }

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


(** Parsing of signature subpackets *)

(** parse sigsubpacket length *)
let parse_sigsubpacket_length cin =
  let byte1 = cin#read_byte in
  if byte1 < 192 then byte1 (* one octet length *)
  else if byte1  < 255 then
    let byte2 = cin#read_byte in
    ((byte1 - 192) lsl 8) + (byte2) + 192
  else if byte1 = 255 then (* five-octet length *)
    let byte2 = cin#read_byte in
    let byte3 = cin#read_byte in
    let byte4 = cin#read_byte in
    let byte5 = cin#read_byte in
    (byte2 lsl 24) lor (byte3 lsl 16) lor (byte4 lsl 8) lor byte5
  else
    failwith "Unable to parse sigsubpacket length"

let read_sigsubpacket cin =
  let length = parse_sigsubpacket_length cin in
  let ssp_type = cin#read_byte land 0x7f in
  let body = cin#read_string (length - 1) in
  { ssp_length = length - 1;
    ssp_type = ssp_type;
    ssp_body = body;
  }

let get_hashed_subpacket_string cin =
  let version = cin#read_byte in
  if version <> 4 then
    failwith "Attempt to parse non-v4 signature as v4 signature";
  let _sigtype = cin#read_byte in
  let _key_alg = cin#read_byte in
  let _hash_alg = cin#read_byte in
  let hashed_subpacket_count = cin#read_int_size 2 in
  (* now we can start reading the hashed sub-packets *)
  cin#read_string hashed_subpacket_count

(** return list of signature sub-packets *)
let read_subpackets cin length =
  let subpacket_string = cin#read_string length in
  let cin = new Channel.string_in_channel subpacket_string 0 in
  let rec loop list =
    match (try Some (read_sigsubpacket cin)
           with End_of_file -> None)
    with
      | Some subpack -> loop (subpack::list)
      | None -> List.rev list
  in
  loop []

let parse_signature packet =
  let cin = new Channel.string_in_channel packet.packet_body 0 in
  let version = cin#read_byte in
  match version with

    | 2 | 3 ->
        cin#skip 1; (* length packet which must be 5 *)
        let sigtype = cin#read_byte in
        let ctime = cin#read_int64_size 4 in
        let keyid = cin#read_string 8 in
        let pk_alg = cin#read_byte in
        let hash_alg = cin#read_byte in
        let hash_value = cin#read_string 2 in
        let mpis = read_mpis cin in
        V3sig { v3s_sigtype = sigtype;
                v3s_ctime = ctime;
                v3s_keyid = keyid;
                v3s_pk_alg = pk_alg;
                v3s_hash_alg = hash_alg;
                v3s_hash_value = hash_value;
                v3s_mpis = mpis;
              }

    | 4 ->
        let sigtype = cin#read_byte in
        let pk_alg = cin#read_byte in
        let _hash_alg = cin#read_byte in

        let hashed_subpacket_bytes = cin#read_int_size 2 in
        let hashed_subpackets = read_subpackets cin hashed_subpacket_bytes in

        let unhashed_subpacket_bytes = cin#read_int_size 2 in
        let unhashed_subpackets = read_subpackets cin unhashed_subpacket_bytes in

        let hash_value = cin#read_string 2 in
        let mpis = read_mpis cin in
        V4sig { v4s_sigtype = sigtype;
                v4s_pk_alg = pk_alg;
                v4s_hashed_subpackets = hashed_subpackets;
                v4s_unhashed_subpackets = unhashed_subpackets;
                v4s_hash_value = hash_value;
                v4s_mpis = mpis;
              }


    | _ -> failwith (sprintf "Unexpected signature version: %d" version)


let ssp_ctime_id = 2
let ssp_exptime_id = 3
let ssp_keyexptime_id = 9

let int32_of_string s =
  let cin = new Channel.string_in_channel s 0 in
  cin#read_int32

let int64_of_string s =
  let cin = new Channel.string_in_channel s 0 in
  cin#read_int64_size (String.length s)

let get_key_exptimes sign = match sign with
  | V3sig sign ->
      (Some sign.v3s_ctime, None)
  | V4sig sign ->
      let hashed_subpackets = sign.v4s_hashed_subpackets in
      let (ctime,exptime_delta) =
        List.fold_left hashed_subpackets ~init:(None,None)
          ~f:(fun (ctime,exptime) ssp ->
                if ssp.ssp_type = ssp_ctime_id && ssp.ssp_length = 4 then
                  (Some (int64_of_string ssp.ssp_body),exptime)
                else if ssp.ssp_type = ssp_keyexptime_id && ssp.ssp_length = 4 then
                  (ctime,Some (int64_of_string ssp.ssp_body))
                else
                  (ctime,exptime)
             )
      in
      match exptime_delta with
        | None -> (None,None)
        | Some _ -> (ctime,exptime_delta)


let get_times sign = match sign with
  | V3sig sign ->
      (Some sign.v3s_ctime, None)
  | V4sig sign ->
      let hashed_subpackets = sign.v4s_hashed_subpackets in
      let (ctime,exptime_delta) =
        List.fold_left hashed_subpackets ~init:(None,None)
          ~f:(fun (ctime,exptime) ssp ->
                if ssp.ssp_type = ssp_ctime_id && ssp.ssp_length = 4 then
                  (Some (int64_of_string ssp.ssp_body),exptime)
                else if ssp.ssp_type = ssp_exptime_id && ssp.ssp_length = 4 then
                  (ctime,Some (int64_of_string ssp.ssp_body))
                else
                  (ctime,exptime)
             )
      in
      match (ctime,exptime_delta) with
        | (Some x,None) -> (Some x,None)
        | (None,_) -> (None,None)
        | (Some x,Some y) -> (Some x,Some (Int64.add x y))