168 lines
6.1 KiB
Clojure
Executable File
168 lines
6.1 KiB
Clojure
Executable File
#!/usr/bin/env bb
|
|
|
|
;; TODO: rewrite with fewer assumptions about the filesystem structure. Perhaps
|
|
;; we can achieve near-atomicity by doing to bulk of the work with a function
|
|
;; `erase-home-darlings : FileSystem -> Maybe FileSystem`, which will not do any
|
|
;; IO.
|
|
|
|
;; TODO: option to either move OR copy
|
|
|
|
(require '[clojure.core.match :refer [match]]
|
|
'[babashka.cli :as cli]
|
|
'[clojure.pprint :as pp]
|
|
'[clojure.tools.logging :as l]
|
|
'[babashka.process :refer [shell check process] :as p])
|
|
|
|
(defn get-files [{:keys [rollback-to dataset]}]
|
|
(let [snapshot (str dataset "@" rollback-to)
|
|
diff (:out (shell {:out :string}
|
|
"zfs diff -HF"
|
|
snapshot
|
|
dataset))]
|
|
;; See zfs-diff(8) to understand what we're parsing here.
|
|
(->> diff
|
|
str/split-lines
|
|
(map #(str/split % #"\s"))
|
|
(filter #(and
|
|
;; We only care to preserve /new/ content.
|
|
(contains? #{"+" "M"} (first %))
|
|
;; We only bother with plain old files. No directories,
|
|
;; symlinks, etc.
|
|
(= (second %) "F")))
|
|
(map #(nth % 2)))))
|
|
|
|
(defn move-out-of-my-way [file]
|
|
;; No TCO. }:<
|
|
(let [maximum-attempts 50]
|
|
(loop [n 0]
|
|
(let [file' (format "%s-%d" file n)]
|
|
(if (fs/exists? file')
|
|
(do (printf (str "Failed to rename `%s' to `%s', "
|
|
"because the latter already exists.\n")
|
|
file file')
|
|
(if (< n maximum-attempts)
|
|
(recur (inc n))
|
|
(do (printf (str "We've tried to rename `%s' %d "
|
|
"without success. This should "
|
|
"never happen! Abort!")
|
|
file (inc n))
|
|
(System/exit 127))))
|
|
(do (fs/move file file')
|
|
file'))))))
|
|
|
|
(defn archive-files [{:keys [archive-to]} files]
|
|
(let [new-archive (fs/path archive-to "new-archive")]
|
|
(when (fs/exists? new-archive)
|
|
(println "Warning: `new-archive' already exists... we'll rename it for you?")
|
|
(move-out-of-my-way new-archive))
|
|
(doseq [file files]
|
|
(let [destination (fs/path
|
|
new-archive
|
|
(fs/relativize "/home" (fs/parent file)))]
|
|
(fs/create-dirs destination)
|
|
(fs/move file destination)))))
|
|
|
|
;; FIXME: This code could be a lot easier on the eyes. }:\
|
|
(defn cycle-archives [{:keys [archive-to archive-limit]}]
|
|
"Delete the oldest archive path, and increment each previous path by one.
|
|
More precisely,
|
|
- Delete the archive path labeled `n` (the oldest allowed).
|
|
- For each remaining path labeled 'i', relabel to 'i + 1'.
|
|
- Lastly, we delete the path labeled `new-archive`, if it exists."
|
|
(let [gp (memoize #(fs/path archive-to (str %)))]
|
|
(when (fs/exists? (gp archive-limit))
|
|
(fs/delete-tree (gp archive-limit)))
|
|
(doseq [i (range (dec archive-limit) 0 -1)]
|
|
(when (fs/exists? (gp i))
|
|
(fs/move (gp i) (gp (inc i)))))
|
|
(when (fs/exists? (gp "new-archive"))
|
|
(fs/move (gp "new-archive") (gp 1)))))
|
|
|
|
(defn do-rollback [{:keys [dataset rollback-to]}]
|
|
(let [proc (shell "zfs" "rollback" "-r" (str dataset "@" rollback-to))]
|
|
(if (= (:exit proc) 0)
|
|
(println (str "Successfully rolled back /home. "
|
|
"Enjoy that fresh filesystem smell! }:D"))
|
|
(println "Something went wrong rolling back /home... D:{"))))
|
|
|
|
(def zfs-dataset?
|
|
;; We memoise an anonymous procedure because we want the command to be run on
|
|
;; the first invocation of `zfs-dataset?`, *not* when this file's top-level is
|
|
;; first evaluated. Naïvely, it's reasonable to think we should instead do
|
|
;; something like
|
|
;; (def zfs-dataset?
|
|
;; (let [datasets <call zfs list>]
|
|
;; (fn [x] (contains? datasets x))))
|
|
;; but that would call zfs (and potentially throw) far too early to make sense.
|
|
(let [get-datasets (memoize
|
|
(fn []
|
|
(->> (:out (shell {:out :string} "ls" "-la"))
|
|
str/split-lines
|
|
(map #(first (str/split % #"\s")))
|
|
set)))]
|
|
(fn [x]
|
|
(contains? (get-datasets) x))))
|
|
|
|
(def cli-spec
|
|
{:spec
|
|
{:archive-limit {:coerce :int
|
|
:alias :n
|
|
:validate #(pos? %)
|
|
:default 3
|
|
:desc "Number of archives to save at a time."}
|
|
:dataset {:coerce :string
|
|
;; :validate zfs-dataset?
|
|
:require true
|
|
:desc "Dataset to be archived and rolled back."}
|
|
:rollback-to {:coerce :string
|
|
;; TODO: Validate snapshot.
|
|
:require true
|
|
:desc "Snapshot to rollback to."}
|
|
:archive-to {:coerce :string
|
|
:default "/persist/previous/home"
|
|
:desc "The path under which archives will be stored."}
|
|
:error-fn
|
|
(fn [{:keys [spec type cause msg option] :as data}]
|
|
(when (= :org.babashka/cli type)
|
|
(case cause
|
|
:require
|
|
(println
|
|
(format "Missing required argument: %s\n" option))))
|
|
(System/exit 1))}})
|
|
|
|
(defmacro with-echoed-shell-commands [& body]
|
|
(let [print-cmd #(println (str "+ " (str/join (:cmd %))))]
|
|
`(binding [p/*defaults* {:pre-start-fn ~print-cmd}]
|
|
~@body)))
|
|
|
|
(defmacro with-echoed-shell-commands [& body]
|
|
`(do ~@body))
|
|
|
|
(defn -main [opts]
|
|
(pp/pprint opts)
|
|
(with-echoed-shell-commands
|
|
(shell "mount" (:dataset opts) "/home")
|
|
(let [files (get-files opts)]
|
|
(archive-files opts files)
|
|
(cycle-archives opts)
|
|
(do-rollback opts))))
|
|
|
|
#_
|
|
(def fs-ops
|
|
{:zfs {:get-files zfs-get-files
|
|
:rollback zfs-rollback}})
|
|
|
|
#_
|
|
(defn -main [opts]
|
|
(let [test-bin (fn [x]
|
|
(printf "%s: %s\n"
|
|
x (map str (fs/which-all x))))]
|
|
(test-bin "mount")
|
|
(test-bin "findmnt")
|
|
(test-bin "zfs"))
|
|
|
|
(shell "mount")
|
|
(shell "ls -la /home"))
|
|
|
|
(-main (cli/parse-opts *command-line-args* cli-spec))
|