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
|
(* virt-builder
* Copyright (C) 2013 Red Hat Inc.
*
* This program 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.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
open Std_utils
open Tools_utils
open Unix_utils
open Common_gettext.Gettext
open Utils
open Printf
open Unix
type t = {
gpg : string;
fingerprint : string;
subkeys_fingerprints : string list;
check_signature : bool;
gpghome : string;
tmpdir : string;
}
(* Import the specified key file. *)
let import_keyfile ~gpg ~gpghome ~tmpdir ?(trust = true) keyfile =
let status_file = Filename.temp_file ~temp_dir:tmpdir "vbstat" ".txt" in
let cmd = sprintf "%s --homedir %s --status-file %s --import %s%s"
gpg gpghome (quote status_file) (quote keyfile)
(if verbose () then "" else " >/dev/null 2>&1") in
let r = shell_command cmd in
if r <> 0 then
error (f_"could not import public key\nUse the ‘-v’ option and look for earlier error messages.");
let status = read_whole_file status_file in
let status = String.nsplit "\n" status in
let key_id = ref "" in
let fingerprint = ref "" in
List.iter (
fun line ->
let line = String.nsplit " " line in
match line with
| "[GNUPG:]" :: "IMPORT_OK" :: _ :: fp :: _ -> fingerprint := fp
| "[GNUPG:]" :: "IMPORTED" :: key :: _ -> key_id := key
| _ -> ()
) status;
if trust then (
let cmd = sprintf "%s --homedir %s --trusted-key %s --list-keys%s"
gpg gpghome (quote !key_id)
(if verbose () then "" else " >/dev/null 2>&1") in
let r = shell_command cmd in
if r <> 0 then
error (f_"GPG failure: could not trust the imported key\nUse the ‘-v’ option and look for earlier error messages.");
);
let subkeys =
(* --with-fingerprint is specified twice so gpg outputs the full
* fingerprint of the subkeys. *)
let cmd = sprintf "%s --homedir %s --with-colons --with-fingerprint --with-fingerprint --list-keys %s"
gpg gpghome !fingerprint in
let lines = external_command cmd in
let current = ref None in
let subkeys = ref [] in
List.iter (
fun line ->
let line = String.nsplit ":" line in
match line with
| "sub" :: ("u"|"-") :: _ :: _ :: id :: _ ->
current := Some id
| "fpr" :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: id :: _ ->
(match !current with
| None -> ()
| Some k ->
if String.is_suffix id k then List.push_front id subkeys;
current := None
)
| _ -> ()
) lines;
!subkeys in
!fingerprint, subkeys
let rec create ~gpg ~gpgkey ~check_signature ~tmpdir =
(* Create a temporary directory for gnupg. *)
let gpgtmpdir = Mkdtemp.temp_dir ~base_dir:tmpdir "vb.gpghome." in
(* Make sure we have no check_signature=true with no actual key. *)
let check_signature, gpgkey =
match check_signature, gpgkey with
| true, No_Key -> false, No_Key
| x, y -> x, y in
let fingerprint, subkeys =
if check_signature then (
(* Run gpg so it can setup its own home directory, failing if it
* cannot.
*)
let cmd = sprintf "%s --homedir %s --list-keys%s"
gpg gpgtmpdir (if verbose () then "" else " >/dev/null 2>&1") in
let r = shell_command cmd in
if r <> 0 then
error (f_"GPG failure: could not run GPG the first time\nUse the ‘-v’ option and look for earlier error messages.");
match gpgkey with
| No_Key ->
assert false
| KeyFile kf ->
import_keyfile gpg gpgtmpdir tmpdir kf
| Fingerprint fp ->
let filename = Filename.temp_file ~temp_dir:tmpdir "vbpubkey" ".asc" in
let cmd = sprintf "%s --yes --armor --output %s --export %s%s"
gpg (quote filename) (quote fp)
(if verbose () then "" else " >/dev/null 2>&1") in
let r = shell_command cmd in
if r <> 0 then
error (f_"could not export public key\nUse the ‘-v’ option and look for earlier error messages.");
import_keyfile gpg gpgtmpdir tmpdir filename
) else
"", [] in
{
gpg = gpg;
fingerprint = fingerprint;
subkeys_fingerprints = subkeys;
check_signature = check_signature;
gpghome = gpgtmpdir;
tmpdir = tmpdir;
}
(* Compare two strings of hex digits ignoring whitespace and case. *)
and equal_fingerprints fp1 fp2 =
let len1 = String.length fp1 and len2 = String.length fp2 in
let rec loop i j =
if i = len1 && j = len2 then true (* match! *)
else if i = len1 || j = len2 then false (* no match - different lengths *)
else (
let x1 = getxdigit fp1.[i] and x2 = getxdigit fp2.[j] in
match x1, x2 with
| Some x1, Some x2 when x1 = x2 -> loop (i+1) (j+1)
| Some x1, Some x2 -> false (* no match - different content *)
| Some _, None -> loop i (j+1)
| None, Some _ -> loop (i+1) j
| None, None -> loop (i+1) (j+1)
)
in
loop 0 0
and getxdigit = function
| '0'..'9' as c -> Some (Char.code c - Char.code '0')
| 'a'..'f' as c -> Some (Char.code c - Char.code 'a')
| 'A'..'F' as c -> Some (Char.code c - Char.code 'A')
| _ -> None
let verifying_signatures t =
t.check_signature
let rec verify t filename =
if t.check_signature then (
let args = quote filename in
do_verify t args
)
and verify_detached t filename sigfile =
if t.check_signature then (
match sigfile with
| None ->
error (f_"there is no detached signature file\nThis probably means the index file is missing a sig=... line.\nYou can use --no-check-signature to ignore this error, but that means you are susceptible to man-in-the-middle attacks.")
| Some sigfile ->
let args = sprintf "%s %s" (quote sigfile) (quote filename) in
do_verify t args
)
and verify_and_remove_signature t filename =
if t.check_signature then (
(* Copy the input file as temporary file with the .asc extension,
* so gpg recognises that format. *)
let asc_file = Filename.temp_file ~temp_dir:t.tmpdir "vbfile" ".asc" in
let cmd = [ "cp"; filename; asc_file ] in
if run_command cmd <> 0 then exit 1;
let out_file = Filename.temp_file ~temp_dir:t.tmpdir "vbfile" "" in
let args = sprintf "--yes --output %s %s" (quote out_file) (quote filename) in
do_verify ~verify_only:false t args;
Some out_file
) else
None
and do_verify ?(verify_only = true) t args =
let status_file = Filename.temp_file ~temp_dir:t.tmpdir "vbstat" ".txt" in
let cmd =
sprintf "%s --homedir %s %s%s --status-file %s %s"
t.gpg t.gpghome
(if verify_only then "--verify" else "")
(if verbose () then "" else " --batch -q --logger-file /dev/null")
(quote status_file) args in
let r = shell_command cmd in
if r <> 0 then
error (f_"GPG failure: could not verify digital signature of file\nTry:\n - Use the ‘-v’ option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!");
(* Check the fingerprint is who it should be. *)
let status = read_whole_file status_file in
let status = String.nsplit "\n" status in
let fingerprint = ref "" in
List.iter (
fun line ->
let line = String.nsplit " " line in
match line with
| "[GNUPG:]" :: "VALIDSIG" :: fp :: _ -> fingerprint := fp
| _ -> ()
) status;
if not (equal_fingerprints !fingerprint t.fingerprint) &&
not (List.exists (equal_fingerprints !fingerprint) t.subkeys_fingerprints) then
error (f_"fingerprint of signature does not match the expected fingerprint!\n found fingerprint: %s\n expected fingerprint: %s")
!fingerprint t.fingerprint
|
