Commit | Line | Data |
---|---|---|
526382ff | 1 | ;;; GNU Guix --- Functional package management for GNU |
4c0c4db0 | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> |
526382ff LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix scripts authenticate) | |
20 | #:use-module (guix config) | |
4c0c4db0 | 21 | #:use-module (guix base16) |
ca719424 | 22 | #:use-module (gcrypt pk-crypto) |
96e5085c | 23 | #:use-module (guix pki) |
526382ff | 24 | #:use-module (guix ui) |
2535635f LC |
25 | #:use-module (ice-9 binary-ports) |
26 | #:use-module (ice-9 rdelim) | |
526382ff LC |
27 | #:use-module (ice-9 match) |
28 | #:export (guix-authenticate)) | |
29 | ||
30 | ;;; Commentary: | |
31 | ;;; | |
32 | ;;; This program is used internally by the daemon to sign exported archive | |
33 | ;;; (the 'export-paths' RPC), and to authenticate imported archives (the | |
34 | ;;; 'import-paths' RPC.) | |
35 | ;;; | |
36 | ;;; Code: | |
37 | ||
9dbe6e43 LC |
38 | (define read-canonical-sexp |
39 | ;; Read a gcrypt sexp from a port and return it. | |
2535635f | 40 | (compose string->canonical-sexp read-string)) |
526382ff | 41 | |
9dbe6e43 LC |
42 | (define (read-hash-data port key-type) |
43 | "Read sha256 hash data from PORT and return it as a gcrypt sexp. KEY-TYPE | |
32a1eb80 | 44 | is a symbol representing the type of public key algo being used." |
2535635f | 45 | (let* ((hex (read-string port)) |
526382ff | 46 | (bv (base16-string->bytevector (string-trim-both hex)))) |
32a1eb80 | 47 | (bytevector->hash-data bv #:key-type key-type))) |
526382ff | 48 | |
9dbe6e43 LC |
49 | (define (sign-with-key key-file port) |
50 | "Sign the hash read from PORT with KEY-FILE, and write an sexp that includes | |
51 | both the hash and the actual signature." | |
52 | (let* ((secret-key (call-with-input-file key-file read-canonical-sexp)) | |
53 | (public-key (if (string-suffix? ".sec" key-file) | |
54 | (call-with-input-file | |
55 | (string-append (string-drop-right key-file 4) | |
56 | ".pub") | |
57 | read-canonical-sexp) | |
58 | (leave | |
69daee23 | 59 | (G_ "cannot find public key for secret key '~a'~%") |
9dbe6e43 LC |
60 | key-file))) |
61 | (data (read-hash-data port (key-type public-key))) | |
62 | (signature (signature-sexp data secret-key public-key))) | |
63 | (display (canonical-sexp->string signature)) | |
64 | #t)) | |
65 | ||
66 | (define (validate-signature port) | |
67 | "Read the signature from PORT (which is as produced above), check whether | |
68 | its public key is authorized, verify the signature, and print the signed data | |
69 | to stdout upon success." | |
70 | (let* ((signature (read-canonical-sexp port)) | |
71 | (subject (signature-subject signature)) | |
72 | (data (signature-signed-data signature))) | |
73 | (if (and data subject) | |
74 | (if (authorized-key? subject) | |
75 | (if (valid-signature? signature) | |
76 | (let ((hash (hash-data->bytevector data))) | |
77 | (display (bytevector->base16-string hash)) | |
78 | #t) ; success | |
69daee23 | 79 | (leave (G_ "error: invalid signature: ~a~%") |
9dbe6e43 | 80 | (canonical-sexp->string signature))) |
69daee23 | 81 | (leave (G_ "error: unauthorized public key: ~a~%") |
9dbe6e43 | 82 | (canonical-sexp->string subject))) |
69daee23 | 83 | (leave (G_ "error: corrupt signature data: ~a~%") |
9dbe6e43 | 84 | (canonical-sexp->string signature))))) |
4cca9183 | 85 | |
526382ff LC |
86 | \f |
87 | ;;; | |
88 | ;;; Entry point with 'openssl'-compatible interface. We support this | |
89 | ;;; interface because that's what the daemon expects, and we want to leave it | |
90 | ;;; unmodified currently. | |
91 | ;;; | |
92 | ||
93 | (define (guix-authenticate . args) | |
6f695885 LC |
94 | ;; Signature sexps written to stdout may contain binary data, so force |
95 | ;; ISO-8859-1 encoding so that things are not mangled. See | |
96 | ;; <http://bugs.gnu.org/17312> for details. | |
97 | (set-port-encoding! (current-output-port) "ISO-8859-1") | |
98 | (set-port-conversion-strategy! (current-output-port) 'error) | |
99 | ||
100 | ;; Same goes for input ports. | |
101 | (with-fluids ((%default-port-encoding "ISO-8859-1") | |
102 | (%default-port-conversion-strategy 'error)) | |
103 | (match args | |
104 | ;; As invoked by guix-daemon. | |
105 | (("rsautl" "-sign" "-inkey" key "-in" hash-file) | |
106 | (call-with-input-file hash-file | |
107 | (lambda (port) | |
108 | (sign-with-key key port)))) | |
109 | ;; As invoked by Nix/Crypto.pm (used by Hydra.) | |
110 | (("rsautl" "-sign" "-inkey" key) | |
111 | (sign-with-key key (current-input-port))) | |
112 | ;; As invoked by guix-daemon. | |
113 | (("rsautl" "-verify" "-inkey" _ "-pubin" "-in" signature-file) | |
114 | (call-with-input-file signature-file | |
115 | (lambda (port) | |
116 | (validate-signature port)))) | |
117 | ;; As invoked by Nix/Crypto.pm (used by Hydra.) | |
118 | (("rsautl" "-verify" "-inkey" _ "-pubin") | |
119 | (validate-signature (current-input-port))) | |
120 | (("--help") | |
69daee23 | 121 | (display (G_ "Usage: guix authenticate OPTION... |
526382ff LC |
122 | Sign or verify the signature on the given file. This tool is meant to |
123 | be used internally by 'guix-daemon'.\n"))) | |
6f695885 LC |
124 | (("--version") |
125 | (show-version-and-exit "guix authenticate")) | |
126 | (else | |
69daee23 | 127 | (leave (G_ "wrong arguments")))))) |
526382ff LC |
128 | |
129 | ;;; authenticate.scm ends here |