ambrevar/storage: Fix sync-gpg-key.

master
Pierre Neidhardt 2021-06-05 15:12:59 +02:00
parent b225bb05e8
commit a0821b0fca
1 changed files with 12 additions and 8 deletions

View File

@ -220,10 +220,15 @@ If DESTINATION ends with '.gpg', it gets GPG-encrypted."
(export-always 'sync-gpg-key) (export-always 'sync-gpg-key)
(defun sync-gpg-key (device &key (mount-point "/mnt")) (defun sync-gpg-key (device &key (mount-point "/mnt"))
"Device (e.g. /dev/sda1) where to sync ~/.gnupg." "Device (e.g. /dev/sda1) where to sync ~/.gnupg."
(let ((mapper-name "gpg_backup")) (format t "Enter passphrase for ~a:~&" device)
(cmd:cmd "sudo cryptsetup open" device mapper-name) (let ((mapper-name "gpg_backup")
(passphrase (uiop:run-program `(,(uiop:getenv "SUDO_ASKPASS")) :output '(:string :stripped t))))
(with-input-from-string (input passphrase)
(uiop:run-program
`("sudo" "cryptsetup" "open" ,device ,mapper-name)
:input input))
(cmd:cmd "sudo mount -o compress=zstd" (cmd:cmd "sudo mount -o compress=zstd"
(str:concat "/dev/mapper" mapper-name) (str:concat "/dev/mapper/" mapper-name)
mount-point) mount-point)
(cmd:cmd "gpg --import" (cmd:cmd "gpg --import"
(str:concat mount-point "/public/.gnupg/pubring.gpg")) (str:concat mount-point "/public/.gnupg/pubring.gpg"))
@ -232,17 +237,16 @@ If DESTINATION ends with '.gpg', it gets GPG-encrypted."
(str:concat mount-point "/.snapshots/public." (str:concat mount-point "/.snapshots/public."
(local-time:format-timestring t (local-time:now) (local-time:format-timestring t (local-time:now)
:format +fs-time-format+))) :format +fs-time-format+)))
;; TODO: Uncomment this once tested. (uiop:delete-directory-tree
;; (uiop:delete-directory-tree (str:concat mount-point "/public/.gnupg/")
;; (str:concat mount-point "/public/.gnupg") :validate t)
;; :validate t)
;; TODO: How to copy directory trees in pure CL? ;; TODO: How to copy directory trees in pure CL?
(cmd:cmd "cp -av" (home ".gnupg") (str:concat mount-point "/public")) (cmd:cmd "cp -av" (home ".gnupg") (str:concat mount-point "/public"))
(cmd:cmd "sudo umount" mount-point) (cmd:cmd "sudo umount" mount-point)
(cmd:cmd "sudo cryptsetup close" mapper-name))) (cmd:cmd "sudo cryptsetup close" mapper-name)))
(export-always 'sync-all) (export-always 'sync-all)
(defun sync-all () (defun sync-all () ; REVIEW: Optionally call `sync-gpg-key'?
(dolist (op '(write-roots-index (dolist (op '(write-roots-index
notmuch-tags notmuch-tags
stowed-saves stowed-saves