Commit | Line | Data |
---|---|---|
8b420f74 | 1 | ;;; GNU Guix --- Functional package management for GNU |
2535635f | 2 | ;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org> |
8b420f74 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 pki) | |
20 | #:use-module (guix config) | |
ca719424 | 21 | #:use-module (gcrypt pk-crypto) |
8b420f74 | 22 | #:use-module ((guix utils) #:select (with-atomic-file-output)) |
590e4154 | 23 | #:use-module ((guix build utils) #:select (mkdir-p)) |
8b420f74 | 24 | #:use-module (ice-9 match) |
2535635f LC |
25 | #:use-module (ice-9 rdelim) |
26 | #:use-module (ice-9 binary-ports) | |
8b420f74 | 27 | #:export (%public-key-file |
554f26ec | 28 | %private-key-file |
f82cc5fd | 29 | %acl-file |
8b420f74 LC |
30 | current-acl |
31 | public-keys->acl | |
32 | acl->public-keys | |
d28684b5 | 33 | authorized-key? |
ded1012f | 34 | write-acl |
d28684b5 | 35 | |
8b420f74 | 36 | signature-sexp |
d28684b5 LC |
37 | signature-subject |
38 | signature-signed-data | |
81deef27 LC |
39 | valid-signature? |
40 | signature-case)) | |
8b420f74 LC |
41 | |
42 | ;;; Commentary: | |
43 | ;;; | |
44 | ;;; Public key infrastructure for the authentication and authorization of | |
45 | ;;; archive imports. This is essentially a subset of SPKI for our own | |
46 | ;;; purposes (see <http://theworld.com/~cme/spki.txt> and | |
47 | ;;; <http://www.ietf.org/rfc/rfc2693.txt>.) | |
48 | ;;; | |
49 | ;;; Code: | |
50 | ||
8b420f74 | 51 | (define (public-keys->acl keys) |
39831f16 | 52 | "Return an ACL that lists all of KEYS with a '(guix import)' |
8b420f74 LC |
53 | tag---meaning that all of KEYS are authorized for archive imports. Each |
54 | element in KEYS must be a canonical sexp with type 'public-key'." | |
39831f16 LC |
55 | |
56 | ;; Use SPKI-style ACL entry sexp for PUBLIC-KEY, authorizing imports | |
57 | ;; signed by the corresponding secret key (see the IETF draft at | |
58 | ;; <http://theworld.com/~cme/spki.txt> for the ACL format.) | |
59 | ;; | |
60 | ;; Note: We always use PUBLIC-KEY to designate the subject. Someday we may | |
61 | ;; want to have name certificates and to use subject names instead of | |
62 | ;; complete keys. | |
63 | `(acl ,@(map (lambda (key) | |
64 | `(entry ,(canonical-sexp->sexp key) | |
65 | (tag (guix import)))) | |
66 | keys))) | |
8b420f74 LC |
67 | |
68 | (define %acl-file | |
69 | (string-append %config-directory "/acl")) | |
70 | ||
71 | (define %public-key-file | |
72 | (string-append %config-directory "/signing-key.pub")) | |
73 | ||
554f26ec LC |
74 | (define %private-key-file |
75 | (string-append %config-directory "/signing-key.sec")) | |
76 | ||
8b420f74 LC |
77 | (define (ensure-acl) |
78 | "Make sure the ACL file exists, and create an initialized one if needed." | |
79 | (unless (file-exists? %acl-file) | |
80 | ;; If there's no public key file, don't attempt to create the ACL. | |
81 | (when (file-exists? %public-key-file) | |
82 | (let ((public-key (call-with-input-file %public-key-file | |
83 | (compose string->canonical-sexp | |
2535635f | 84 | read-string)))) |
590e4154 | 85 | (mkdir-p (dirname %acl-file)) |
8b420f74 LC |
86 | (with-atomic-file-output %acl-file |
87 | (lambda (port) | |
ded1012f LC |
88 | (write-acl (public-keys->acl (list public-key)) |
89 | port))))))) | |
90 | ||
91 | (define (write-acl acl port) | |
92 | "Write ACL to PORT in canonical-sexp format." | |
93 | (let ((sexp (sexp->canonical-sexp acl))) | |
94 | (display (canonical-sexp->string sexp) port))) | |
8b420f74 LC |
95 | |
96 | (define (current-acl) | |
39831f16 | 97 | "Return the current ACL." |
8b420f74 LC |
98 | (ensure-acl) |
99 | (if (file-exists? %acl-file) | |
100 | (call-with-input-file %acl-file | |
39831f16 LC |
101 | (compose canonical-sexp->sexp |
102 | string->canonical-sexp | |
2535635f | 103 | read-string)) |
8b420f74 LC |
104 | (public-keys->acl '()))) ; the empty ACL |
105 | ||
106 | (define (acl->public-keys acl) | |
107 | "Return the public keys (as canonical sexps) listed in ACL with the '(guix | |
108 | import)' tag." | |
39831f16 | 109 | (match acl |
8b420f74 LC |
110 | (('acl |
111 | ('entry subject-keys | |
112 | ('tag ('guix 'import))) | |
113 | ...) | |
114 | (map sexp->canonical-sexp subject-keys)) | |
115 | (_ | |
116 | (error "invalid access-control list" acl)))) | |
117 | ||
39831f16 | 118 | (define* (authorized-key? key #:optional (acl (current-acl))) |
8b420f74 LC |
119 | "Return #t if KEY (a canonical sexp) is an authorized public key for archive |
120 | imports according to ACL." | |
39831f16 LC |
121 | ;; Note: ACL is kept in native sexp form to make 'authorized-key?' faster, |
122 | ;; by not having to convert it with 'canonical-sexp->sexp' on each call. | |
123 | ;; TODO: We could use a better data type for ACLs. | |
8b420f74 | 124 | (let ((key (canonical-sexp->sexp key))) |
39831f16 | 125 | (match acl |
8b420f74 LC |
126 | (('acl |
127 | ('entry subject-keys | |
128 | ('tag ('guix 'import))) | |
129 | ...) | |
130 | (not (not (member key subject-keys)))) | |
131 | (_ | |
132 | (error "invalid access-control list" acl))))) | |
133 | ||
134 | (define (signature-sexp data secret-key public-key) | |
135 | "Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that | |
136 | includes DATA, the actual signature value (with a 'sig-val' tag), and | |
137 | PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)" | |
138 | (string->canonical-sexp | |
139 | (format #f | |
140 | "(signature ~a ~a ~a)" | |
141 | (canonical-sexp->string data) | |
142 | (canonical-sexp->string (sign data secret-key)) | |
143 | (canonical-sexp->string public-key)))) | |
144 | ||
d28684b5 LC |
145 | (define (signature-subject sig) |
146 | "Return the signer's public key for SIG." | |
147 | (find-sexp-token sig 'public-key)) | |
148 | ||
149 | (define (signature-signed-data sig) | |
150 | "Return the signed data from SIG, typically an sexp such as | |
151 | (hash \"sha256\" #...#)." | |
152 | (find-sexp-token sig 'data)) | |
153 | ||
154 | (define (valid-signature? sig) | |
155 | "Return #t if SIG is valid." | |
156 | (let* ((data (signature-signed-data sig)) | |
157 | (signature (find-sexp-token sig 'sig-val)) | |
158 | (public-key (signature-subject sig))) | |
159 | (and data signature | |
160 | (verify signature data public-key)))) | |
161 | ||
81deef27 LC |
162 | (define* (%signature-status signature hash |
163 | #:optional (acl (current-acl))) | |
164 | "Return a symbol denoting the status of SIGNATURE vs. HASH vs. ACL. | |
165 | ||
166 | This procedure must only be used internally, because it would be easy to | |
167 | forget some of the cases." | |
168 | (let ((subject (signature-subject signature)) | |
169 | (data (signature-signed-data signature))) | |
170 | (if (and data subject) | |
171 | (if (authorized-key? subject acl) | |
172 | (if (equal? (hash-data->bytevector data) hash) | |
173 | (if (valid-signature? signature) | |
174 | 'valid-signature | |
175 | 'invalid-signature) | |
176 | 'hash-mismatch) | |
177 | 'unauthorized-key) | |
178 | 'corrupt-signature))) | |
179 | ||
180 | (define-syntax signature-case | |
181 | (syntax-rules (valid-signature invalid-signature | |
182 | hash-mismatch unauthorized-key corrupt-signature | |
183 | else) | |
184 | "\ | |
185 | Match the cases of the verification of SIGNATURE against HASH and ACL: | |
186 | ||
187 | - the 'valid-signature' case if SIGNATURE is indeed a signature of HASH with | |
188 | a key present in ACL; | |
189 | - 'invalid-signature' if SIGNATURE is incorrect; | |
190 | - 'hash-mismatch' if the hash in SIGNATURE does not match HASH; | |
191 | - 'unauthorized-key' if the public key in SIGNATURE is not listed in ACL; | |
192 | - 'corrupt-signature' if SIGNATURE is not a valid signature sexp. | |
193 | ||
194 | This macro guarantees at compile-time that all these cases are handled. | |
195 | ||
196 | SIGNATURE, and ACL must be canonical sexps; HASH must be a bytevector." | |
197 | ||
198 | ;; Simple case: we only care about valid signatures. | |
199 | ((_ (signature hash acl) | |
200 | (valid-signature valid-exp ...) | |
201 | (else else-exp ...)) | |
202 | (case (%signature-status signature hash acl) | |
203 | ((valid-signature) valid-exp ...) | |
204 | (else else-exp ...))) | |
205 | ||
206 | ;; Full case. | |
207 | ((_ (signature hash acl) | |
208 | (valid-signature valid-exp ...) | |
209 | (invalid-signature invalid-exp ...) | |
210 | (hash-mismatch mismatch-exp ...) | |
211 | (unauthorized-key unauthorized-exp ...) | |
212 | (corrupt-signature corrupt-exp ...)) | |
213 | (case (%signature-status signature hash acl) | |
214 | ((valid-signature) valid-exp ...) | |
215 | ((invalid-signature) invalid-exp ...) | |
216 | ((hash-mismatch) mismatch-exp ...) | |
217 | ((unauthorized-key) unauthorized-exp ...) | |
218 | ((corrupt-signature) corrupt-exp ...) | |
219 | (else (error "bogus signature status")))))) | |
220 | ||
8b420f74 | 221 | ;;; pki.scm ends here |