From 28b2aece65fa69d16a12ec25ef9dd8042e435e9e Mon Sep 17 00:00:00 2001
From: Madeleine Sydney <lomiskiam@gmail.com>
Date: Wed, 11 Dec 2024 19:22:16 -0700
Subject: [PATCH] rewrite erase-home-darlings service in clojure

---
 README.org                                  | 42 ++---------
 hosts/nixos-testbed/erase-home-darlings.clj | 84 +++++++++++++++++++++
 2 files changed, 89 insertions(+), 37 deletions(-)
 create mode 100644 hosts/nixos-testbed/erase-home-darlings.clj

diff --git a/README.org b/README.org
index 9fdf3fb..9f81b2c 100644
--- a/README.org
+++ b/README.org
@@ -129,8 +129,7 @@ builtins.mapAttrs mkHost (builtins.readDir ./hosts)
   boot.initrd.systemd.initrdBin = with pkgs; [
     zfs
     coreutils
-    gnugrep
-    gawk
+    babashka
   ];
 
   boot.initrd.systemd.services.erase-darlings = {
@@ -168,48 +167,17 @@ builtins.mapAttrs mkHost (builtins.readDir ./hosts)
     after = [
       "home.mount"
     ];
-    path = [ pkgs.zfs pkgs.coreutils pkgs.gnugrep pkgs.gawk pkgs.util-linux ];
+    path = [ pkgs.zfs pkgs.babashka ];
     # unitConfig.DefaultDependencies = "no";
     serviceConfig = {
       Type = "oneshot";
       RemainAfterExit = true;
+      ExecStart =
+        let script = ./erase-home-darlings.clj;
+        in ''${pkgs.babashka}/bin/bb "${script}" 3'';
     };
     stopIfChanged = false;
     restartIfChanged = false;
-    script = /* bash */ ''
-      set -xe
-      set -o pipefail
-
-      command -v findmnt || echo "can't find findmnt on PATH"
-      command -v awk || echo "can't find awk on PATH"
-
-      # findmnt -no TARGET rpool/darlings/persist
-      PREVDIR=$(findmnt -no TARGET rpool/darlings/persist)/previous
-      # PREVDIR=/sysroot/persist/previous
-
-      echo "PREVDIR=$PREVDIR"
-      mkdir -p $PREVDIR/home
-
-      [ -e $PREVDIR/home/3 ] && rm -rf $PREVDIR/home/3
-      [ -e $PREVDIR/home/2 ] && mv $PREVDIR/home/2 $PREVDIR/home/3
-      [ -e $PREVDIR/home/1 ] && mv $PREVDIR/home/1 $PREVDIR/home/2
-
-      DIFFFILE="$(mktemp "erase-home-darlings-zfs-diff-XXXXXX")"
-
-      zfs diff -HF rpool/local/home@blank rpool/local/home \
-          > "$DIFFFILE"
-      awk '{if ($2 == "F" || $2 == "/") print $3}' < "$DIFFFILE" \
-        | while read -r line; do
-            DEST="$PREVDIR/home/1/$(dirname "$line")/$(basename "$line")"
-            mkdir -p "$(dirname "$DEST")"
-            mv "$line" "$DEST" && \
-              echo "$line -> $DEST"
-          done \
-          && echo ">> previous home backed up to $PREVDIR/home/1 <<"
-
-      zfs rollback -r rpool/local/home@blank \
-        && echo ">> home rolled back <<"
-    '';
   };
 
   # boot.loader.grub = {
diff --git a/hosts/nixos-testbed/erase-home-darlings.clj b/hosts/nixos-testbed/erase-home-darlings.clj
new file mode 100644
index 0000000..a146963
--- /dev/null
+++ b/hosts/nixos-testbed/erase-home-darlings.clj
@@ -0,0 +1,84 @@
+#!/usr/bin/env bb
+
+;;; TODO: option to either move OR copy
+
+(require '[clojure.core.match :refer [match]]
+         '[babashka.cli :as cli]
+         '[babashka.process :refer [$ check] :as p])
+
+(defn get-archive-path []
+  (fs/path
+   "/persist/previous"))
+
+(defn get-files []
+  (let [diff (:out (check ($ {:out :string}
+                             "zfs" "diff" "-HF"
+                             "rpool/local/home@blank"
+                             "rpool/local/home")))]
+    ;; 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. }:<
+  (loop [n 0]
+    (let [file' (format "%s-%d" file n)]
+      (if (fs/exists? file')
+        (recur (inc n))
+        (do (fs/move file file')
+            file')))))
+
+(defn archive-files [archive-path files]
+  (let [new-archive (fs/path archive-path "home/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)))))
+
+(defn cycle-archives [archive-path n]
+  "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 #(fs/path archive-path "home" (str %))]
+    (fs/delete-if-exists (gp n))
+    (doseq [i (range (dec n) 1 -1)]
+      (when (fs/exists? (gp (dec i)))
+        (fs/move (gp (dec i)) (gp i))))
+    (when (fs/exists? (gp "new-archive"))
+      (fs/move (gp "new-archive") (gp 1)))))
+
+(defn do-rollback []
+  (let [proc (deref ($ "zfs" "rollback" "-r" "rpool/local/home@blank"))]
+    (if (= (:exit proc) 0)
+      (println (str "Successfully rolled back /home.  "
+                    "Enjoy the fresh filesystem smell!  }:D"))
+      (println "Something went wrong rolling back /home... D:{"))))
+
+(defn -main []
+  (let [n (if (< 0 (count *command-line-args*))
+            (parse-long (first *command-line-args*))
+            3)]
+    (binding [p/*defaults*
+              {:pre-start-fn #(println (str "+ " (str/join (:cmd %))))}]
+      (let [archive-path (get-archive-path)
+            files (get-files)]
+        (archive-files archive-path files)
+        (cycle-archives archive-path n)
+        (do-rollback)))))
+
+(-main)