ambrevar: Add gpg.lisp.
parent
b65a679a35
commit
fa1a233ffc
|
@ -0,0 +1,103 @@
|
|||
(uiop:define-package ambrevar/gpg
|
||||
(:documentation "GPG utilities like writing .gpg files.")
|
||||
(:use #:common-lisp)
|
||||
(:use #:trivia)
|
||||
(:import-from #:log4cl)
|
||||
(:import-from #:serapeum #:export-always))
|
||||
(in-package ambrevar/gpg)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
|
||||
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
|
||||
|
||||
;; Borrowed from Nyxt.
|
||||
;; TODO: Extract to public library?
|
||||
|
||||
(defvar *gpg-program* "gpg")
|
||||
|
||||
(export-always '*gpg-default-recipient*)
|
||||
(defvar *gpg-default-recipient* "mail@ambrevar.xyz")
|
||||
|
||||
(defun gpg-recipient (file) ; TODO: Find a proper way to do this.
|
||||
"Return the key of FILE's recipient if any, `*gpg-recipient*' otherwise.
|
||||
As second value the email.
|
||||
As third value the name."
|
||||
(if (uiop:file-exists-p file)
|
||||
(let* ((output (sera:lines (with-output-to-string (s)
|
||||
(uiop:run-program (list *gpg-program* "--decrypt" file)
|
||||
:output nil :error-output s))))
|
||||
(first-line-tokens (str:split " " (first output)))
|
||||
(key (let ((key-string (second (member "ID" first-line-tokens :test #'string=))))
|
||||
(if (str:ends-with? "," key-string)
|
||||
(subseq key-string 0 (1- (length key-string)))
|
||||
key-string)))
|
||||
(second-line (str:trim (second output)))
|
||||
(mail-start (position #\space second-line :from-end t))
|
||||
(mail (str:trim (reduce (lambda (target rep) (str:replace-all rep "" target))
|
||||
'(">" "<" "\"") :initial-value (subseq second-line mail-start))))
|
||||
(name (str:replace-all "\"" "" (subseq second-line 0 mail-start))))
|
||||
(values key mail name))
|
||||
*gpg-default-recipient*))
|
||||
|
||||
(defun gpg-write (stream gpg-file recipient)
|
||||
"Write STREAM to GPG-FILE using RECIPIENT key."
|
||||
(if recipient
|
||||
;; TODO: Handle GPG errors.
|
||||
(uiop:run-program
|
||||
(list *gpg-program* "--output" gpg-file "--recipient" recipient
|
||||
"--batch" "--yes" "--encrypt")
|
||||
:input stream)
|
||||
(log:warn "Set `*gpg-default-recipient*' to save ~s." gpg-file)))
|
||||
|
||||
(export-always 'with-gpg-file)
|
||||
(defmacro with-gpg-file ((stream gpg-file &rest options) &body body)
|
||||
"Like `with-open-file' but use
|
||||
OPTIONS are as for `open''s `:direction'.
|
||||
Other options are not supported. File is overwritten if it exists, while
|
||||
nothing is done if file is missing."
|
||||
;; TODO: Support all of `open' options.
|
||||
(alex:with-gensyms (in clear-data result recipient)
|
||||
(if (member (getf options :direction) '(:io :input nil))
|
||||
`(when (uiop:file-exists-p ,gpg-file)
|
||||
(let ((,clear-data (with-output-to-string (out)
|
||||
(uiop:run-program
|
||||
(list *gpg-program* "--decrypt" ,gpg-file)
|
||||
:output out))))
|
||||
(with-input-from-string (,stream ,clear-data)
|
||||
(prog1 ; TODO: Shouldn't we `unwind-protect' instead?
|
||||
(progn
|
||||
,@body)
|
||||
,(when (eq (getf options :direction) :io)
|
||||
;; TODO: Need to handle error when gpg-file key is not available.
|
||||
`(gpg-write ,stream ,gpg-file (gpg-recipient ,gpg-file)))))))
|
||||
`(let ((,result nil)
|
||||
(,recipient (gpg-recipient ,gpg-file)))
|
||||
(if ,recipient
|
||||
(with-input-from-string (,in (with-output-to-string (,stream)
|
||||
(setf ,result (progn ,@body))))
|
||||
(gpg-write ,in ,gpg-file ,recipient))
|
||||
(error "No recipient."))
|
||||
,result))))
|
||||
|
||||
(defun ensure-parent-exists (path)
|
||||
"Create parent directories of PATH if they don't exist and return PATH."
|
||||
(ensure-directories-exist (directory-namestring path))
|
||||
path)
|
||||
|
||||
(export-always 'with-maybe-gpg-file)
|
||||
(defmacro with-maybe-gpg-file ((stream filespec &rest options) &body body)
|
||||
"Evaluate BODY with STREAM bound to DATA-PATH.
|
||||
DATA-PATH can be a GPG-encrypted file if it ends with a .gpg extension.
|
||||
If DATA-PATH expands to NIL or the empty string, do nothing.
|
||||
OPTIONS are as for `open'.
|
||||
Parent directories are created if necessary."
|
||||
`(if (str:ends-with? ".gpg" ,filespec :ignore-case t)
|
||||
(with-gpg-file (,stream ,filespec ,@options)
|
||||
,@body)
|
||||
(progn
|
||||
,(when (and (member (getf options :direction) '(:io :output))
|
||||
(let ((l (nth-value 2 (get-properties options '(:if-does-not-exist)))))
|
||||
(or (null l)
|
||||
(eq (getf l :if-does-not-exist) :create))))
|
||||
`(ensure-parent-exists ,filespec))
|
||||
(with-open-file (,stream ,filespec ,@options)
|
||||
,@body))))
|
Loading…
Reference in New Issue