Polish erase-home-darlings.clj

README.org

@@ -35,14 +35,14 @@
         let modules = list-nix-directory ./modules/nixos;
         in { ... }: {
           imports =
-            let x = builtins.map (m: ./modules/nixos/${m}) modules;
+            builtins.map (m: ./modules/nixos/${m}) modules;
-                in x;
         };
 
       homeManagerModules.default =
         let modules = list-nix-directory ./modules/home;
         in { ... }: {
-          imports = builtins.map (m: ./modules/home/${m}) modules;
+          imports =
+            builtins.map (m: ./modules/home/${m}) modules;
         };
 
       nixosConfigurations = (
@@ -51,7 +51,19 @@
 
       homeConfigurations =
         let users = builtins.readDir ./users;
-            mkUser = username: _v: import ./users/${username}/default.nix;
+            mkUser = username: _v: {
+              imports = [
+                (import ./users/${username}).home
+
+                inputs.self.homeManagerModules.default
+
+                ({ lib, ... }: {
+                  home.username = username;
+                })
+
+                inputs.impermanence.homeManagerModules.impermanence
+              ];
+            };
         in
           builtins.mapAttrs mkUser users;
     };
@@ -87,6 +99,8 @@ let mkHost = k: v: nixpkgs.lib.nixosSystem {
             lib.filterAttrs
               (k: _v: builtins.elem k config.sydnix.users.users)
               self.homeConfigurations;
+
+          home-manager.extraSpecialArgs = inputs // { inherit self; };
         })
       ];
     };
@@ -113,6 +127,9 @@ builtins.mapAttrs mkHost (builtins.readDir ./hosts)
         # reassigned on reboot.
         "/var/lib/nixos"
       ];
+      rollbackTo = "blank";
+      dataset = "rpool/local/home";
+      archiveLimit = 3;
     };
     users.users = [
       "crumb"

modules/home/erase-home-darlings.clj

@@ -1,84 +0,0 @@
-#!/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)

modules/home/impermanence.nix

@@ -14,45 +14,24 @@ in {
       };
 
       directories = mkOption {
-        description = "";
+        # type = with types;
-        type = with types;
+        #   listOf (coercedTo str (d: { directory = d; }) userDir);
-          listOf (coercedTo str (d: { directory = d; }) userDir);
         default = [];
       };
 
       files = mkOption {
-        description = "";
+        # type = with types;
-        type = with types;
+        #   listOf (coercedTo str (f: { file = f; }) userFile);
-          listOf (coercedTo str (f: { file = f; }) userFile);
         default = [];
       };
     };
   };
 
   config = mkIf cfg.enable {
-    systemd.services.erase-home-darlings =
+    home.persistence."/persist/home/${config.home.username}" = {
-      let service = {
+      allowOther = true;
-            description = "Rollback home to a blank state on boot";
+      directories = cfg.directories;
-            wantedBy = [
+      files = cfg.files;
-              "multi-user.target"
+    };
-            ];
-            after = [
-              "home.mount"
-            ];
-            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;
-          };
-      in if config.boot.initrd.systemd.enable
-         then service
-         else throw "sydnix.impermanence currently requires config.boot.initrd.systemd.enable'!";
   };
 }

modules/nixos/erase-home-darlings.clj

@@ -0,0 +1,147 @@
+#!/usr/bin/env bb
+
+;;; TODO: rewrite with fewer assumptions about the filesystem structure.
+
+;;; TODO: option to either move OR copy
+
+(require '[clojure.core.match :refer [match]]
+         '[babashka.cli :as cli]
+         '[clojure.pprint :as pp]
+         '[babashka.process :refer [shell check process] :as p])
+
+(defn get-files [{:keys [rollback-to dataset]}]
+  ;; (prn rollback-to)
+  ;; (prn 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
+    (let [files (get-files opts)]
+      (archive-files opts files)
+      (cycle-archives opts)
+      (do-rollback opts))))
+
+(-main (cli/parse-opts *command-line-args* cli-spec))

modules/nixos/impermanence.nix

@@ -26,6 +26,21 @@ in {
         type = with types; listOf anything;
         default = [];
       };
+
+      rollbackTo = mkOption {
+        type = types.str;
+      };
+      archiveTo = mkOption {
+        type = types.str;
+        default = "/persist/previous/home";
+      };
+      dataset = mkOption {
+        type = types.str;
+      };
+      archiveLimit = mkOption {
+        type = types.ints.positive;
+        default = 3;
+      };
     };
   };
 
@@ -34,33 +49,58 @@ in {
       zfs
     ];
 
-    boot.initrd.systemd.services.erase-darlings = {
+    boot.initrd.systemd.services.erase-darlings =
-      description = "Rollback filesystem to a blank state on boot";
+      let service = {
+            description = "Rollback filesystem to a blank state on boot";
+            wantedBy = [
+              "initrd.target"
+            ];
+            after = [
+              # "zfs-import.service"
+              "zfs-import-rpool.service"
+            ];
+            before = [
+              "sysroot.mount"
+            ];
+            path = [ pkgs.zfs ];
+            unitConfig.DefaultDependencies = "no";
+            serviceConfig = {
+              Type = "oneshot";
+              RemainAfterExit = true;
+            };
+            script = /* bash */ ''
+              zfs rollback -r rpool/local/root@blank \
+                && echo ">> >> rollback complete << <<"
+            '';
+          };
+      in if config.boot.initrd.systemd.enable
+         then service
+         else throw "sydnix.impermanence currently requires config.boot.initrd.systemd.enable'!";
+
+    systemd.services.erase-home-darlings = {
+      description = "Rollback home to a blank state on boot";
       wantedBy = [
-        "initrd.target"
+        "multi-user.target"
       ];
       after = [
-        # "zfs-import.service"
+        "home.mount"
-        "zfs-import-rpool.service"
       ];
-      before = [
+      path = [ pkgs.zfs pkgs.babashka ];
-        "sysroot.mount"
+      # unitConfig.DefaultDependencies = "no";
-      ];
-      path = [ pkgs.zfs ];
-      unitConfig.DefaultDependencies = "no";
       serviceConfig = {
         Type = "oneshot";
         RemainAfterExit = true;
+        ExecStart =
+          let script = ./erase-home-darlings.clj;
+          in ''${pkgs.babashka}/bin/bb "${script}" -n "${toString cfg.archiveLimit}" --dataset "${cfg.dataset}" --rollback-to "${cfg.rollbackTo}"'';
       };
-      script = /* bash */ ''
+      stopIfChanged = false;
-      zfs rollback -r rpool/local/root@blank \
+      restartIfChanged = false;
-        && echo ">> >> rollback complete << <<"
-    '';
     };
 
     environment.persistence."/persist" = {
-        directories = cfg.directories;
+      directories = cfg.directories;
-        files = cfg.files;
+      files = cfg.files;
     };
   };
 }

users/crumb/default.nix

@@ -1,6 +1,12 @@
-{ config, lib, pkgs, ... }:
-
 {
-  home.stateVersion = "18.09";
+  home = { config, lib, pkgs, ... }: {
-  home.packages = [ pkgs.hello ];
+    sydnix.impermanence = {
+      enable = true;
+    };
+
+    home = {
+      stateVersion = "18.09";
+      packages = [ pkgs.hello ];
+    };
+  };
 }