Polish erase-home-darlings.clj

This commit is contained in:
Madeleine Sydney
2024-12-12 13:59:43 -07:00
parent 0350752a50
commit 684e78e936
6 changed files with 243 additions and 138 deletions

View File

@@ -35,14 +35,14 @@
let modules = list-nix-directory ./modules/nixos;
in { ... }: {
imports =
let x = builtins.map (m: ./modules/nixos/${m}) modules;
in x;
builtins.map (m: ./modules/nixos/${m}) modules;
};
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"

View File

@@ -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)

View File

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

View File

@@ -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))

View File

@@ -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,7 +49,8 @@ in {
zfs
];
boot.initrd.systemd.services.erase-darlings = {
boot.initrd.systemd.services.erase-darlings =
let service = {
description = "Rollback filesystem to a blank state on boot";
wantedBy = [
"initrd.target"
@@ -57,6 +73,30 @@ in {
&& 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 = [
"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}" -n "${toString cfg.archiveLimit}" --dataset "${cfg.dataset}" --rollback-to "${cfg.rollbackTo}"'';
};
stopIfChanged = false;
restartIfChanged = false;
};
environment.persistence."/persist" = {
directories = cfg.directories;

View File

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