1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (guix pki)
20 #:use-module (guix config)
21 #:use-module (guix pk-crypto)
22 #:use-module ((guix utils) #:select (with-atomic-file-output))
23 #:use-module ((guix build utils) #:select (mkdir-p))
24 #:use-module (ice-9 match)
25 #:use-module (rnrs io ports)
26 #:export (%public-key-file
42 ;;; Public key infrastructure for the authentication and authorization of
43 ;;; archive imports. This is essentially a subset of SPKI for our own
44 ;;; purposes (see <http://theworld.com/~cme/spki.txt> and
45 ;;; <http://www.ietf.org/rfc/rfc2693.txt>.)
49 (define (acl-entry-sexp public-key)
50 "Return a SPKI-style ACL entry sexp for PUBLIC-KEY, authorizing imports
51 signed by the corresponding secret key (see the IETF draft at
52 <http://theworld.com/~cme/spki.txt> for the ACL format.)"
53 ;; Note: We always use PUBLIC-KEY to designate the subject. Someday we may
54 ;; want to have name certificates and to use subject names instead of
56 (string->canonical-sexp
58 "(entry ~a (tag (guix import)))"
59 (canonical-sexp->string public-key))))
61 (define (acl-sexp entries)
62 "Return an ACL sexp from ENTRIES, a list of 'entry' sexps."
63 (string->canonical-sexp
64 (string-append "(acl "
65 (string-join (map canonical-sexp->string entries))
68 (define (public-keys->acl keys)
69 "Return an ACL canonical sexp that lists all of KEYS with a '(guix import)'
70 tag---meaning that all of KEYS are authorized for archive imports. Each
71 element in KEYS must be a canonical sexp with type 'public-key'."
72 (acl-sexp (map acl-entry-sexp keys)))
75 (string-append %config-directory "/acl"))
77 (define %public-key-file
78 (string-append %config-directory "/signing-key.pub"))
80 (define %private-key-file
81 (string-append %config-directory "/signing-key.sec"))
84 "Make sure the ACL file exists, and create an initialized one if needed."
85 (unless (file-exists? %acl-file)
86 ;; If there's no public key file, don't attempt to create the ACL.
87 (when (file-exists? %public-key-file)
88 (let ((public-key (call-with-input-file %public-key-file
89 (compose string->canonical-sexp
91 (mkdir-p (dirname %acl-file))
92 (with-atomic-file-output %acl-file
94 (display (canonical-sexp->string
95 (public-keys->acl (list public-key)))
99 "Return the current ACL as a canonical sexp."
101 (if (file-exists? %acl-file)
102 (call-with-input-file %acl-file
103 (compose string->canonical-sexp
105 (public-keys->acl '()))) ; the empty ACL
107 (define (acl->public-keys acl)
108 "Return the public keys (as canonical sexps) listed in ACL with the '(guix
110 (match (canonical-sexp->sexp acl)
113 ('tag ('guix 'import)))
115 (map sexp->canonical-sexp subject-keys))
117 (error "invalid access-control list" acl))))
119 (define* (authorized-key? key
120 #:optional (acl (current-acl)))
121 "Return #t if KEY (a canonical sexp) is an authorized public key for archive
122 imports according to ACL."
123 (let ((key (canonical-sexp->sexp key)))
124 (match (canonical-sexp->sexp acl)
127 ('tag ('guix 'import)))
129 (not (not (member key subject-keys))))
131 (error "invalid access-control list" acl)))))
133 (define (signature-sexp data secret-key public-key)
134 "Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that
135 includes DATA, the actual signature value (with a 'sig-val' tag), and
136 PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)"
137 (string->canonical-sexp
139 "(signature ~a ~a ~a)"
140 (canonical-sexp->string data)
141 (canonical-sexp->string (sign data secret-key))
142 (canonical-sexp->string public-key))))
144 (define (signature-subject sig)
145 "Return the signer's public key for SIG."
146 (find-sexp-token sig 'public-key))
148 (define (signature-signed-data sig)
149 "Return the signed data from SIG, typically an sexp such as
150 (hash \"sha256\" #...#)."
151 (find-sexp-token sig 'data))
153 (define (valid-signature? sig)
154 "Return #t if SIG is valid."
155 (let* ((data (signature-signed-data sig))
156 (signature (find-sexp-token sig 'sig-val))
157 (public-key (signature-subject sig)))
159 (verify signature data public-key))))
161 (define* (%signature-status signature hash
162 #:optional (acl (current-acl)))
163 "Return a symbol denoting the status of SIGNATURE vs. HASH vs. ACL.
165 This procedure must only be used internally, because it would be easy to
166 forget some of the cases."
167 (let ((subject (signature-subject signature))
168 (data (signature-signed-data signature)))
169 (if (and data subject)
170 (if (authorized-key? subject acl)
171 (if (equal? (hash-data->bytevector data) hash)
172 (if (valid-signature? signature)
177 'corrupt-signature)))
179 (define-syntax signature-case
180 (syntax-rules (valid-signature invalid-signature
181 hash-mismatch unauthorized-key corrupt-signature
184 Match the cases of the verification of SIGNATURE against HASH and ACL:
186 - the 'valid-signature' case if SIGNATURE is indeed a signature of HASH with
187 a key present in ACL;
188 - 'invalid-signature' if SIGNATURE is incorrect;
189 - 'hash-mismatch' if the hash in SIGNATURE does not match HASH;
190 - 'unauthorized-key' if the public key in SIGNATURE is not listed in ACL;
191 - 'corrupt-signature' if SIGNATURE is not a valid signature sexp.
193 This macro guarantees at compile-time that all these cases are handled.
195 SIGNATURE, and ACL must be canonical sexps; HASH must be a bytevector."
197 ;; Simple case: we only care about valid signatures.
198 ((_ (signature hash acl)
199 (valid-signature valid-exp ...)
201 (case (%signature-status signature hash acl)
202 ((valid-signature) valid-exp ...)
203 (else else-exp ...)))
206 ((_ (signature hash acl)
207 (valid-signature valid-exp ...)
208 (invalid-signature invalid-exp ...)
209 (hash-mismatch mismatch-exp ...)
210 (unauthorized-key unauthorized-exp ...)
211 (corrupt-signature corrupt-exp ...))
212 (case (%signature-status signature hash acl)
213 ((valid-signature) valid-exp ...)
214 ((invalid-signature) invalid-exp ...)
215 ((hash-mismatch) mismatch-exp ...)
216 ((unauthorized-key) unauthorized-exp ...)
217 ((corrupt-signature) corrupt-exp ...)
218 (else (error "bogus signature status"))))))
220 ;;; pki.scm ends here