1
(************************************************************************)
2
(* This file is part of SKS. SKS is free software; you can
3
redistribute it and/or modify it under the terms of the GNU General
4
Public License as published by the Free Software Foundation; either
5
version 2 of the License, or (at your option) any later version.
7
This program is distributed in the hope that it will be useful, but
8
WITHOUT ANY WARRANTY; without even the implied warranty of
9
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10
General Public License for more details.
12
You should have received a copy of the GNU General Public License
13
along with this program; if not, write to the Free Software
14
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
16
(***********************************************************************)
18
(** Conversion to and from ASCII armor *)
1
(***********************************************************************)
2
(* armor.ml- Conversion to and from ASCII armor *)
4
(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
5
(* 2011, 2012 Yaron Minsky and Contributors *)
7
(* This file is part of SKS. SKS is free software; you can *)
8
(* redistribute it and/or modify it under the terms of the GNU General *)
9
(* Public License as published by the Free Software Foundation; either *)
10
(* version 2 of the License, or (at your option) any later version. *)
12
(* This program is distributed in the hope that it will be useful, but *)
13
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
14
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
15
(* General Public License for more details. *)
17
(* You should have received a copy of the GNU General Public License *)
18
(* along with this program; if not, write to the Free Software *)
19
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
20
(* USA or see <http://www.gnu.org/licenses/>. *)
21
(***********************************************************************)
23
27
external crc_of_string : string -> int = "caml_crc_octets"
26
30
let encoder = Cryptokit.Base64.encode_multiline () in
27
31
encoder#put_string input;
33
37
encoder#put_char (char_of_int ((crc lsr 8) land 0xFF));
34
38
encoder#put_char (char_of_int (crc land 0xFF));
37
if base64.[String.length base64 - 1] <> '\n'
41
if base64.[String.length base64 - 1] <> '\n'
38
42
then base64 ^ "\n" else base64 in
39
43
base64 ^ "=" ^ encoder#get_string
41
let pubkey_armor_header = "-----BEGIN PGP PUBLIC KEY BLOCK-----"
42
let pubkey_armor_tail = "-----END PGP PUBLIC KEY BLOCK-----"
45
let pubkey_armor_header = "-----BEGIN PGP PUBLIC KEY BLOCK-----"
46
let pubkey_armor_tail = "-----END PGP PUBLIC KEY BLOCK-----"
45
let encode_pubkey key =
49
let encode_pubkey key =
46
50
let armor_header = pubkey_armor_header
47
51
and armor_tail = pubkey_armor_tail
48
and version = (sprintf "Version: SKS %s" Common.version)
52
and version = (sprintf "Version: SKS %s%s" Common.version Common.version_suffix)
53
and hostname = (sprintf "Comment: Hostname: %s" (if String.length !Settings.hostname > 53 then String.sub !Settings.hostname 0 53 else !Settings.hostname))
50
55
let input = Key.to_string key in
51
56
armor_header ^ "\n" ^
53
59
base64crc input ^ "\n" ^
56
let encode_pubkey_string keystr =
62
let encode_pubkey_string keystr =
57
63
let armor_header = pubkey_armor_header
58
64
and armor_tail = pubkey_armor_tail
59
and version = (sprintf "Version: SKS %s" Common.version)
65
and version = (sprintf "Version: SKS %s%s" Common.version Common.version_suffix)
66
and hostname = (sprintf "Comment: Hostname: %s" (if String.length !Settings.hostname > 53 then String.sub !Settings.hostname 0 53 else !Settings.hostname))
61
68
let input = keystr in
62
69
armor_header ^ "\n" ^
64
72
base64crc input ^ "\n" ^
68
76
let decoder = Cryptokit.Base64.decode () in
69
77
decoder#put_string s;
71
79
let b1 = decoder#get_byte in
72
80
let b2 = decoder#get_byte in
73
81
let b3 = decoder#get_byte in
74
b1 lsl 16 + b2 lsl 8 + b3
82
b1 lsl 16 + b2 lsl 8 + b3
76
84
let eol = Str.regexp "[ \t]*\r?\n"
81
89
let rec read_adata lines = match lines with
82
90
[] -> failwith "Error while decoding ascii-armored key: text terminated before reaching CRC sum"
85
then ( (* close the decoder and return the CRC string *)
87
let crc = decode_crc (String.sub ~pos:1
88
~len:(String.length line - 1) line)
89
and data = decoder#get_string in
93
decoder#put_string line;
93
then ( (* close the decoder and return the CRC string *)
95
let crc = decode_crc (String.sub ~pos:1
96
~len:(String.length line - 1) line)
97
and data = decoder#get_string in
101
decoder#put_string line;
96
104
and read_full lines = match lines with
97
105
[] -> failwith "Error while decoding ascii-armored key: text terminated before reaching PGP public key header line"
99
if line = pubkey_armor_header then read_block tl
107
if line = pubkey_armor_header then read_block tl
101
109
and read_block lines = match lines with
102
110
[] -> failwith "Error while decoding ascii-armored key: text terminated before beginning of ascii block"
104
if line = "" then read_adata tl
112
if line = "" then read_adata tl
107
115
let (data,crc) = read_full lines in
108
116
let data_crc = crc_of_string data in
109
117
assert (data_crc = crc);
110
118
Key.of_string_multiple data
added
removed
armor.ml
