guix/pki.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 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 (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
  27             %private-key-file
  28             %acl-file
  29             current-acl
  30             public-keys->acl
  31             acl->public-keys
  32             authorized-key?
  33
  34             signature-sexp
  35             signature-subject
  36             signature-signed-data
  37             valid-signature?))
  38
  39 ;;; Commentary:
  40 ;;;
  41 ;;; Public key infrastructure for the authentication and authorization of
  42 ;;; archive imports.  This is essentially a subset of SPKI for our own
  43 ;;; purposes (see <http://theworld.com/~cme/spki.txt> and
  44 ;;; <http://www.ietf.org/rfc/rfc2693.txt>.)
  45 ;;;
  46 ;;; Code:
  47
  48 (define (acl-entry-sexp public-key)
  49   "Return a SPKI-style ACL entry sexp for PUBLIC-KEY, authorizing imports
  50 signed by the corresponding secret key (see the IETF draft at
  51 <http://theworld.com/~cme/spki.txt> for the ACL format.)"
  52   ;; Note: We always use PUBLIC-KEY to designate the subject.  Someday we may
  53   ;; want to have name certificates and to use subject names instead of
  54   ;; complete keys.
  55   (string->canonical-sexp
  56    (format #f
  57            "(entry ~a (tag (guix import)))"
  58            (canonical-sexp->string public-key))))
  59
  60 (define (acl-sexp entries)
  61   "Return an ACL sexp from ENTRIES, a list of 'entry' sexps."
  62   (string->canonical-sexp
  63    (string-append "(acl "
  64                   (string-join (map canonical-sexp->string entries))
  65                   ")")))
  66
  67 (define (public-keys->acl keys)
  68   "Return an ACL canonical sexp that lists all of KEYS with a '(guix import)'
  69 tag---meaning that all of KEYS are authorized for archive imports.  Each
  70 element in KEYS must be a canonical sexp with type 'public-key'."
  71   (acl-sexp (map acl-entry-sexp keys)))
  72
  73 (define %acl-file
  74   (string-append %config-directory "/acl"))
  75
  76 (define %public-key-file
  77   (string-append %config-directory "/signing-key.pub"))
  78
  79 (define %private-key-file
  80   (string-append %config-directory "/signing-key.sec"))
  81
  82 (define (ensure-acl)
  83   "Make sure the ACL file exists, and create an initialized one if needed."
  84   (unless (file-exists? %acl-file)
  85     ;; If there's no public key file, don't attempt to create the ACL.
  86     (when (file-exists? %public-key-file)
  87       (let ((public-key (call-with-input-file %public-key-file
  88                           (compose string->canonical-sexp
  89                                    get-string-all))))
  90         (mkdir-p (dirname %acl-file))
  91         (with-atomic-file-output %acl-file
  92           (lambda (port)
  93             (display (canonical-sexp->string
  94                       (public-keys->acl (list public-key)))
  95                      port)))))))
  96
  97 (define (current-acl)
  98   "Return the current ACL as a canonical sexp."
  99   (ensure-acl)
 100   (if (file-exists? %acl-file)
 101       (call-with-input-file %acl-file
 102         (compose string->canonical-sexp
 103                  get-string-all))
 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 (canonical-sexp->sexp 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
 119                           #:optional (acl (current-acl)))
 120   "Return #t if KEY (a canonical sexp) is an authorized public key for archive
 121 imports according to ACL."
 122   (let ((key (canonical-sexp->sexp key)))
 123     (match (canonical-sexp->sexp acl)
 124       (('acl
 125         ('entry subject-keys
 126                 ('tag ('guix 'import)))
 127         ...)
 128        (not (not (member key subject-keys))))
 129       (_
 130        (error "invalid access-control list" acl)))))
 131
 132 (define (signature-sexp data secret-key public-key)
 133   "Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that
 134 includes DATA, the actual signature value (with a 'sig-val' tag), and
 135 PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)"
 136   (string->canonical-sexp
 137    (format #f
 138            "(signature ~a ~a ~a)"
 139            (canonical-sexp->string data)
 140            (canonical-sexp->string (sign data secret-key))
 141            (canonical-sexp->string public-key))))
 142
 143 (define (signature-subject sig)
 144   "Return the signer's public key for SIG."
 145   (find-sexp-token sig 'public-key))
 146
 147 (define (signature-signed-data sig)
 148   "Return the signed data from SIG, typically an sexp such as
 149   (hash \"sha256\" #...#)."
 150   (find-sexp-token sig 'data))
 151
 152 (define (valid-signature? sig)
 153   "Return #t if SIG is valid."
 154   (let* ((data       (signature-signed-data sig))
 155          (signature  (find-sexp-token sig 'sig-val))
 156          (public-key (signature-subject sig)))
 157     (and data signature
 158          (verify signature data public-key))))
 159
 160 ;;; pki.scm ends here