gnu: Properly credit Konrad Hinsen.

[jackhill/guix/guix.git] / guix / pki.scm

diff --git a/guix/pki.scm b/guix/pki.scm
index 609c03f..6326e06 100644 (file)
--- a/guix/pki.scm
+++ b/guix/pki.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,11 +18,12 @@
 
 (define-module (guix pki)
   #:use-module (guix config)
-  #:use-module (guix pk-crypto)
+  #:use-module (gcrypt 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)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 binary-ports)
   #:export (%public-key-file
             %private-key-file
             %acl-file
@@ -30,6 +31,7 @@
             public-keys->acl
             acl->public-keys
             authorized-key?
+            write-acl
 
             signature-sexp
             signature-subject
@@ -46,30 +48,22 @@
 ;;;
 ;;; Code:
 
-(define (acl-entry-sexp public-key)
-  "Return a 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.
-  (string->canonical-sexp
-   (format #f
-           "(entry ~a (tag (guix import)))"
-           (canonical-sexp->string public-key))))
-
-(define (acl-sexp entries)
-  "Return an ACL sexp from ENTRIES, a list of 'entry' sexps."
-  (string->canonical-sexp
-   (string-append "(acl "
-                  (string-join (map canonical-sexp->string entries))
-                  ")")))
-
 (define (public-keys->acl keys)
-  "Return an ACL canonical sexp that lists all of KEYS with a '(guix import)'
+  "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'."
-  (acl-sexp (map acl-entry-sexp keys)))
+
+  ;; 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"))
@@ -87,27 +81,32 @@ element in KEYS must be a canonical sexp with type 'public-key'."
     (when (file-exists? %public-key-file)
       (let ((public-key (call-with-input-file %public-key-file
                           (compose string->canonical-sexp
-                                   get-string-all))))
+                                   read-string))))
         (mkdir-p (dirname %acl-file))
         (with-atomic-file-output %acl-file
           (lambda (port)
-            (display (canonical-sexp->string
-                      (public-keys->acl (list public-key)))
-                     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 as a canonical sexp."
+  "Return the current ACL."
   (ensure-acl)
   (if (file-exists? %acl-file)
       (call-with-input-file %acl-file
-        (compose string->canonical-sexp
-                 get-string-all))
+        (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 (canonical-sexp->sexp acl)
+  (match acl
     (('acl
       ('entry subject-keys
               ('tag ('guix 'import)))
@@ -116,12 +115,14 @@ import)' tag."
     (_
      (error "invalid access-control list" acl))))
 
-(define* (authorized-key? key
-                          #:optional (acl (current-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 (canonical-sexp->sexp acl)
+    (match acl
       (('acl
         ('entry subject-keys
                 ('tag ('guix 'import)))