diff options
-rw-r--r-- | consfigurator.asd | 3 | ||||
-rw-r--r-- | doc/data.rst | 5 | ||||
-rw-r--r-- | src/data/gpgpubkeys.lisp | 82 | ||||
-rw-r--r-- | src/package.lisp | 3 |
4 files changed, 91 insertions, 2 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index 2508754..eb9d35c 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -40,4 +40,5 @@ (:file "src/connection/chroot/shell") (:file "src/data/asdf") (:file "src/data/pgp") - (:file "src/data/git-snapshot"))) + (:file "src/data/git-snapshot") + (:file "src/data/gpgpubkeys"))) diff --git a/doc/data.rst b/doc/data.rst index 1cdea9b..ce53fa5 100644 --- a/doc/data.rst +++ b/doc/data.rst @@ -31,7 +31,10 @@ other purposes. user ``USER`` on ``HOSTNAME`` - ``("--git-snapshot" . NAME)`` means the data is a snapshot of a git repo - identified by ``NAME``; see ``DATA.GIT-SNAPSHOT``. + identified by ``NAME``; see ``DATA.GIT-SNAPSHOT`` + +- ``("--pgp-pubkey" . FINGERPRINT)`` means the/a OpenPGP public key with + fingerprint FINGERPRINT. (Proposed convention: Except for the first item above, these reserved names should start with ``--`` and use ``--`` to separate parameter values within diff --git a/src/data/gpgpubkeys.lisp b/src/data/gpgpubkeys.lisp new file mode 100644 index 0000000..a83f138 --- /dev/null +++ b/src/data/gpgpubkeys.lisp @@ -0,0 +1,82 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2021 Sean Whitton <spwhitton@spwhitton.name> + +;;; This file 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, or (at your option) +;;; any later version. + +;;; This file 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 this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :consfigurator.data.gpgpubkeys) +(named-readtables:in-readtable :consfigurator) + +(defmethod register-data-source + ((type (eql :gpgpubkeys)) &key keyring try-recv-key) + "Obtain ASCII-armoured PGP public keys by querying local gpg keyring KEYRING. +If TRY-RECV-KEY, try to add any missing keys to KEYRING by querying keyservers +configured in dirmngr.conf." + (unless (file-exists-p keyring) + (missing-data-source "~A does not exist." keyring)) + (let (cache lastmod) + (labels ((reset-cache (&optional (new-lastmod (file-write-date keyring))) + (setq cache (make-hash-table :test #'equal) + lastmod new-lastmod)) + (retrieve (iden1 fingerprint) + (declare (ignore iden1)) + (let ((new-lastmod (file-write-date keyring))) + (when (> new-lastmod lastmod) + (reset-cache new-lastmod))) + (or (gethash fingerprint cache) + (multiple-value-bind (key queriedp) + (getkey keyring fingerprint try-recv-key) + (when queriedp (reset-cache)) + (and key + (setf (gethash fingerprint cache) + (make-instance 'string-data + :string key + :mime "application/pgp-keys" + :iden1 "--pgp-pubkey" + :iden2 fingerprint + :version lastmod)))))) + (check (iden1 iden2) + ;; We can't avoid running gpg(1) to find out whether a PGP key + ;; is available, so we might as well just do the extraction + ;; work when asked whether we can extract. + (and (string= iden1 "--pgp-pubkey") + (let ((retrieved (retrieve nil iden2))) + (and retrieved (data-version retrieved)))))) + (reset-cache) + (cons #'check #'retrieve)))) + +(defun local-getkey (keyring fingerprint) + (multiple-value-bind (output _ exit-code) + (run-program `("gpg" "--armor" "--no-default-keyring" + "--keyring" ,(namestring keyring) + "--export-options" "export-minimal" + "--export" ,fingerprint) + :output :string :ignore-error-status t) + (declare (ignore _)) + (let ((key (stripln output))) + (and (zerop exit-code) (not (string-equal "" key)) key)))) + +(defun getkey (keyring fingerprint try-recv-key) + (let ((local (local-getkey keyring fingerprint))) + (when (or local (not try-recv-key)) + (return-from getkey (values local nil))) + (let ((exit-code + (nth-value + 2 (run-program + `("gpg" "--no-default-keyring" + "--keyring" ,(namestring keyring) + "--recv-key" ,fingerprint) + :output :string :ignore-error-status t)))) + (when (zerop exit-code) + (values (local-getkey keyring fingerprint) t))))) diff --git a/src/package.lisp b/src/package.lisp index 23f0f90..298d776 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -307,3 +307,6 @@ (defpackage :consfigurator.data.git-snapshot (:use #:cl #:consfigurator #:alexandria)) + +(defpackage :consfigurator.data.gpgpubkeys + (:use #:cl #:consfigurator)) |