ambrevar: Add EncFS wrapper.

.local/share/common-lisp/source/ambrevar/all.lisp

@@ -50,6 +50,7 @@
   (:use-reexport
    #:ambrevar/debug
    #:ambrevar/emacs
+   #:ambrevar/encfs
    #:ambrevar/guix
    #:ambrevar/shell
    #:ambrevar/storage

.local/share/common-lisp/source/ambrevar/encfs.lisp

@@ -0,0 +1,56 @@
+(uiop:define-package ambrevar/encfs
+  (:documentation "Convenience wrapper around encfs")
+  (:use #:common-lisp)
+  (:import-from #:cmd)
+  (:import-from #:fof)
+  (:import-from #:log4cl)
+  (:import-from #:ambrevar/storage)
+  (:import-from #:serapeum #:export-always))
+(in-package ambrevar/encfs)
+(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)
+  (trivial-package-local-nicknames:add-package-local-nickname :path :pathname-utils))
+
+(defun encfs-roots ()
+  (mapcar (alex:compose #'rest #'first)
+          (rest
+           (first (json:decode-json-from-string
+                   (cmd:$cmd "findmnt --noheadings --output=target encfs --json"))))))
+
+(export-always 'mount)
+(defun mount (encrypted-directory
+              &optional (mount-point (str:concat encrypted-directory "_decrypted")))
+  (ambrevar/shell:make-directory mount-point)
+  (setf mount-point (fof:path (fof:file mount-point)))
+  (let ((code (nth-value 2
+                         (uiop:run-program
+                          `("encfs"
+                            ,(str:concat "--extpass="
+                                         (uiop:getenv "SUDO_ASKPASS"))
+                            ,(fof:path (fof:file encrypted-directory))
+                            ,mount-point)
+                          :output t
+                          :error-output t))))
+    (unless (= 0 code)
+      (uiop:delete-empty-directory mount-point))))
+
+(defvar *index-destination* (ambrevar/storage::personal "index"))
+
+(export-always 'unmount)
+(defun unmount (&rest roots)
+  "Unmount EncFS ROOTS.
+If ROOTS is unspecified, unmount all."
+  (setf roots (mapcar #'fof:file (or roots (encfs-roots))))
+  (mapcar (lambda (root)
+            (let ((parent (fof:basename (fof:parent root))))
+              (ambrevar/storage::write-index
+               (fof:path root)
+               (ambrevar/storage::subpath
+                *index-destination*
+                parent
+                (str:concat (fof:basename root) ".index.gpg"))))
+            (uiop:run-program `("fusermount" "-u" ,(fof:path root))
+                              :output t :error-output t)
+            (uiop:delete-empty-directory (fof:path root)))
+          roots))