diff --git a/guix/pki.scm b/guix/pki.scm index 609c03f8d8..6f5e95b0ab 100644 --- a/guix/pki.scm +++ b/guix/pki.scm @@ -46,30 +46,22 @@ (define-module (guix pki) ;;; ;;; 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 - for the ACL format.)" +(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 + ;; 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)' -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))) + `(acl ,@(map (lambda (key) + `(entry ,(canonical-sexp->sexp key) + (tag (guix import)))) + keys))) (define %acl-file (string-append %config-directory "/acl")) @@ -96,18 +88,19 @@ (define (ensure-acl) 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 + (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 (canonical-sexp->sexp acl) + (match acl (('acl ('entry subject-keys ('tag ('guix 'import))) @@ -116,12 +109,14 @@ (define (acl->public-keys acl) (_ (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))) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 0f9e4d8360..90dc844281 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -289,7 +289,8 @@ (define (read-key) (mkdir-p (dirname %acl-file)) (with-atomic-file-output %acl-file (lambda (port) - (display (canonical-sexp->string acl) port)))))) + (display (canonical-sexp->string (sexp->canonical-sexp acl)) + port)))))) (define (guix-archive . args) (define (parse-options)