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
222
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix pki)
#:use-module (guix config)
#:use-module (gcrypt pk-crypto)
#:use-module ((guix utils) #:select (with-atomic-file-output))
#:use-module ((guix build utils) #:select (mkdir-p))
#:autoload (srfi srfi-1) (delete-duplicates)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:export (%public-key-file
%private-key-file
%acl-file
current-acl
public-keys->acl
acl->public-keys
authorized-key?
write-acl
signature-sexp
signature-subject
signature-signed-data
valid-signature?
signature-case))
;;; Commentary:
;;;
;;; Public key infrastructure for the authentication and authorization of
;;; archive imports. This is essentially a subset of SPKI for our own
;;; purposes (see <http://theworld.com/~cme/spki.txt> and
;;; <http://www.ietf.org/rfc/rfc2693.txt>.)
;;;
;;; Code:
(define (public-keys->acl keys)
"Return an ACL that lists all of KEYS with a '(guix import)'
tag---meaning that all of KEYS are authorized for archive imports. Each
element in KEYS must be a canonical sexp with type 'public-key'."
;; Use SPKI-style ACL entry sexp for PUBLIC-KEY, authorizing imports
;; signed by the corresponding secret key (see the IETF draft at
;; <http://theworld.com/~cme/spki.txt> for the ACL format.)
;;
;; Note: We always use PUBLIC-KEY to designate the subject. Someday we may
;; want to have name certificates and to use subject names instead of
;; complete keys.
`(acl ,@(map (lambda (key)
`(entry ,key
(tag (guix import))))
(delete-duplicates
(map canonical-sexp->sexp keys)))))
(define %acl-file
(string-append %config-directory "/acl"))
(define %public-key-file
(string-append %config-directory "/signing-key.pub"))
(define %private-key-file
(string-append %config-directory "/signing-key.sec"))
(define (ensure-acl)
"Make sure the ACL file exists, and create an initialized one if needed."
(unless (file-exists? %acl-file)
;; If there's no public key file, don't attempt to create the ACL.
(when (file-exists? %public-key-file)
(let ((public-key (call-with-input-file %public-key-file
(compose string->canonical-sexp
read-string))))
(mkdir-p (dirname %acl-file))
(with-atomic-file-output %acl-file
(lambda (port)
(write-acl (public-keys->acl (list public-key))
port)))))))
(define (write-acl acl port)
"Write ACL to PORT in canonical-sexp format."
(let ((sexp (sexp->canonical-sexp acl)))
(display (canonical-sexp->string sexp) port)))
(define (current-acl)
"Return the current ACL."
(ensure-acl)
(if (file-exists? %acl-file)
(call-with-input-file %acl-file
(compose canonical-sexp->sexp
string->canonical-sexp
read-string))
(public-keys->acl '()))) ; the empty ACL
(define (acl->public-keys acl)
"Return the public keys (as canonical sexps) listed in ACL with the '(guix
import)' tag."
(match acl
(('acl
('entry subject-keys
('tag ('guix 'import)))
...)
(map sexp->canonical-sexp subject-keys))
(_
(error "invalid access-control list" acl))))
(define* (authorized-key? key #:optional (acl (current-acl)))
"Return #t if KEY (a canonical sexp) is an authorized public key for archive
imports according to ACL."
;; Note: ACL is kept in native sexp form to make 'authorized-key?' faster,
;; by not having to convert it with 'canonical-sexp->sexp' on each call.
;; TODO: We could use a better data type for ACLs.
(let ((key (canonical-sexp->sexp key)))
(match acl
(('acl
('entry subject-keys
('tag ('guix 'import)))
...)
(not (not (member key subject-keys))))
(_
(error "invalid access-control list" acl)))))
(define (signature-sexp data secret-key public-key)
"Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that
includes DATA, the actual signature value (with a 'sig-val' tag), and
PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)"
(string->canonical-sexp
(format #f
"(signature ~a ~a ~a)"
(canonical-sexp->string data)
(canonical-sexp->string (sign data secret-key))
(canonical-sexp->string public-key))))
(define (signature-subject sig)
"Return the signer's public key for SIG."
(find-sexp-token sig 'public-key))
(define (signature-signed-data sig)
"Return the signed data from SIG, typically an sexp such as
(hash \"sha256\" #...#)."
(find-sexp-token sig 'data))
(define (valid-signature? sig)
"Return #t if SIG is valid."
(let* ((data (signature-signed-data sig))
(signature (find-sexp-token sig 'sig-val))
(public-key (signature-subject sig)))
(and data signature
(verify signature data public-key))))
(define* (%signature-status signature hash
#:optional (acl (current-acl)))
"Return a symbol denoting the status of SIGNATURE vs. HASH vs. ACL.
This procedure must only be used internally, because it would be easy to
forget some of the cases."
(let ((subject (signature-subject signature))
(data (signature-signed-data signature)))
(if (and data subject)
(if (authorized-key? subject acl)
(if (equal? (hash-data->bytevector data) hash)
(if (valid-signature? signature)
'valid-signature
'invalid-signature)
'hash-mismatch)
'unauthorized-key)
'corrupt-signature)))
(define-syntax signature-case
(syntax-rules (valid-signature invalid-signature
hash-mismatch unauthorized-key corrupt-signature
else)
"\
Match the cases of the verification of SIGNATURE against HASH and ACL:
- the 'valid-signature' case if SIGNATURE is indeed a signature of HASH with
a key present in ACL;
- 'invalid-signature' if SIGNATURE is incorrect;
- 'hash-mismatch' if the hash in SIGNATURE does not match HASH;
- 'unauthorized-key' if the public key in SIGNATURE is not listed in ACL;
- 'corrupt-signature' if SIGNATURE is not a valid signature sexp.
This macro guarantees at compile-time that all these cases are handled.
SIGNATURE, and ACL must be canonical sexps; HASH must be a bytevector."
;; Simple case: we only care about valid signatures.
((_ (signature hash acl)
(valid-signature valid-exp ...)
(else else-exp ...))
(case (%signature-status signature hash acl)
((valid-signature) valid-exp ...)
(else else-exp ...)))
;; Full case.
((_ (signature hash acl)
(valid-signature valid-exp ...)
(invalid-signature invalid-exp ...)
(hash-mismatch mismatch-exp ...)
(unauthorized-key unauthorized-exp ...)
(corrupt-signature corrupt-exp ...))
(case (%signature-status signature hash acl)
((valid-signature) valid-exp ...)
((invalid-signature) invalid-exp ...)
((hash-mismatch) mismatch-exp ...)
((unauthorized-key) unauthorized-exp ...)
((corrupt-signature) corrupt-exp ...)
(else (error "bogus signature status"))))))
;;; pki.scm ends here
|
