mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-15 19:35:25 -05:00
ded1012f3c
* guix/pki.scm (write-acl): New procedure.
(ensure-acl): Use it. Fixes a regression introduced in 39831f1,
whereby 'ensure-acl' would yield a wrong-type-arg error.
* guix/scripts/archive.scm (authorize-key): Use 'write-acl'.
220 lines
8 KiB
Scheme
220 lines
8 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2013, 2014 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 (guix pk-crypto)
|
|
#:use-module ((guix utils) #:select (with-atomic-file-output))
|
|
#:use-module ((guix build utils) #:select (mkdir-p))
|
|
#:use-module (ice-9 match)
|
|
#:use-module (rnrs io ports)
|
|
#: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 ,(canonical-sexp->sexp key)
|
|
(tag (guix import))))
|
|
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
|
|
get-string-all))))
|
|
(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
|
|
get-string-all))
|
|
(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
|