blob: a83f138949c686a98e9d28a82ac1c7fbe27d3b5d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
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)))))
|
