guix/pki.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
   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)
  21   #:use-module (gcrypt 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 (ice-9 rdelim)
  26   #:use-module (ice-9 binary-ports)
  27   #:export (%public-key-file
  28             %private-key-file
  29             %acl-file
  30             current-acl
  31             public-keys->acl
  32             acl->public-keys
  33             authorized-key?
  34             write-acl
  35
  36             signature-sexp
  37             signature-subject
  38             signature-signed-data
  39             valid-signature?
  40             signature-case))
  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
  51 (define (public-keys->acl keys)
  52   "Return an ACL that lists all of KEYS with a '(guix import)'
  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'."
  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)))
  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
  74 (define %private-key-file
  75   (string-append %config-directory "/signing-key.sec"))
  76
  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
  84                                    read-string))))
  85         (mkdir-p (dirname %acl-file))
  86         (with-atomic-file-output %acl-file
  87           (lambda (port)
  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)))
  95
  96 (define (current-acl)
  97   "Return the current ACL."
  98   (ensure-acl)
  99   (if (file-exists? %acl-file)
 100       (call-with-input-file %acl-file
 101         (compose canonical-sexp->sexp
 102                  string->canonical-sexp
 103                  read-string))
 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."
 109   (match acl
 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
 118 (define* (authorized-key? key #:optional (acl (current-acl)))
 119   "Return #t if KEY (a canonical sexp) is an authorized public key for archive
 120 imports according to ACL."
 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.
 124   (let ((key (canonical-sexp->sexp key)))
 125     (match acl
 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
 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
 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
 221 ;;; pki.scm ends here