File: sigchecker.ml

package info (click to toggle)
libguestfs 1%3A1.28.1-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 65,676 kB
  • ctags: 42,708
  • sloc: ansic: 374,827; ml: 40,236; sh: 19,721; java: 8,493; perl: 8,244; makefile: 5,740; cs: 5,602; haskell: 5,088; python: 2,591; erlang: 2,197; xml: 1,494; ruby: 271; pascal: 218; yacc: 123; lex: 110; cpp: 10
file content (219 lines) | stat: -rw-r--r-- 7,867 bytes parent folder | download
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
(* 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 Common_gettext.Gettext
open Common_utils

open Printf
open Unix

let quote = Filename.quote

type gpgkey_type =
  | No_Key
  | Fingerprint of string
  | KeyFile of string

type t = {
  verbose : bool;
  gpg : string;
  fingerprint : string;
  check_signature : bool;
  gpghome : string;
}

(* Import the specified key file. *)
let import_keyfile ~gpg ~gpghome ~verbose keyfile =
  let status_file = Filename.temp_file "vbstat" ".txt" in
  unlink_on_exit status_file;
  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
  if verbose then eprintf "%s\n%!" cmd;
  let r = Sys.command cmd in
  if r <> 0 then (
    eprintf (f_"virt-builder: error: could not import public key\nUse the '-v' option and look for earlier error messages.\n");
    exit 1
  );
  status_file

let rec create ~verbose ~gpg ~gpgkey ~check_signature =
  (* Create a temporary directory for gnupg. *)
  let tmpdir = Mkdtemp.temp_dir "vb.gpghome." "" in
  rmdir_on_exit tmpdir;
  (* 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 =
    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 tmpdir (if verbose then "" else " >/dev/null 2>&1") in
      if verbose then eprintf "%s\n%!" cmd;
      let r = Sys.command cmd in
      if r <> 0 then (
        eprintf (f_"virt-builder: error: GPG failure: could not run GPG the first time\nUse the '-v' option and look for earlier error messages.\n");
        exit 1
      );
      match gpgkey with
      | No_Key ->
        assert false
      | KeyFile kf ->
        let status_file = import_keyfile gpg tmpdir verbose kf in
        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:]" :: "IMPORT_OK" :: _ :: fp :: _ -> fingerprint := fp
            | _ -> ()
        ) status;
        !fingerprint
      | Fingerprint fp ->
        let filename = Filename.temp_file "vbpubkey" ".asc" in
        unlink_on_exit filename;
        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
        if verbose then eprintf "%s\n%!" cmd;
        let r = Sys.command cmd in
        if r <> 0 then (
          eprintf (f_"virt-builder: error: could not export public key\nUse the '-v' option and look for earlier error messages.\n");
          exit 1
        );
        ignore (import_keyfile gpg tmpdir verbose filename);
        fp
    ) else
      "" in
  {
    verbose = verbose;
    gpg = gpg;
    fingerprint = fingerprint;
    check_signature = check_signature;
    gpghome = 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 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 ->
      eprintf (f_"virt-builder: error: 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\nyou are susceptible to man-in-the-middle attacks.\n");
      exit 1
    | Some sigfile ->
      let args = sprintf "%s %s" (quote sigfile) (quote filename) in
      do_verify t args
  )

and do_verify t args =
  let status_file = Filename.temp_file "vbstat" ".txt" in
  unlink_on_exit status_file;
  let cmd =
    sprintf "%s --homedir %s --verify%s --status-file %s %s"
        t.gpg t.gpghome
        (if t.verbose then "" else " -q --logger-file /dev/null")
        (quote status_file) args in
  if t.verbose then eprintf "%s\n%!" cmd;
  let r = Sys.command cmd in
  if r <> 0 then (
    eprintf (f_"virt-builder: error: 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!\n");
    exit 1
  );

  (* 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) then (
    eprintf (f_"virt-builder: error: fingerprint of signature does not match the expected fingerprint!\n  found fingerprint: %s\n  expected fingerprint: %s\n")
      !fingerprint t.fingerprint;
    exit 1
  )

type csum_t = SHA512 of string

let verify_checksum t (SHA512 csum) filename =
  let csum_file = Filename.temp_file "vbcsum" ".txt" in
  unlink_on_exit csum_file;
  let cmd = sprintf "sha512sum %s | awk '{print $1}' > %s"
    (quote filename) (quote csum_file) in
  if t.verbose then eprintf "%s\n%!" cmd;
  let r = Sys.command cmd in
  if r <> 0 then (
    eprintf (f_"virt-builder: error: could not run sha512sum command to verify checksum\n");
    exit 1
  );

  let csum_actual = read_whole_file csum_file in

  let csum_actual =
    let len = String.length csum_actual in
    if len > 0 && csum_actual.[len-1] = '\n' then
      String.sub csum_actual 0 (len-1)
    else
      csum_actual in

  if csum <> csum_actual then (
    eprintf (f_"virt-builder: error: checksum of template did not match the expected checksum!\n  found checksum: %s\n  expected checksum: %s\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!\n")
      csum_actual csum;
    exit 1
  )