diff options
Diffstat (limited to 'lisp/zfs.el')
| -rw-r--r-- | lisp/zfs.el | 1028 |
1 files changed, 1028 insertions, 0 deletions
diff --git a/lisp/zfs.el b/lisp/zfs.el new file mode 100644 index 0000000..7d86e2e --- /dev/null +++ b/lisp/zfs.el @@ -0,0 +1,1028 @@ +;;; zfs.el --- ZFS management UI -*- lexical-binding: t; -*- + +(require 'vui) +(require 'vui-components) +(require 'async) +(require 'zfs-cli) + +(defcustom zfs-buffer-name "*zfs*" + "Name of the ZFS management buffer." + :type 'string + :group 'zfs) + +(defcustom zfs-targets-file (locate-user-emacs-file "zfs-targets.eld") + "File where backup targets are stored as a plain elisp list." + :type 'file + :group 'zfs) + +(defcustom zfs-backup-targets nil + "Seed backup targets, used when `zfs-targets-file' does not exist yet. +Same plist shape as documented there." + :type '(repeat sexp) + :group 'zfs) + +(defvar-local zfs-ui--row-actions nil) +(defvar-local zfs-ui--refresh-fn nil) + +(defun zfs-ui--targets-load () + (if (file-exists-p zfs-targets-file) + (with-temp-buffer + (insert-file-contents zfs-targets-file) + (goto-char (point-min)) + (read (current-buffer))) + zfs-backup-targets)) + +(defun zfs-ui--targets-save (targets) + (with-temp-file zfs-targets-file + (pp targets (current-buffer)))) + +(defun zfs--format-bytes (bytes) + (cond + ((null bytes) "-") + ((not (numberp bytes)) (format "%s" bytes)) + (t (let ((units '((1099511627776 . "T") (1073741824 . "G") (1048576 . "M") (1024 . "K"))) + (result nil)) + (dolist (unit units) + (when (and (not result) (>= bytes (car unit))) + (let ((value (/ bytes (float (car unit))))) + (setq result (if (< value 10) (format "%.1f%s" value (cdr unit)) + (format "%.0f%s" value (cdr unit))))))) + (or result (format "%dB" bytes)))))) + +(defun zfs--format-ago (epoch) + (if (not (numberp epoch)) + "-" + (let ((delta (- (float-time) epoch))) + (cond + ((< delta 90) "just now") + ((< delta 3600) (format "%dm ago" (truncate (/ delta 60)))) + ((< delta 86400) (format "%dh ago" (truncate (/ delta 3600)))) + ((< delta (* 30 86400)) (format "%dd ago" (truncate (/ delta 86400)))) + ((< delta (* 365 86400)) (format "%dmo ago" (truncate (/ delta (* 30 86400))))) + (t (format "%dy ago" (truncate (/ delta (* 365 86400))))))))) + +(defun zfs--gauge (percent &optional width) + (let* ((width (or width 20)) + (done (max 0 (min width (round (* width (/ (or percent 0) 100.0))))))) + (concat (make-string done ?█) (make-string (- width done) ?░)))) + +(defun zfs--health-face (health) + (pcase health + ("ONLINE" 'success) + ("DEGRADED" 'warning) + (_ 'error))) + +(defun zfs--capacity-face (percent) + (cond + ((>= (or percent 0) 90) 'error) + ((>= (or percent 0) 75) 'warning) + (t 'success))) + +(defun zfs--direct-children (datasets parent) + (let ((prefix (concat parent "/"))) + (seq-filter (lambda (entry) + (and (string-prefix-p prefix (car entry)) + (not (string-match-p "/" (substring (car entry) (length prefix)))))) + datasets))) + +(defun zfs--snapshots-of (snaps dataset) + (seq-filter (lambda (entry) + (string-prefix-p (concat dataset "@") (car entry))) + snaps)) + +(defun zfs--snapshot-leaf (full-name) + (car (last (split-string full-name "@" t)))) + +(defun zfs-ui--fetch (host include-disks callback) + (let ((cli-dir (file-name-directory (locate-library "zfs-cli.el")))) + (async-start + `(lambda () + (add-to-list 'load-path ,cli-dir) + (require 'zfs-cli) + (list :pools (condition-case err (zfs-cli-pools ',host) + (error (cons :error (error-message-string err)))) + :datasets (condition-case err (zfs-cli-datasets ',host) + (error (cons :error (error-message-string err)))) + :snaps (condition-case err (zfs-cli-snapshots ',host) + (error (cons :error (error-message-string err)))) + :locked ,(if include-disks + '(condition-case err + (mapcar (lambda (device) + (append device + (list :pool (and (zfs-cli-disk-unlocked-p device) + (zfs-cli-pool-on-device + (concat "/dev/mapper/" (zfs-cli-disk-mapper device))))))) + (zfs-cli-locked-disks)) + (error (cons :error (error-message-string err)))) + nil))) + callback))) + +(defun zfs-ui--fetch-done (result) + (let ((pools (plist-get result :pools)) + (datasets (plist-get result :datasets)) + (snaps (plist-get result :snaps)) + (locked (plist-get result :locked))) + (vui-batch + (vui-set-state :loading nil) + (vui-set-state :refreshed (format-time-string "%H:%M")) + (if (and (eq (car-safe pools) :error) (eq (car-safe datasets) :error)) + (vui-set-state :message (cons (format "Could not reach host: %s" (cdr pools)) 'error)) + (vui-set-state :pools (and (not (eq (car-safe pools) :error)) pools)) + (vui-set-state :datasets (and (not (eq (car-safe datasets) :error)) datasets)) + (vui-set-state :snaps (and (not (eq (car-safe snaps) :error)) snaps)) + (vui-set-state :locked (and (listp locked) (not (eq (car-safe locked) :error)) locked)))))) + +(defun zfs-ui--refresh (host) + (vui-set-state :loading t) + (zfs-ui--fetch host (null host) (vui-async-callback (result) (zfs-ui--fetch-done result)))) + +(defun zfs-ui--go (page &optional arg) + (vui-batch + (vui-set-state :page page) + (vui-set-state :page-arg arg) + (vui-set-state :backup-target nil) + (vui-set-state :backup-preview nil) + (vui-set-state :backup-progress nil) + (vui-set-state :backup-done nil) + (vui-set-state :create-status nil) + (vui-set-state :format-disk nil) + (vui-set-state :format-status nil))) + +(defun zfs-ui--fail (err) + (vui-set-state :message (cons (format "Error: %s" (error-message-string err)) 'error))) + +(defun zfs-ui--do-snapshot (host dataset) + (let ((snap-name (read-string (format "Snapshot name for %s: " dataset) + (format-time-string "manual-%Y-%m-%d_%H-%M")))) + (condition-case err + (progn + (zfs-cli-snapshot host dataset snap-name) + (vui-set-state :message (cons (format "Snapshot %s@%s created" dataset snap-name) 'success)) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err))))) + +(defun zfs-ui--do-destroy (host target has-dependents) + (when (yes-or-no-p (if has-dependents + (format "Destroy %s including its children and snapshots? " target) + (format "Destroy %s? " target))) + (condition-case err + (progn + (zfs-cli-destroy host target has-dependents) + (vui-set-state :message (cons (format "Destroyed %s" target) 'success)) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err))))) + +(defun zfs-ui--do-rollback (host snapshot) + (when (yes-or-no-p (format "Roll back to %s? Snapshots taken after it are destroyed. " snapshot)) + (condition-case err + (progn + (zfs-cli-rollback host snapshot) + (vui-set-state :message (cons (format "Rolled back to %s" snapshot) 'success)) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err))))) + +(defun zfs-ui--do-mount (host dataset) + (condition-case err + (progn + (zfs-cli-mount host dataset) + (vui-set-state :message (cons (format "Mounted %s" dataset) 'success)) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err)))) + +(defun zfs-ui--do-diff (host snapshot) + (let ((command (if host + (format "ssh -o BatchMode=yes %s %s" + (shell-quote-argument (plist-get host :ssh)) + (shell-quote-argument (concat "doas -n zfs diff -H " snapshot))) + (format "doas -n zfs diff -H %s" snapshot)))) + (if (fboundp 'ghostel-compile) + (ghostel-compile command) + (compile command)))) + +(defun zfs-ui--do-scrub (host pool stop) + (condition-case err + (progn + (zfs-cli-scrub host pool stop) + (vui-set-state :message (cons (if stop "Scrub stopped" "Scrub started — reads all data, verifies checksums") + 'success)) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err)))) + +(defun zfs-ui--do-export (host pool) + (when (yes-or-no-p (format "Export %s? The pool goes offline until imported again. " pool)) + (condition-case err + (progn + (zfs-cli-export host pool) + (vui-set-state :message (cons (format "Exported %s" pool) 'success)) + (zfs-ui--go 'overview) + (zfs-ui--refresh host)) + (error (zfs-ui--fail err))))) + +(defun zfs-ui--do-unlock (device) + (let ((passphrase (read-passwd (format "LUKS passphrase for %s: " (plist-get device :name))))) + (condition-case err + (let ((mapper (concat "luks-" (plist-get device :name)))) + (zfs-cli-luks-open (plist-get device :path) mapper passphrase) + (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" mapper)))) + (if pool + (progn + (zfs-cli-import nil pool t) + (vui-set-state :message (cons (format "Unlocked — pool %s imported" pool) 'success))) + (vui-set-state :message (cons "Unlocked, but no ZFS pool found on the device" 'warning)))) + (zfs-ui--refresh nil)) + (error (zfs-ui--fail err))))) + +(defun zfs-ui--do-import (device) + (condition-case err + (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" (zfs-cli-disk-mapper device))))) + (if pool + (progn + (zfs-cli-import nil pool t) + (vui-set-state :message (cons (format "Imported %s" pool) 'success)) + (zfs-ui--refresh nil)) + (vui-set-state :message (cons "No ZFS pool found on the device" 'warning)))) + (error (zfs-ui--fail err)))) + +(defun zfs-ui--do-lock (device pools) + (let* ((mapper (zfs-cli-disk-mapper device)) + (pool (zfs-cli-pool-on-device (concat "/dev/mapper/" mapper)))) + (when (yes-or-no-p (if (and pool (assoc pool pools)) + (format "Export %s and lock %s? " pool (plist-get device :name)) + (format "Lock %s? " (plist-get device :name)))) + (condition-case err + (progn + (when (and pool (assoc pool pools)) + (zfs-cli-export nil pool)) + (zfs-cli-luks-close mapper) + (vui-set-state :message (cons (format "Locked %s" (plist-get device :name)) 'success)) + (zfs-ui--refresh nil)) + (error (zfs-ui--fail err)))))) + +(defun zfs-ui--common-base (snaps target-snap-names dataset) + (let* ((own (zfs--snapshots-of snaps dataset)) + (common (seq-filter (lambda (entry) + (member (zfs--snapshot-leaf (car entry)) target-snap-names)) + own)) + (sorted (sort (copy-sequence common) + (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0) + (or (zfs-cli-prop b 'creation) 0)))))) + (when sorted + (car (car (last sorted)))))) + +(defun zfs-ui--newest-snapshot (snaps dataset) + (let ((sorted (sort (copy-sequence (zfs--snapshots-of snaps dataset)) + (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0) + (or (zfs-cli-prop b 'creation) 0)))))) + (car (last sorted)))) + +(defun zfs-ui--backup-preview (host dataset snapshot snaps entry target) + (let* ((leaf (file-name-nondirectory dataset)) + (target-dataset (concat (plist-get target :dataset) "/" leaf)) + (target-snap-names (condition-case nil + (mapcar (lambda (snap-entry) (zfs--snapshot-leaf (car snap-entry))) + (zfs-cli-snapshots target target-dataset)) + (error nil))) + (base (zfs-ui--common-base snaps target-snap-names dataset)) + (raw (and entry (not (member (zfs-cli-prop entry 'encryption) '(nil "off"))))) + (preview (zfs-cli-send-preview host snapshot base))) + (list :target-dataset target-dataset + :base base + :raw raw + :kind (plist-get preview :kind) + :bytes (plist-get preview :bytes)))) + +(defun zfs-ui--backup-event (event) + (pcase (car event) + (:progress + (vui-set-state :backup-progress (nth 1 event))) + (:done + (if (zerop (nth 1 event)) + (vui-batch + (vui-set-state :backup-done 'success) + (vui-set-state :backup-progress nil)) + (vui-batch + (vui-set-state :backup-done (format "%s" (nth 2 event))) + (vui-set-state :backup-progress nil)))))) + +(defun zfs-ui--start-backup (host snapshot target preview) + (vui-batch + (vui-set-state :backup-progress "starting…") + (vui-set-state :backup-done nil)) + (zfs-cli-send-async host snapshot target (plist-get preview :target-dataset) + (plist-get preview :base) (plist-get preview :raw) + (vui-async-callback (event) + (zfs-ui--backup-event event)))) + +(defun zfs-ui--field-string (key) + (or (vui-field-value key) "")) + +(defun zfs-ui--start-move (host dataset mountpoint move-dir) + (vui-set-state :create-status (cons "Copying… 0%" 'shadow)) + (zfs-cli-rsync-async + move-dir mountpoint + (vui-async-callback (event) + (pcase (car event) + (:progress + (when (string-match "\\([0-9]+%\\)" (nth 1 event)) + (vui-set-state :create-status + (cons (format "Copying… %s" (match-string 1 (nth 1 event))) 'shadow)))) + (:done + (if (zerop (nth 1 event)) + (vui-set-state :message + (cons (format "%s created, data copied — original kept in %s" dataset move-dir) + 'success)) + (vui-set-state :message + (cons (format "%s created, but copying failed: %s" dataset (nth 2 event)) + 'error))) + (zfs-ui--go 'dataset dataset) + (zfs-ui--refresh host)))))) + +(defun zfs-ui--do-create-dataset (host parent) + (let* ((leaf (zfs-ui--field-string "create-name")) + (mountpoint (zfs-ui--field-string "create-mountpoint")) + (quota (zfs-ui--field-string "create-quota")) + (passphrase (zfs-ui--field-string "create-passphrase")) + (encrypted (not (string-blank-p passphrase))) + (compression (zfs-ui--field-string "create-compression")) + (move-dir (zfs-ui--field-string "create-move")) + (dataset (concat parent "/" leaf))) + (cond + ((string-blank-p leaf) + (vui-set-state :create-status (cons "Name is empty" 'error))) + ((string-match-p "/" leaf) + (vui-set-state :create-status (cons "Name must be a single segment, no slashes" 'error))) + ((and (not (string-blank-p move-dir)) (string-blank-p mountpoint)) + (vui-set-state :create-status (cons "Moving a folder in needs a mountpoint" 'error))) + (t + (let ((properties nil)) + (when (and compression (not (equal compression "inherit"))) + (push (cons "compression" compression) properties)) + (when (and mountpoint (not (string-blank-p mountpoint)) (not (equal mountpoint "none"))) + (push (cons "mountpoint" mountpoint) properties)) + (when (and quota (not (string-blank-p quota))) + (push (cons "quota" quota) properties)) + (condition-case err + (progn + (if encrypted + (zfs-cli-create-encrypted host dataset passphrase properties) + (zfs-cli-create host dataset properties)) + (when (and (not (string-blank-p mountpoint)) (not (equal mountpoint "none"))) + (ignore-errors (zfs-cli-mount host dataset))) + (if (not (string-blank-p move-dir)) + (zfs-ui--start-move host dataset mountpoint move-dir) + (vui-set-state :message (cons (format "Created %s" dataset) 'success)) + (zfs-ui--go 'dataset dataset) + (zfs-ui--refresh host))) + (error (vui-set-state :create-status (cons (error-message-string err) 'error))))))))) + +(defun zfs-ui--do-format (device pool-name encrypted passphrase) + (let ((mapper (concat "luks-" (plist-get device :name)))) + (vui-set-state :format-status (cons "Formatting… this takes a moment" 'shadow)) + (zfs-cli-format-disk-async + (plist-get device :path) pool-name mapper (and encrypted passphrase) + (vui-async-callback (status err) + (if (zerop status) + (vui-batch + (vui-set-state :format-status (cons (format "Pool %s created on %s" pool-name (plist-get device :name)) + 'success)) + (vui-set-state :format-disk nil) + (zfs-ui--refresh nil)) + (vui-set-state :format-status (cons (format "Format failed: %s" err) 'error))))))) + +(defconst zfs-ui--property-glossary + '(("used" . "live data + snapshots + children together") + ("referenced" . "live data right now, snapshots excluded") + ("usedbysnapshots" . "only reachable through snapshots; freed when you delete them") + ("usedbychildren" . "used by datasets below this one") + ("available" . "room this dataset can still grow into") + ("compressratio" . "how much smaller data is stored; 1.31x ≈ 24% saved") + ("encryption" . "dataset-level encryption, independent of disk LUKS") + ("keystatus" . "available = key loaded, data readable") + ("mountpoint" . "where it shows up; legacy = mounted by the system, not zfs") + ("recordsize" . "max block size; matters for databases and VM images") + ("quota" . "hard size limit, if set") + ("reservation" . "space guaranteed to this dataset, if set") + ("creation" . "when the dataset was created") + ("mounted" . "whether it is currently mounted"))) + +(defun zfs-ui--dataset-row (entry depth snap-count) + (let* ((name (car entry)) + (short (file-name-nondirectory name)) + (label (concat (make-string (* 2 depth) ?\s) + (if (> snap-count 0) "▸ " " ") + short + (when (> snap-count 0) (format " (%d)" snap-count)))) + (encryption (zfs-cli-prop entry 'encryption)) + (keystatus (zfs-cli-prop entry 'keystatus))) + (vui-hstack + (vui-box (vui-button (truncate-string-to-width label 32) :no-decoration t + :key (concat "ds:" name) + :on-click (lambda () (zfs-ui--go 'dataset name))) + :width 34) + (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'used))) :width 9) + (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'available)) :face 'shadow) :width 9) + (vui-box (vui-text (format "%s" (or (zfs-cli-prop entry 'compressratio) "-")) :face 'shadow) :width 7) + (vui-box (cond + ((or (null encryption) (equal encryption "off")) (vui-text "·" :face 'shadow)) + ((equal keystatus "available") (vui-text "🔓" :face 'success)) + (t (vui-text "🔒" :face 'warning))) + :width 4)))) + +(defun zfs-ui--dataset-rows (entry depth datasets snaps) + (let* ((name (car entry)) + (children (zfs--direct-children datasets name)) + (own-snaps (zfs--snapshots-of snaps name))) + (push (cons (concat "ds:" name) + (list :open (vui-with-async-context (zfs-ui--go 'dataset name)) + :backup (vui-with-async-context (zfs-ui--go 'backup name)) + :create-child (vui-with-async-context (zfs-ui--go 'create name)))) + zfs-ui--row-actions) + (cons (zfs-ui--dataset-row entry depth (length own-snaps)) + (mapcan (lambda (child) (zfs-ui--dataset-rows child (1+ depth) datasets snaps)) + children)))) + +(defun zfs-ui--pool-row (pool) + (let* ((name (car pool)) + (health (zfs-cli-prop pool 'health)) + (capacity (zfs-cli-prop pool 'capacity)) + (size (zfs-cli-prop pool 'size)) + (free (zfs-cli-prop pool 'free))) + (push (cons (concat "pool:" name) + (list :open (vui-with-async-context (zfs-ui--go 'pool name)) + :create-child (vui-with-async-context (zfs-ui--go 'create name)))) + zfs-ui--row-actions) + (vui-hstack + :spacing 1 + (vui-box (vui-button name :no-decoration t + :key (concat "pool:" name) + :on-click (lambda () (zfs-ui--go 'pool name))) + :width 10) + (vui-box (vui-text (or health "?") :face (zfs--health-face health)) :width 9) + (vui-box (vui-text (zfs--gauge capacity) + :face (zfs--capacity-face capacity)) + :width 22) + (vui-text (format "%d%% · %s free of %s" + (or capacity 0) + (zfs--format-bytes free) + (zfs--format-bytes size)) + :face 'shadow)))) + +(defun zfs-ui--locked-disk-row (device pools) + (let* ((name (plist-get device :name)) + (unlocked (zfs-cli-disk-unlocked-p device)) + (mapper (zfs-cli-disk-mapper device)) + (pool (plist-get device :pool)) + (imported (and pool (assoc pool pools)))) + (push (cons (concat "lock:" name) + (if unlocked + (append (unless imported + (list :import (vui-with-async-context (zfs-ui--do-import device)))) + (list :lock (vui-with-async-context (zfs-ui--do-lock device pools)))) + (list :unlock (vui-with-async-context (zfs-ui--do-unlock device))))) + zfs-ui--row-actions) + (vui-hstack + :spacing 1 + (vui-box (vui-text (if unlocked "🔓" "🔒") :face (if unlocked 'warning 'shadow)) :width 3) + (vui-box (vui-button name :no-decoration t + :key (concat "lock:" name) + :on-click (lambda () nil)) + :width 10) + (vui-box (vui-text (or (plist-get device :model) "?") :face 'shadow) :width 24) + (vui-box (vui-text (zfs--format-bytes (plist-get device :size)) :face 'shadow) :width 8) + (vui-text (cond + (imported (format "pool %s imported · L ejects and locks" pool)) + (unlocked (format "unlocked as %s · i imports pool %s · L locks" mapper (or pool "?"))) + (t "locked · u unlock")) + :face 'shadow)))) + +(defun zfs-ui--page-overview (pools datasets snaps locked) + (push (cons 'page + (list :format (vui-with-async-context (zfs-ui--go 'new-pool)) + :targets (vui-with-async-context (zfs-ui--go 'targets)))) + zfs-ui--row-actions) + (let ((roots (seq-filter (lambda (entry) (not (string-match-p "/" (car entry)))) datasets))) + (apply + #'vui-vstack + :spacing 1 + (append + (when locked + (list (vui-vstack + :spacing 0 + (vui-heading-3 "Disks") + (vui-muted "LUKS disks ZFS can use once unlocked") + (apply #'vui-vstack :spacing 0 + (mapcar (lambda (device) (zfs-ui--locked-disk-row device pools)) locked))))) + (list + (vui-vstack + :spacing 0 + (vui-heading-3 "Pools") + (vui-muted "teams of disks; datasets live inside them · RET details · F format a disk") + (apply #'vui-vstack :spacing 0 (mapcar #'zfs-ui--pool-row pools))) + (vui-vstack + :spacing 0 + (vui-heading-3 "Datasets") + (vui-muted "named drawers · RET details · b backup · c new dataset inside") + (vui-hstack + (vui-box (vui-text "NAME" :face 'shadow) :width 34) + (vui-box (vui-text "USED" :face 'shadow) :width 9) + (vui-box (vui-text "AVAIL" :face 'shadow) :width 9) + (vui-box (vui-text "RATIO" :face 'shadow) :width 7) + (vui-box (vui-text "ENC" :face 'shadow) :width 4)) + (apply #'vui-vstack :spacing 0 + (mapcan (lambda (root) (zfs-ui--dataset-rows root 0 datasets snaps)) roots)))))))) + +(defun zfs-ui--property-row (entry property) + (let* ((raw (zfs-cli-prop entry (intern property))) + (value (cond + ((equal property "creation") (format "%s (%s)" + (format-time-string "%Y-%m-%d" raw) + (zfs--format-ago raw))) + ((and (member property '("quota" "reservation")) (or (null raw) (equal raw 0))) "none") + ((numberp raw) (zfs--format-bytes raw)) + (t (format "%s" (or raw "-"))))) + (gloss (cdr (assoc property zfs-ui--property-glossary)))) + (vui-hstack + (vui-box (vui-text property :face 'shadow) :width 18) + (vui-box (vui-text value) :width 22) + (vui-text (or gloss "") :face 'shadow)))) + +(defun zfs-ui--snapshot-row (snap dataset host) + (let* ((full-name (car snap)) + (leaf (zfs--snapshot-leaf full-name))) + (push (cons (concat "snap:" full-name) + (list :diff (vui-with-async-context (zfs-ui--do-diff host full-name)) + :rollback (vui-with-async-context (zfs-ui--do-rollback host full-name)) + :backup (vui-with-async-context (zfs-ui--go 'backup (cons dataset full-name))) + :destroy (vui-with-async-context (zfs-ui--do-destroy host full-name nil)))) + zfs-ui--row-actions) + (vui-hstack + (vui-box (vui-button (concat "@" leaf) :no-decoration t :face 'shadow + :key (concat "snap:" full-name) + :on-click (lambda () nil)) + :width 38) + (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop snap 'used)) :face 'shadow) :width 9) + (vui-text (zfs--format-ago (zfs-cli-prop snap 'creation)) :face 'shadow)))) + +(defun zfs-ui--page-dataset (name host datasets snaps) + (let* ((entry (assoc name datasets)) + (own-snaps (zfs--snapshots-of snaps name))) + (when entry + (push (cons 'page + (list :snapshot (vui-with-async-context (zfs-ui--do-snapshot host name)) + :backup (vui-with-async-context (zfs-ui--go 'backup name)) + :create-child (vui-with-async-context (zfs-ui--go 'create name)) + :destroy (vui-with-async-context (zfs-ui--do-destroy host name t)) + :mount (vui-with-async-context (zfs-ui--do-mount host name)))) + zfs-ui--row-actions)) + (if (null entry) + (vui-text (format "%s not found — g to refresh" name) :face 'error) + (apply + #'vui-vstack + :spacing 1 + (append + (list + (vui-hstack :spacing 2 + (vui-heading-3 name) + (vui-text (downcase (or (alist-get 'type (cdr entry)) "")) :face 'shadow)) + (vui-muted (format "Everything in this dataset and its snapshots uses %s." + (zfs--format-bytes (zfs-cli-prop entry 'used)))) + (vui-text "s snapshot · b backup · c new dataset inside · m mount · D destroy" :face 'shadow) + (apply #'vui-vstack :spacing 0 + (mapcar (lambda (property) (zfs-ui--property-row entry property)) + '("used" "referenced" "usedbysnapshots" "usedbychildren" "available" + "compressratio" "encryption" "keystatus" "mountpoint" "recordsize" + "quota" "creation" "mounted")))) + (list + (apply + #'vui-vstack + :spacing 0 + (append + (list (vui-heading-3 (format "Snapshots (%d)" (length own-snaps))) + (vui-muted "frozen moments · d what changed since · r roll back to · D delete")) + (if own-snaps + (mapcar (lambda (snap) (zfs-ui--snapshot-row snap name host)) own-snaps) + (list (vui-muted "none yet — press s to freeze this moment"))))))))))) + +(defun zfs-ui--vdev-row (vdev depth) + (vui-hstack + (vui-box (vui-text (concat (make-string (* 2 depth) ?\s) (plist-get vdev :name))) :width 40) + (vui-box (vui-text (or (plist-get vdev :state) "?") + :face (zfs--health-face (plist-get vdev :state))) + :width 9) + (vui-text (format "%s/%s/%s errors" + (or (plist-get vdev :read-errors) 0) + (or (plist-get vdev :write-errors) 0) + (or (plist-get vdev :checksum-errors) 0)) + :face 'shadow))) + +(defun zfs-ui--page-pool (name host) + (let ((status (ignore-errors (zfs-cli-pool-status host name)))) + (when status + (push (cons 'page + (list :scrub-start (vui-with-async-context (zfs-ui--do-scrub host name nil)) + :scrub-stop (vui-with-async-context (zfs-ui--do-scrub host name t)) + :export (vui-with-async-context (zfs-ui--do-export host name)))) + zfs-ui--row-actions)) + (if (null status) + (vui-text (format "Could not read status of %s" name) :face 'error) + (let ((state (alist-get 'state status)) + (error-count (alist-get 'error_count status)) + (scan (alist-get 'scan status)) + (vdevs (zfs-cli-pool-vdevs status))) + (vui-vstack + :spacing 1 + (vui-hstack :spacing 2 + (vui-heading-3 name) + (vui-text state :face (zfs--health-face state))) + (vui-muted (if (> (or error-count 0) 0) + (format "%d errors — check the devices below" error-count) + "No known data errors.")) + (vui-text (if scan + (format "Scan: %s" (or (alist-get 'state scan) "recorded")) + "Scrub: never run here — it reads everything and verifies checksums") + :face 'shadow) + (vui-text "1 scrub start · 2 scrub stop · x export (take offline)" :face 'shadow) + (vui-vstack + :spacing 0 + (vui-heading-3 "Devices") + (apply #'vui-vstack :spacing 0 + (mapcar (lambda (vdev) (zfs-ui--vdev-row vdev 0)) vdevs)))))))) + +(defun zfs-ui--form-row (label content &optional gloss) + (vui-hstack + (vui-box (vui-text label :face 'shadow) :width 14 :align :right) + content + (when gloss (vui-hstack (vui-space 2) (vui-text gloss :face 'shadow))))) + +(defun zfs-ui--page-create (parent host create-status) + (push (cons 'page (list :submit (vui-with-async-context (zfs-ui--do-create-dataset host parent)))) + zfs-ui--row-actions) + (vui-vstack + :spacing 1 + (vui-heading-3 (format "New dataset inside %s" parent)) + (vui-muted "A dataset is a drawer: its own compression, quota and snapshots.") + (zfs-ui--form-row "Name" + (vui-field :size 24 :key "create-name" :placeholder "music") + (format "→ %s/<name>" parent)) + (zfs-ui--form-row "Mountpoint" + (vui-field :size 24 :key "create-mountpoint" + :placeholder (expand-file-name "~/music")) + "where it appears; empty = not mounted") + (zfs-ui--form-row "Compression" + (vui-field :size 24 :key "create-compression" :value "zstd" + :placeholder "zstd") + "zstd squeezes better, lz4 is faster, off disables") + (zfs-ui--form-row "Passphrase" + (vui-field :size 24 :key "create-passphrase" :secret t + :placeholder "empty = not encrypted") + "dataset-level, on top of disk LUKS") + (zfs-ui--form-row "Quota" + (vui-field :size 24 :key "create-quota" :placeholder "empty = no limit") + "e.g. 50G") + (zfs-ui--form-row "Move folder in" + (vui-field :size 24 :key "create-move" + :placeholder "empty = start empty") + "rsync copy with progress; original is kept") + (vui-hstack + (vui-box (vui-text "") :width 14) + (vui-button "Create dataset" :on-click (lambda () (zfs-ui--do-create-dataset host parent)))) + (when create-status + (vui-text (car create-status) :face (cdr create-status))))) + +(defun zfs-ui--page-backup (arg host datasets snaps targets backup-target backup-preview backup-progress backup-done) + (let* ((dataset (if (consp arg) (car arg) arg)) + (snapshot (if (consp arg) (cdr arg) + (car (zfs-ui--newest-snapshot snaps dataset)))) + (entry (assoc dataset datasets))) + (if (null snapshot) + (vui-vstack + :spacing 1 + (vui-heading-3 (format "Backup %s" dataset)) + (vui-text "No snapshots yet — a backup sends a snapshot." :face 'warning) + (vui-button "Create one now" + :on-click (lambda () (zfs-ui--do-snapshot host dataset)))) + (vui-vstack + :spacing 1 + (vui-heading-3 (format "Backup %s" dataset)) + (vui-muted "Sends a snapshot to another machine or pool. After the first full copy only the changes travel.") + (vui-hstack + (vui-box (vui-text "Snapshot" :face 'shadow) :width 14 :align :right) + (vui-text (concat "@" (zfs--snapshot-leaf snapshot))) + (vui-space 2) + (vui-text (format "(%s)" (zfs--format-ago (zfs-cli-prop (assoc snapshot snaps) 'creation))) + :face 'shadow)) + (vui-vstack + :spacing 0 + (vui-hstack (vui-box (vui-text "Target" :face 'shadow) :width 14 :align :right) + (vui-text "")) + (apply + #'vui-vstack + :spacing 0 + (mapcar (lambda (target) + (vui-hstack + (vui-box (vui-text "") :width 14) + (vui-button (format "%s — %s %s" + (plist-get target :name) + (or (plist-get target :ssh) "this machine") + (plist-get target :dataset)) + :no-decoration (not (equal target backup-target)) + :face (when (equal target backup-target) 'success) + :on-click + (lambda () + (vui-set-state :backup-target target) + (condition-case err + (vui-set-state :backup-preview + (zfs-ui--backup-preview host dataset snapshot snaps entry target)) + (error (vui-set-state :message + (cons (format "Preview failed: %s" (error-message-string err)) 'error)))))))) + targets))) + (vui-hstack + (vui-box (vui-text "One-off" :face 'shadow) :width 14 :align :right) + (vui-field :size 18 :key "oneoff-ssh" :placeholder "user@host — empty = local") + (vui-space 1) + (vui-field :size 18 :key "oneoff-prefix" :placeholder "pool/prefix") + (vui-space 1) + (vui-button "Use once" + :on-click + (lambda () + (let ((prefix (zfs-ui--field-string "oneoff-prefix"))) + (if (string-blank-p prefix) + (vui-set-state :message (cons "One-off target needs a dataset prefix" 'error)) + (let ((target (list :name "one-off" :dataset prefix)) + (ssh (zfs-ui--field-string "oneoff-ssh"))) + (unless (string-blank-p ssh) + (setq target (append target (list :ssh ssh)))) + (vui-set-state :backup-target target) + (condition-case err + (vui-set-state :backup-preview + (zfs-ui--backup-preview host dataset snapshot snaps entry target)) + (error (vui-set-state :message + (cons (format "Preview failed: %s" (error-message-string err)) 'error)))))))))) + (when backup-target + (vui-hstack + (vui-box (vui-text "Will send" :face 'shadow) :width 14 :align :right) + (if backup-preview + (vui-text (format "%s · %s%s" + (if (equal (plist-get backup-preview :kind) "incremental") + (format "only changes since @%s" (zfs--snapshot-leaf (plist-get backup-preview :base))) + "everything (first time)") + (zfs--format-bytes (plist-get backup-preview :bytes)) + (if (plist-get backup-preview :raw) " · stays encrypted" ""))) + (vui-text "…" :face 'shadow)))) + (when (and backup-target backup-preview (not backup-progress) (not backup-done)) + (vui-hstack + (vui-box (vui-text "") :width 14) + (vui-button "Start backup" + :on-click (lambda () (zfs-ui--start-backup host snapshot backup-target backup-preview))))) + (when backup-progress + (vui-hstack + (vui-box (vui-text "Sending" :face 'shadow) :width 14 :align :right) + (vui-text backup-progress :face 'shadow))) + (when backup-done + (vui-hstack + (vui-box (vui-text "") :width 14) + (if (eq backup-done 'success) + (vui-text "Backup complete." :face 'success) + (vui-text (format "Backup failed: %s" backup-done) :face 'error)))))))) + +(defun zfs-ui--page-format (format-disk format-status) + (if (null format-disk) + (let ((candidates (zfs-cli-disk-candidates))) + (vui-vstack + :spacing 1 + (vui-heading-3 "Format a disk as ZFS") + (vui-muted "Everything on the chosen disk is erased. Only unused disks are listed.") + (if candidates + (apply + #'vui-vstack + :spacing 0 + (mapcar (lambda (device) + (vui-button (format "%s — %s — %s" + (plist-get device :name) + (or (plist-get device :model) "?") + (zfs--format-bytes (plist-get device :size))) + :no-decoration t + :on-click (lambda () (vui-set-state :format-disk device)))) + candidates)) + (vui-muted "No unused disks found. Plug one in and press g.")))) + (vui-vstack + :spacing 1 + (vui-heading-3 (format "Format %s" (plist-get format-disk :name))) + (vui-text (format "%s · %s — all data on it is erased" + (or (plist-get format-disk :model) "?") + (zfs--format-bytes (plist-get format-disk :size))) + :face 'warning) + (zfs-ui--form-row "Pool name" (vui-field :size 24 :key "format-pool" :placeholder "tank")) + (zfs-ui--form-row "Passphrase" (vui-field :size 24 :key "format-pass" :secret t + :placeholder "empty = no encryption") + "LUKS passphrase; empty leaves the disk unencrypted") + (zfs-ui--form-row "Type disk name" (vui-field :size 24 :key "format-confirm" + :placeholder (plist-get format-disk :name)) + "confirms you picked the right disk") + (vui-hstack + (vui-box (vui-text "") :width 14) + (vui-button "Format" + :face 'error + :on-click + (lambda () + (let ((pool-name (zfs-ui--field-string "format-pool")) + (passphrase (zfs-ui--field-string "format-pass"))) + (cond + ((string-blank-p pool-name) + (vui-set-state :format-status (cons "Pool name is empty" 'error))) + ((not (equal (zfs-ui--field-string "format-confirm") (plist-get format-disk :name))) + (vui-set-state :format-status (cons "Type the disk name to confirm" 'error))) + (t + (zfs-ui--do-format format-disk + pool-name + (not (string-blank-p passphrase)) + passphrase))))))) + (when format-status + (vui-text (car format-status) :face (cdr format-status)))))) + +(defun zfs-ui--page-targets (targets) + (push (cons 'page + (list :add (vui-with-async-context + (let ((name (zfs-ui--field-string "target-name")) + (ssh (zfs-ui--field-string "target-ssh")) + (prefix (zfs-ui--field-string "target-prefix"))) + (if (or (string-blank-p name) (string-blank-p prefix)) + (vui-set-state :message (cons "Name and dataset prefix are required" 'error)) + (let ((new (list :name name :dataset prefix))) + (unless (string-blank-p ssh) + (setq new (append new (list :ssh ssh)))) + (let ((updated (append targets (list new)))) + (zfs-ui--targets-save updated) + (vui-set-state :targets updated) + (vui-set-state :message (cons (format "Target %s saved to %s" name zfs-targets-file) + 'success))))))))) + zfs-ui--row-actions) + (apply + #'vui-vstack + :spacing 1 + (append + (list + (vui-heading-3 "Backup targets") + (vui-muted (format "Stored as plain elisp data in %s — edit by hand or here." zfs-targets-file))) + (if targets + (list (apply + #'vui-vstack + :spacing 0 + (mapcar (lambda (target) + (vui-hstack + :spacing 2 + (vui-box (vui-text (plist-get target :name)) :width 16) + (vui-box (vui-text (or (plist-get target :ssh) "this machine") :face 'shadow) :width 24) + (vui-box (vui-text (plist-get target :dataset) :face 'shadow) :width 28) + (vui-button "Delete" :face 'error + :on-click + (lambda () + (when (yes-or-no-p (format "Delete target %s? " (plist-get target :name))) + (let ((updated (seq-remove (lambda (other) (equal other target)) targets))) + (zfs-ui--targets-save updated) + (vui-set-state :targets updated) + (vui-set-state :message (cons "Target deleted" 'success)))))))) + targets))) + (list (vui-muted "No targets yet — add one below."))) + (list + (vui-vstack + :spacing 1 + (vui-heading-3 "Add target") + (zfs-ui--form-row "Name" (vui-field :size 24 :key "target-name" :placeholder "interserver")) + (zfs-ui--form-row "SSH" (vui-field :size 24 :key "target-ssh" :placeholder "user@host — empty = this machine")) + (zfs-ui--form-row "Dataset prefix" (vui-field :size 24 :key "target-prefix" :placeholder "backuppool/mainframe") + "must exist on the target; the dataset's leaf name is appended") + (vui-hstack + (vui-box (vui-text "") :width 14) + (vui-button "Save target" + :on-click (lambda () + (when-let* ((actions (cdr (assoc 'page zfs-ui--row-actions))) + (fn (plist-get actions :add))) + (funcall fn)))))))))) + +(vui-defcomponent zfs-app () + :state ((page 'overview) + (page-arg nil) + (host nil) + (pools nil) + (datasets nil) + (snaps nil) + (locked nil) + (targets (zfs-ui--targets-load)) + (loading t) + (message nil) + (refreshed nil) + (backup-target nil) + (backup-preview nil) + (backup-progress nil) + (backup-done nil) + (create-status nil) + (format-disk nil) + (format-status nil)) + :render + (progn + (vui-use-effect () + (zfs-ui--refresh host) + nil) + (setq zfs-ui--row-actions nil) + (setq zfs-ui--refresh-fn (vui-with-async-context (zfs-ui--refresh host))) + (push (cons 'nav + (list :back (vui-with-async-context + (if (eq page 'overview) + (bury-buffer) + (zfs-ui--go 'overview))))) + zfs-ui--row-actions) + (let ((content + (cond + (loading (vui-text "Loading…" :face 'shadow)) + ((eq page 'overview) + (if pools + (zfs-ui--page-overview pools datasets snaps locked) + (vui-vstack :spacing 1 + (vui-heading-3 "No pools found") + (vui-muted "ZFS returned no pools. Kernel module loaded, pools imported?")))) + ((eq page 'dataset) (zfs-ui--page-dataset page-arg host datasets snaps)) + ((eq page 'pool) (zfs-ui--page-pool page-arg host)) + ((eq page 'create) (zfs-ui--page-create page-arg host create-status)) + ((eq page 'backup) (zfs-ui--page-backup page-arg host datasets snaps targets + backup-target backup-preview + backup-progress backup-done)) + ((eq page 'new-pool) (zfs-ui--page-format format-disk format-status)) + ((eq page 'targets) (zfs-ui--page-targets targets)) + (t (vui-text "unknown page" :face 'error))))) + (vui-vstack + :spacing 1 + (vui-flex :width 'window :justify :space-between + (vui-hstack :spacing 2 + (vui-heading-2 "ZFS") + (vui-text (cond + ((eq page 'overview) (if host (format "on %s" (plist-get host :name)) "on this machine")) + (t (format "› %s" (if (symbolp page) (symbol-name page) page)))) + :face 'shadow)) + (vui-text (format "%s pools · refreshed %s" (length pools) (or refreshed "—")) :face 'shadow)) + (if message + (vui-text (car message) :face (cdr message)) + (vui-text " ")) + content + (vui-text (pcase page + ('overview "RET open · u unlock · F format disk · T targets · g refresh · q quit") + ('dataset "q back · s snapshot · b backup · c new dataset · d diff · r rollback · D destroy · g refresh") + ('pool "q back · 1 scrub start · 2 scrub stop · x export · g refresh") + ('backup "q back · click a target · g refresh") + (_ "q back · g refresh")) + :face 'shadow))))) + +(defun zfs-ui--key-on-line () + (save-excursion + (beginning-of-line) + (let ((end (line-end-position)) + (found nil)) + (while (and (<= (point) end) (not found)) + (setq found (vui-key-at)) + (forward-char 1)) + found))) + +(defun zfs-ui--invoke (action) + (let* ((key (zfs-ui--key-on-line)) + (row (and key (cdr (assoc key zfs-ui--row-actions)))) + (page (cdr (assoc 'page zfs-ui--row-actions)))) + (cond + ((plist-get row action) (funcall (plist-get row action))) + ((and (eq action :open) (plist-get row :open)) (funcall (plist-get row :open))) + ((plist-get page action) (funcall (plist-get page action))) + (t (message "Nothing here for that key"))))) + +(define-derived-mode zfs-mode vui-mode "ZFS" + (hl-line-mode 1)) + +(define-key zfs-mode-map (kbd "q") (lambda () (interactive) (zfs-ui--invoke :back))) +(define-key zfs-mode-map (kbd "g") (lambda () (interactive) (when zfs-ui--refresh-fn (funcall zfs-ui--refresh-fn)))) +(define-key zfs-mode-map (kbd "s") (lambda () (interactive) (zfs-ui--invoke :snapshot))) +(define-key zfs-mode-map (kbd "b") (lambda () (interactive) (zfs-ui--invoke :backup))) +(define-key zfs-mode-map (kbd "c") (lambda () (interactive) (zfs-ui--invoke :create-child))) +(define-key zfs-mode-map (kbd "d") (lambda () (interactive) (zfs-ui--invoke :diff))) +(define-key zfs-mode-map (kbd "r") (lambda () (interactive) (zfs-ui--invoke :rollback))) +(define-key zfs-mode-map (kbd "D") (lambda () (interactive) (zfs-ui--invoke :destroy))) +(define-key zfs-mode-map (kbd "m") (lambda () (interactive) (zfs-ui--invoke :mount))) +(define-key zfs-mode-map (kbd "u") (lambda () (interactive) (zfs-ui--invoke :unlock))) +(define-key zfs-mode-map (kbd "i") (lambda () (interactive) (zfs-ui--invoke :import))) +(define-key zfs-mode-map (kbd "L") (lambda () (interactive) (zfs-ui--invoke :lock))) +(define-key zfs-mode-map (kbd "F") (lambda () (interactive) (zfs-ui--invoke :format))) +(define-key zfs-mode-map (kbd "T") (lambda () (interactive) (zfs-ui--invoke :targets))) +(define-key zfs-mode-map (kbd "1") (lambda () (interactive) (zfs-ui--invoke :scrub-start))) +(define-key zfs-mode-map (kbd "2") (lambda () (interactive) (zfs-ui--invoke :scrub-stop))) +(define-key zfs-mode-map (kbd "x") (lambda () (interactive) (zfs-ui--invoke :export))) + +;;;###autoload +(defun zfs () + (interactive) + (let ((buffer (get-buffer-create zfs-buffer-name))) + (with-current-buffer buffer + (unless (eq major-mode 'zfs-mode) + (zfs-mode) + (vui-mount (vui-component 'zfs-app) buffer) + (vui-rerender-on-resize))) + (pop-to-buffer buffer))) + +(provide 'zfs) +;;; zfs.el ends here |