blob: cff64ac4c0b56fb3c34137d175695da446f6cfc3 (
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
;;; 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.pgp)
;; Simple PGP-encrypted file source of prerequisite data
;; We provide an implementation of REGISTER-DATA-SOURCE and functions for the
;; user to call at the REPL to add pieces of data, see what's there, etc. (a
;; prerequisite data source which was some sort of external file-generating or
;; secrets storage database might not provide any functions for the REPL).
;;
;; You will need to touch(1) the file you wish to use before trying to
;; register it.
(defmethod register-data-source ((type (eql :pgp)) &key location)
(unless (file-exists-p location)
(error 'missing-data-source
:text (format nil "Could not open ~A" location)))
(let ((mod (file-write-date location))
(cache (read-store location)))
(labels ((update-cache ()
(when-let ((new-mod (> (file-write-date location) mod)))
(setq mod new-mod
cache (read-store location))))
(check (iden1 iden2)
(update-cache)
(cadr (data-assoc iden1 iden2 cache)))
(extract (iden1 iden2)
(update-cache)
(cddr (data-assoc iden1 iden2 cache))))
(cons #'check #'extract))))
(defun read-store (location)
(handler-case
(read-from-string
(run-program
(escape-sh-command (list "gpg" "--decrypt" (unix-namestring location)))
:output :string))
(subprocess-error (error)
(error 'missing-data-source
:text (format nil "While attempt to decrypt, gpg exited with ~A"
(uiop:subprocess-error-code error))))))
(defun put-store (location data)
(run-program (list "gpg" "--encrypt")
:input (make-string-input-stream (prin1-to-string data))
:output (unix-namestring location)))
(defun data-assoc (iden1 iden2 data)
(assoc (cons iden1 iden2) data
:test (lambda (x y)
(and (string= (car x) (car y))
(string= (cdr x) (cdr y))))))
(defun get-data (location iden1 iden2)
"Fetch a piece of prerequisite data.
Useful at the REPL."
(cddr (data-assoc iden1 iden2 (read-store location))))
(defun set-data (location iden1 iden2 val)
"Set a piece of prerequisite data.
Useful at the REPL."
(let ((data (delete-if
(lambda (d)
(and (string= (caar d) iden1) (string= (cdar d) iden2)))
(and (file-exists-p location) (read-store location)))))
(push (cons (cons iden1 iden2) (cons (get-universal-time) val)) data)
(put-store location data)))
(defun set-data-from-file (location iden1 iden2 file)
"Set a piece of prerequisite data from the contents of a file.
Useful at the REPL."
(set-data location iden1 iden2 (read-file-string file)))
(defun list-data (location)
"List all prerequisite data in the PGP store at LOCATION.
Useful at the REPL."
(dolist (item (read-store location))
(format t "~A ~A~%" (caar item) (cdar item))))
|
