summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am2
-rw-r--r--guix/pki.scm132
-rw-r--r--tests/pki.scm51
3 files changed, 185 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index ba54f8c582..6d6aba059b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -31,6 +31,7 @@ MODULES = \
guix/records.scm \
guix/hash.scm \
guix/pk-crypto.scm \
+ guix/pki.scm \
guix/utils.scm \
guix/download.scm \
guix/monads.scm \
@@ -111,6 +112,7 @@ SCM_TESTS = \
tests/base32.scm \
tests/hash.scm \
tests/pk-crypto.scm \
+ tests/pki.scm \
tests/builders.scm \
tests/derivations.scm \
tests/ui.scm \
diff --git a/guix/pki.scm b/guix/pki.scm
new file mode 100644
index 0000000000..1ed84e55f0
--- /dev/null
+++ b/guix/pki.scm
@@ -0,0 +1,132 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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 (ice-9 match)
+ #:use-module (rnrs io ports)
+ #:export (%public-key-file
+ current-acl
+ public-keys->acl
+ acl->public-keys
+ signature-sexp
+ authorized-key?))
+
+;;; 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 (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)'
+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)))
+
+(define %acl-file
+ (string-append %config-directory "/acl"))
+
+(define %public-key-file
+ (string-append %config-directory "/signing-key.pub"))
+
+(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))))
+ (with-atomic-file-output %acl-file
+ (lambda (port)
+ (display (canonical-sexp->string
+ (public-keys->acl (list public-key)))
+ port)))))))
+
+(define (current-acl)
+ "Return the current ACL as a canonical sexp."
+ (ensure-acl)
+ (if (file-exists? %acl-file)
+ (call-with-input-file %acl-file
+ (compose 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)
+ (('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."
+ (let ((key (canonical-sexp->sexp key)))
+ (match (canonical-sexp->sexp 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))))
+
+;;; pki.scm ends here
diff --git a/tests/pki.scm b/tests/pki.scm
new file mode 100644
index 0000000000..04d5a5311b
--- /dev/null
+++ b/tests/pki.scm
@@ -0,0 +1,51 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 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 (test-pki)
+ #:use-module (guix pki)
+ #:use-module (guix pk-crypto)
+ #:use-module (rnrs io ports)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix pki) module.
+
+(define %public-key
+ (call-with-input-file %public-key-file
+ (compose string->canonical-sexp
+ get-string-all)))
+
+(test-begin "pki")
+
+(test-assert "current-acl"
+ (not (not (member (canonical-sexp->sexp %public-key)
+ (map canonical-sexp->sexp
+ (acl->public-keys (current-acl)))))))
+
+(test-assert "authorized-key? public-key current-acl"
+ (authorized-key? %public-key))
+
+(test-assert "authorized-key? public-key empty-acl"
+ (not (authorized-key? %public-key (public-keys->acl '()))))
+
+(test-assert "authorized-key? public-key singleton"
+ (authorized-key? %public-key (public-keys->acl (list %public-key))))
+
+(test-end)
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-10 07:03:59 +0000