File: armor.ml

package info (click to toggle)
sks 1.1.3-2%2Bdeb7u1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,592 kB
  • sloc: ml: 13,621; ansic: 1,029; makefile: 330; sh: 315; python: 25
file content (112 lines) | stat: -rw-r--r-- 3,775 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
(************************************************************************)
(* 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 *)
(***********************************************************************)

(** Conversion to and from ASCII armor *)
open StdLabels
open MoreLabels
open Printf

external crc_of_string : string -> int = "caml_crc_octets"

let base64crc input = 
  let encoder = Cryptokit.Base64.encode_multiline () in
  encoder#put_string input;
  encoder#finish;
  let base64 = encoder#get_string in
  let crc = crc_of_string input in
  let encoder = Cryptokit.Base64.encode_compact () in
  encoder#put_char (char_of_int ((crc lsr 16) land 0xFF));
  encoder#put_char (char_of_int ((crc lsr 8) land 0xFF));
  encoder#put_char (char_of_int (crc land 0xFF));
  encoder#finish;
  let base64 = 
    if base64.[String.length base64 - 1] <> '\n' 
    then base64 ^ "\n" else base64 in
  base64 ^ "=" ^ encoder#get_string

let pubkey_armor_header = "-----BEGIN PGP PUBLIC KEY BLOCK-----" 
let pubkey_armor_tail = "-----END PGP PUBLIC KEY BLOCK-----" 

(* pubkey *)
let encode_pubkey key = 
  let armor_header = pubkey_armor_header
  and armor_tail = pubkey_armor_tail
  and version = (sprintf "Version: SKS %s" Common.version)
  in
  let input = Key.to_string key in
  armor_header ^ "\n" ^
  version ^ "\n\n" ^
  base64crc input ^ "\n" ^
  armor_tail
    
let encode_pubkey_string keystr = 
  let armor_header = pubkey_armor_header
  and armor_tail = pubkey_armor_tail
  and version = (sprintf "Version: SKS %s" Common.version)
  in
  let input = keystr in
  armor_header ^ "\n" ^
  version ^ "\n\n" ^
  base64crc input ^ "\n" ^
  armor_tail

let decode_crc s = 
  let decoder = Cryptokit.Base64.decode () in
  decoder#put_string s;
  decoder#finish;
  let b1 = decoder#get_byte in
  let b2 = decoder#get_byte in
  let b3 = decoder#get_byte in
  b1 lsl 16 + b2 lsl 8 + b3 

let eol = Str.regexp "[ \t]*\r?\n"

let decode_pubkey text =
  let decoder = Cryptokit.Base64.decode () in
  let lines = Str.split eol text in
  let rec read_adata lines = match lines with
      [] -> failwith "Error while decoding ascii-armored key: text terminated before reaching CRC sum"
    | line::tl ->
	if line.[0] = '=' 
	then ( (* close the decoder and return the CRC string *)
	  decoder#finish;
	  let crc = decode_crc (String.sub ~pos:1 
				  ~len:(String.length line - 1) line)
	  and data = decoder#get_string in
	  (data,crc)
	)
	else (
	  decoder#put_string line;
	  read_adata tl
	)
  and read_full lines = match lines with
      [] -> failwith "Error while decoding ascii-armored key:  text terminated before reaching PGP public key header line"
    | line::tl ->
	if line = pubkey_armor_header then read_block tl
	else read_full tl
  and read_block lines = match lines with
      [] -> failwith "Error while decoding ascii-armored key: text terminated before beginning of ascii block"
    | line::tl ->
	if line = "" then read_adata tl
	else read_block tl
  in
  let (data,crc) = read_full lines in
  let data_crc = crc_of_string data in
  assert (data_crc = crc);
  Key.of_string_multiple data