commit 8db7f2f182028f85b475eb3d211ce3dc635638b0 from: mtmn date: Mon Sep 14 23:53:41 2026 UTC add sursum commit - dd8f2033e5ebf2237b990d491d2f316f5f46334c commit + 8db7f2f182028f85b475eb3d211ce3dc635638b0 blob - f4aabcc6d1a6e8e53d41d199755d345992318a87 blob + 2ea74eb829c8b5510f80b2003f1fb0574c108010 --- README.md +++ README.md @@ -1,5 +1,5 @@ # tools -[![builds.sr.ht status](https://builds.sr.ht/~mtmn/tools.svg)](https://builds.sr.ht/~mtmn/tools?) +[![builds.sr.ht status](https://builds.sr.ht/~mtmn/tools.svg)](https://builds.sr.ht/~mtmn/tools) Various tools I have been using throughout the years. @@ -22,6 +22,7 @@ Various tools I have been using throughout the years. | [plants](plants/) | bluetooth battery monitoring for linux | | [reflink-snap](reflink-snap/) | reflink (copy-on-write) snapshot manager for XFS | | [kundali](kundali/) | scans track metadata and builds a sequence around an anchor track | +| [sursum](sursum/) | backup helper for git, tarsnap, plakar and rclone | ## Toolchains @@ -31,12 +32,13 @@ Various tools I have been using throughout the years. | Zig | 0.16.0 | `build.zig.zon` (`minimum_zig_version`) | | Python | 3.14 | system | | Go | 1.26 | `go.mod` | -| Ruby | >= 3.0 | `hue.gemspec` (`required_ruby_version`); reflink-snap uses stdlib only | +| Ruby | >= 3.0 | `hue.gemspec` (`required_ruby_version`). reflink-snap uses stdlib only | +| Janet | 1.41.2 | system | ## Building -Install [redo](http://news.dieweltistgarnichtso.net/bin/redo-sh.html) -and the native toolchains; redo orchestrates `cargo`, `zig build`, `go build`, +Install [knit](https://github.com/zyedidia/knit) +and the native toolchains. Knit orchestrates `cargo`, `zig build`, `go build`, `cc`, and a shared Python virtualenv. All common tasks are available via `just`: @@ -61,7 +63,7 @@ The equivalent convenience wrapper is `just deploy $output chmod +x $output +$ bin/sursum: sursum/sursum + cp sursum/sursum $output + chmod +x $output + $ all:VB: $bins $ deploy-dir:VB: blob - /dev/null blob + 12a4d85a5075761bc2d335ec7eb06c7cf3972c03 (mode 644) --- /dev/null +++ sursum/README.md @@ -0,0 +1,41 @@ +# sursum + +Backup helper for git, tarsnap, plakar and rclone. One command commits, +archives or syncs a named set of directories. + +Needs `janet` plus whichever backends you use. + +## Config + +Targets live in `~/.config/sursum/config.janet`. One Janet table. Paths may use `~/` and `$VAR`. +See `config.example.janet`. + +Omit rclone `:targets` to reuse the plakar sources. Set `{}` to +disable rclone. Plakar stores and sources stay in plakar's own files. + +## Usage + +```sh +sursum -l # list targets +sursum git:notes # commit, no push +sursum -p git:notes # commit, pull, push +sursum tarsnap:notes # timestamped archive +sursum plakar:hoo # back up every source to hoo +sursum 'plakar:hoo:src,notes' # back up two sources +sursum rclone:notes # copy to backup:notes +sursum git -e notes # all git targets except notes +``` + +One target per run. No target lists and exits. + +## Options + +- `-p`, `--push`: commit, pull, push git targets +- `-f`, `--fetch`: pull git targets first +- `-q`, `--quiet`: hide child output +- `-l`, `--list`: list targets +- `-e`, `--exclude`: names to skip +- `-h`, `--help`: usage + +Failing targets get reported. The rest still run. Exit code is +nonzero if anything failed. blob - /dev/null blob + 8b81622957fd4c9a0a779cf224765b643367145c (mode 644) --- /dev/null +++ sursum/config.example.janet @@ -0,0 +1,14 @@ +# ~/.config/sursum/config.janet +{:git {:targets {"notes" "~/notes" + "pass" "~/.password-store"}} + + :tarsnap {:targets {"notes" "~/notes"}} + + :rclone {:remote "backup" + :transfers 4 + :checkers 8 + :checksum true + :extra-args [] + :targets {"notes" "~/notes"}} + + :plakar {}} blob - /dev/null blob + 55f66c6fb3f65e5726380f3976f6a6ac57d07544 (mode 755) --- /dev/null +++ sursum/sursum @@ -0,0 +1,710 @@ +#!/usr/bin/env janet + +(var failures @[]) +(var current-proc nil) + +(try + (do + (defn- on-signal [proc] + (when proc + (try (os/proc-kill proc) ([_] nil)))) + (os/sigaction :int (fn [&] (on-signal current-proc) (os/exit 130))) + (os/sigaction :term (fn [&] (on-signal current-proc) (os/exit 143)))) + ([_] nil)) + +(var- tz-cache nil) +(defn- tz [] + (when (nil? tz-cache) + (set tz-cache + (try + (do + (def p (os/spawn ["date" "+%z"] :p {:out :pipe :err :pipe})) + (def out (ev/read (p :out) :all)) + (os/proc-wait p) + (os/proc-close p) + (string/trim (string (or out "")))) + ([_] "")))) + tz-cache) + +(defn- ts [] + (string (os/strftime "%Y-%m-%dT%H:%M:%S" nil false) (tz))) + +(defn- log [msg] + (print (string "[" (ts) "]: " msg)) + (file/flush stdout)) + +(defn- err [msg] + (eprint (string "[" (ts) "]: " msg)) + (file/flush stderr)) + +(defn- fatal [msg] + (err msg) + (os/exit 1)) + +(defn- record-failure [msg] + (array/push failures msg) + (err (string "ERROR: " msg))) + +(defn- check [msg res] + (if (res :ok) true + (do + (def detail (string/trim (string (or (res :err) "")))) + (record-failure (if (= detail "") msg (string msg ": " detail))) + false))) + + +(def home (or (os/getenv "HOME") (fatal "HOME not set"))) + +(def default-config-path + (string (or (os/getenv "XDG_CONFIG_HOME") (string home "/.config")) + "/sursum/config.janet")) +(def config-path default-config-path) + +(defn- cfg-key [t k] + (or (get t k) (get t (keyword (string k))))) + +(defn- fatal-config [msg] + (fatal (string config-path ": " msg))) + +(defn- var-char? [c] + (or (and (>= c 48) (<= c 57)) + (and (>= c 65) (<= c 90)) + (= c 95) + (and (>= c 97) (<= c 122)))) + +(defn- expand-env [s] + (def buf @"") + (var i 0) + (def n (length s)) + (while (< i n) + (def c (s i)) + (if (= c 36) + (cond + (and (< (+ i 1) n) (= (s (+ i 1)) 123)) + (do + (def j (string/find "}" s (+ i 2))) + (unless j (fatal-config (string "unclosed ${ in path: " s))) + (def vname (string/slice s (+ i 2) j)) + (when (empty? vname) (fatal-config (string "empty ${} in path: " s))) + (def val (os/getenv vname)) + (unless val (fatal-config (string "unknown env var $" vname " in path: " s))) + (buffer/push-string buf val) + (set i (+ j 1))) + (let [j (do (var k (+ i 1)) + (while (and (< k n) (var-char? (s k))) (++ k)) + k)] + (if (= j (+ i 1)) + (do (buffer/push-string buf "$") (set i (+ i 1))) + (do + (def vname (string/slice s (+ i 1) j)) + (def val (os/getenv vname)) + (unless val (fatal-config (string "unknown env var $" vname " in path: " s))) + (buffer/push-string buf val) + (set i j))))) + (do (buffer/push-byte buf c) (++ i)))) + (string buf)) + +(defn- expand-path [raw what] + (unless (string? raw) + (fatal-config (string what " must be a string, got: " (string/format "%p" raw)))) + (def t (string/trim raw)) + (when (empty? t) + (fatal-config (string what " must not be empty"))) + (def home-expanded + (if (or (= t "~") (string/has-prefix? "~/" t)) + (string home (string/slice t 1)) + t)) + (def full (expand-env home-expanded)) + (unless (string/has-prefix? "/" full) + (fatal-config (string what " must be absolute after expansion: " raw))) + full) + +(defn- check-name [raw backend] + (unless (string? raw) + (fatal (string "Invalid " backend " target name (not a string): " (string/format "%p" raw)))) + (def n (string/trim raw)) + (when (empty? n) + (fatal (string "Invalid " backend " target name: empty"))) + (when (not= n raw) + (fatal (string "Invalid " backend " target name with outer whitespace: '" raw "'"))) + (each sep [":" ","] + (when (string/find sep n) + (fatal (string "Invalid " backend " target name '" n "': must not contain '" sep "'")))) + n) + +(defn- strict-keys [section where allowed] + (each k (keys section) + (unless (find |(= (string $) (string k)) allowed) + (fatal-config (string where ": unknown key :" (string k) + " (want " (string/join allowed ", ") ")"))))) + +(defn- load-targets [section backend] + (def out @{}) + (when (nil? section) (break out)) + (unless (or (table? section) (struct? section)) + (fatal-config (string ":" backend " must be a table"))) + (def has-targets (not (nil? (cfg-key section :targets)))) + (when has-targets + (strict-keys section (string ":" backend) ["targets"])) + (def targets (or (cfg-key section :targets) section)) + (unless (or (table? targets) (struct? targets)) + (fatal-config (string ":" backend ":targets must be a table of name to dir"))) + (eachp [k v] targets + (def n (check-name (string k) backend)) + (when (get out n) + (fatal-config (string "duplicate " backend " target: '" n "'"))) + (put out n (expand-path v (string backend "/" n)))) + out) + +(defn- load-config [path] + (unless (os/stat path) + (fatal (string "Missing config file: " path))) + (def text + (try (slurp path) + ([e] (fatal (string "Failed to read " path ": " e))))) + (when (or (nil? text) (empty? (string/trim (string text)))) + (fatal (string "Empty config file: " path))) + (def data + (try (parse (string text)) + ([e] (fatal (string "Failed to parse " path ": " e))))) + (unless (or (table? data) (struct? data)) + (fatal (string "Bad config " path ": top level must be a table, see config.example.janet"))) + (each k (keys data) + (def ks (string k)) + (unless (or (= ks "git") (= ks "tarsnap") (= ks "rclone") (= ks "plakar")) + (fatal-config (string "unknown section :" ks " (want git, tarsnap, rclone, plakar)")))) + data) + +(def config (load-config config-path)) + +(def git-dirs (load-targets (cfg-key config :git) "git")) +(def tarsnap-dirs (load-targets (cfg-key config :tarsnap) "tarsnap")) + +(def rclone-section (or (cfg-key config :rclone) {})) +(unless (or (table? rclone-section) (struct? rclone-section)) + (fatal-config ":rclone must be a table")) +(strict-keys rclone-section ":rclone" + ["remote" "transfers" "checkers" "checksum" "extra-args" "targets"]) +(def rclone-remote + (let [r (or (cfg-key rclone-section :remote) "backup")] + (unless (string? r) (fatal-config ":rclone :remote must be a string")) + (def t (string/trim r)) + (when (empty? t) (fatal-config ":rclone :remote must not be empty")) + (each bad [":" "/" " "] + (when (string/find bad t) + (fatal-config (string ":rclone :remote must not contain '" bad "'")))) + t)) +(defn- cfg-int [key fallback lo] + (def v (or (cfg-key rclone-section key) fallback)) + (unless (and (int? v) (>= v lo)) + (fatal-config (string ":rclone " key " must be an integer >= " lo))) + v) +(def rclone-transfers (cfg-int :transfers 4 1)) +(def rclone-checkers (cfg-int :checkers 8 1)) +(def rclone-checksum + (let [v (cfg-key rclone-section :checksum)] + (if (nil? v) true (not (not v))))) +(def rclone-extra-args + (let [v (or (cfg-key rclone-section :extra-args) [])] + (unless (indexed? v) (fatal-config ":rclone :extra-args must be an array")) + (each a v + (unless (and (string? a) (not (empty? (string/trim a)))) + (fatal-config ":rclone :extra-args must hold non-empty strings"))) + v)) +(def rclone-targets + (let [v (cfg-key rclone-section :targets)] + (when v (load-targets {:targets v} "rclone")))) + +(def plakar-section (or (cfg-key config :plakar) {})) +(unless (or (table? plakar-section) (struct? plakar-section)) + (fatal-config ":plakar must be a table")) +(strict-keys plakar-section ":plakar" ["config-dir"]) +(def plakar-config-dir + (let [v (cfg-key plakar-section :config-dir)] + (if (nil? v) + (string home "/.config/plakar") + (expand-path v "plakar config-dir")))) + + +(defn- run-capture [args] + (try + (do + (def proc (os/spawn args :p {:out :pipe :err :pipe})) + (def res + (try + (do + (def [out errout] + (ev/gather + (ev/read (proc :out) :all) + (ev/read (proc :err) :all))) + (def code (os/proc-wait proc)) + {:ok (zero? code) :code code + :out (string (or out "")) + :err (string (or errout ""))}) + ([e] + (try (os/proc-kill proc) ([_] nil)) + (try (os/proc-wait proc) ([_] nil)) + {:ok false :code 127 :out "" :err (string e)}))) + (try (os/proc-close proc) ([_] nil)) + res) + ([e] {:ok false :code 127 :out "" :err (string e)}))) + +(defn- run-verbose [args] + (try + (do + (file/flush stdout) + (file/flush stderr) + (set current-proc (os/spawn args :p)) + (def code (os/proc-wait current-proc)) + (set current-proc nil) + {:ok (zero? code) :code code :out "" :err ""}) + ([e] + (set current-proc nil) + {:ok false :code 127 :out "" :err (string e)}))) + +(defn- run-cmd [verbose args] + (if verbose (run-verbose args) (run-capture args))) + + +(defn- git [dir verbose & args] + (run-cmd verbose (array/concat @["git" "-C" dir] args))) + +(defn- commit-changes [dir verbose] + (def r (git dir false "diff" "--cached" "--name-only")) + (if (not (check (string "Failed to list staged changes in " dir) r)) + false + (do + (def files + (filter |(not= $ "") + (map string/trim (string/split "\n" (r :out))))) + (if (empty? files) + (do (log (string "Nothing to commit in " dir)) true) + (do + (def n (length files)) + (def listed (string/join (slice files 0 (min n 5)) ", ")) + (def short + (if (> (length listed) 400) + (string (string/slice listed 0 400) "...") + listed)) + (def suffix (if (> n 5) (string ", and " (- n 5) " more") "")) + (def msg (string short suffix)) + (def r2 (git dir verbose "commit" "-m" msg)) + (if (not (check (string "Failed to commit changes in " dir) r2)) + false + (do + (log (string "Committed changes in " dir)) + true))))))) + +(defn- capitalize [s] + (if (empty? s) s + (string (string/ascii-upper (string/slice s 0 1)) (string/slice s 1)))) + +(defn- git-remote [dir action verb verbose] + (log (string (capitalize verb) " changes from " dir)) + (def r (git dir verbose ;action)) + (if (r :ok) + (do (log (string "Done " verb "ing " dir)) true) + (do + (record-failure (string (capitalize verb) " failed for " dir + " (exit " (r :code) "): " + (string/trim (r :err)))) + false))) + +(defn- push-changes [dir verbose] (git-remote dir ["push"] "push" verbose)) +(defn- fetch-changes [dir verbose] (git-remote dir ["pull" "--ff-only"] "fetch" verbose)) + +(defn- sync-repo [name dir verbose push fetch] + (log (string "git/" name)) + (if (nil? (os/stat dir)) + (do + (record-failure (string "Missing directory for git/" name ": " dir)) + false) + (do + (def r (git dir verbose "add" "-A")) + (if (not (check (string "Failed to stage changes in " dir) r)) + false + (do + (def diff (git dir false "diff" "--cached" "--quiet")) + (def ready + (cond + (= (diff :code) 1) + (commit-changes dir verbose) + (diff :ok) + (do (log (string "Nothing to commit in " dir)) true) + (do + (record-failure + (string "Failed to check staged changes in " dir + " (exit " (diff :code) "): " + (string/trim (diff :err)))) + false))) + (if (not ready) + false + (do + (def fetched (if fetch (fetch-changes dir verbose) true)) + (if (not fetched) + false + (if push (push-changes dir verbose) true))))))))) + + +(defn- tarsnap-archive [name dir verbose] + (if (nil? (os/stat dir)) + (record-failure (string "Missing directory for tarsnap/" name ": " dir)) + (do + (def stamp (os/strftime "%Y-%m-%d_%H-%M-%S" nil false)) + (log (string "Archiving tarsnap/" name " from " dir)) + (def r (run-cmd verbose + ["tarsnap" "-c" "-f" (string name "-" stamp) "-C" dir "."])) + (when (check (string "tarsnap failed for " name) r) + (log (string "Done tarsnap/" name)))))) + + +(defn- rclone-backup [name dir verbose] + (if (nil? (os/stat dir)) + (record-failure (string "Missing directory for rclone/" name ": " dir)) + (do + (def remote-path (string rclone-remote ":" name)) + (log (string "Syncing rclone/" name " from " dir " to " remote-path)) + (def args @["rclone" "copy" dir remote-path]) + (if verbose + (do (array/push args "--progress") (array/push args "--verbose")) + (array/push args "--stats-one-line")) + (array/push args "--transfers" (string rclone-transfers)) + (array/push args "--checkers" (string rclone-checkers)) + (def with-checksum rclone-checksum) + (if with-checksum (array/push args "--checksum") nil) + (each a rclone-extra-args (array/push args a)) + (def r (run-cmd verbose args)) + (when (check (string "rclone failed for " name) r) + (log (string "Done rclone/" name)))))) + + +(defn- leading-spaces [line] + (var n 0) + (while (and (< n (length line)) (= (line n) 32)) (++ n)) + n) + +(defn- strip-quotes [s] + (def t (string/trim (string s))) + (if (and (>= (length t) 2) + (or (= (t 0) 39) (= (t 0) 34)) + (= (t (- (length t) 1)) (t 0))) + (string/slice t 1 -2) t)) + +(defn- split-kv [stripped] + (def parts (string/split ":" stripped 0 2)) + (when (= (length parts) 2) + (def k (string/trim (parts 0))) + (def v (string/trim (parts 1))) + (when (not (empty? k)) [k v]))) + +(defn- header-name [stripped] + (def kv (split-kv stripped)) + (when kv + (def [k v] kv) + (when (or (empty? v) (string/has-prefix? "#" v)) k))) + +(defn- parse-plakar-show [text] + (def records @{}) + (var name nil) + (each line (string/split "\n" (or text "")) + (def stripped (string/trim line)) + (unless (empty? stripped) + (if (or (string/has-prefix? " " line) (string/has-prefix? "\t" line)) + (do + (def kv (split-kv stripped)) + (when (and name kv) + (def [k v] kv) + (put (records name) k (strip-quotes v)))) + (do + (def h (header-name stripped)) + (set name (or h stripped)) + (put records name @{}))))) + records) + +(defn- plakar-query [subcommand] + (def r (run-capture ["plakar" subcommand "show"])) + (if (r :ok) (parse-plakar-show (r :out)) @{})) + +(defn- load-plakar-yml [name] + (def path (string plakar-config-dir "/" name ".yml")) + (if (not (os/stat path)) + nil + (do + (def text + (try (slurp path) + ([e] (fatal (string "Failed to read " path ": " e))))) + (when (or (nil? text) (empty? (string text))) + (fatal (string "Failed to read " path ": empty file"))) + (def section @{}) + (var in-section false) + (var entry nil) + (each line (string/split "\n" (string text)) + (def stripped (string/trim line)) + (unless (or (empty? stripped) (string/has-prefix? "#" stripped)) + (def indent (leading-spaces line)) + (cond + (zero? indent) + (do + (def h (header-name stripped)) + (if h + (do (set in-section (= h name)) (set entry nil)) + (set in-section false))) + (and in-section (> indent 0)) + (do + (def h (header-name stripped)) + (if h + (do (set entry h) (put section entry @{})) + (do + (def kv (split-kv stripped)) + (when (and entry kv) + (def [k v] kv) + (unless (string/has-prefix? "#" v) + (put (section entry) k (strip-quotes v)))))))))) + section))) + +(var- stores-cache nil) +(var- sources-cache nil) + +(defn- plakar-stores [] + (when (nil? stores-cache) + (set stores-cache (or (load-plakar-yml "stores") (plakar-query "store")))) + stores-cache) + +(defn- plakar-sources [] + (when (nil? sources-cache) + (set sources-cache (or (load-plakar-yml "sources") (plakar-query "source")))) + sources-cache) + +(defn- plakar-stores-list [] (sorted (keys (plakar-stores)))) +(defn- plakar-sources-list [] (sorted (keys (plakar-sources)))) + +(defn- plakar-source-dirs [] + (def out @{}) + (eachp [k cfg] (plakar-sources) + (def loc (cfg "location")) + (when (and (string? loc) (not (empty? (string/trim loc)))) + (put out k (string/trim loc)))) + out) + +(defn- rclone-dirs [] + (or rclone-targets (plakar-source-dirs))) + +(defn- plakar-ignore-file [store] + (def path (string plakar-config-dir "/" store ".ignore")) + (if (os/stat path) path nil)) + +(defn- plakar-source [store source verbose] + (def ignore (plakar-ignore-file store)) + (def args @["plakar" "at" (string "@" store) "backup"]) + (when ignore (array/concat args ["-ignore-file" ignore])) + (array/push args (string "@" source)) + (log (string "Syncing plakar/" store "/" source)) + (def r (run-cmd verbose args)) + (when (check (string "plakar @" store " failed for " source) r) + (log (string "Done plakar/" store "/" source)))) + +(defn- plakar-store [store verbose exclude] + (unless (find |(= $ store) (plakar-stores-list)) + (fatal (string "Unknown plakar store: " store))) + (each src (plakar-sources-list) + (unless (find |(= $ src) exclude) + (plakar-source store src verbose)))) + +(defn- backup-plakar [verbose exclude] + (each store (plakar-stores-list) + (plakar-store store verbose exclude))) + + +(defn- list-flat [name dirs] + (print name) + (each k (sorted (keys dirs)) + (print (string " " k)))) + +(defn- list-plakar [] + (print "plakar") + (print " sources") + (each s (plakar-sources-list) + (print (string " " s))) + (each store (plakar-stores-list) + (def loc (or ((plakar-stores) store) @{})) + (print (string " " store " (" (or (loc "location") "?") ")")))) + +(defn- list-rclone [] + (print "rclone") + (print " sources") + (each s (sorted (keys (rclone-dirs))) + (print (string " " s))) + (print (string " " rclone-remote))) + +(defn- excluded? [name exclude] + (truthy? (find |(= $ name) exclude))) + +(defn- git-run [verbose push fetch parts exclude] + (when (> (length parts) 1) + (fatal (string "Too many parts in git target: use git:"))) + (if (empty? parts) + (each n (sorted (keys git-dirs)) + (unless (excluded? n exclude) + (sync-repo n (git-dirs n) verbose push fetch))) + (do + (def name (parts 0)) + (unless (excluded? name exclude) + (sync-repo name (or (git-dirs name) + (fatal (string "Unknown git target: " name))) + verbose push fetch))))) + +(defn- tarsnap-run [verbose parts exclude] + (when (> (length parts) 1) + (fatal (string "Too many parts in tarsnap target: use tarsnap:"))) + (if (empty? parts) + (each n (sorted (keys tarsnap-dirs)) + (unless (excluded? n exclude) + (tarsnap-archive n (tarsnap-dirs n) verbose))) + (do + (def name (parts 0)) + (unless (excluded? name exclude) + (tarsnap-archive name (or (tarsnap-dirs name) + (fatal (string "Unknown tarsnap target: " name))) + verbose))))) + +(defn- rclone-run [verbose parts exclude] + (when (> (length parts) 1) + (fatal (string "Too many parts in rclone target: use rclone:"))) + (def dirs (rclone-dirs)) + (if (empty? parts) + (each n (sorted (keys dirs)) + (unless (excluded? n exclude) + (rclone-backup n (dirs n) verbose))) + (do + (def name (parts 0)) + (unless (excluded? name exclude) + (rclone-backup name (or (dirs name) + (fatal (string "Unknown rclone target: " name))) + verbose))))) + +(defn- plakar-run [verbose parts exclude] + (cond + (empty? parts) + (backup-plakar verbose exclude) + (= (length parts) 1) + (plakar-store (parts 0) verbose exclude) + (= (length parts) 2) + (do + (def store (parts 0)) + (unless (find |(= $ store) (plakar-stores-list)) + (fatal (string "Unknown plakar store: " store))) + (def known (plakar-sources-list)) + (def selected + (filter |(not (empty? $)) + (map string/trim (string/split "," (parts 1))))) + (when (empty? selected) + (fatal "Empty plakar source list: use plakar::")) + (each source (filter |(not (excluded? $ exclude)) selected) + (unless (find |(= $ source) known) + (fatal (string "Unknown plakar source: " source))) + (plakar-source store source verbose))) + (fatal "Too many parts in plakar target: use plakar:[:]"))) + +(def backends + {"git" {:list |(list-flat "git" git-dirs) + :run (fn [verbose push fetch exclude parts] + (git-run verbose push fetch parts exclude))} + "tarsnap" {:list |(list-flat "tarsnap" tarsnap-dirs) + :run (fn [verbose _push _fetch exclude parts] + (tarsnap-run verbose parts exclude))} + "plakar" {:list list-plakar + :run (fn [verbose _push _fetch exclude parts] + (plakar-run verbose parts exclude))} + "rclone" {:list list-rclone + :run (fn [verbose _push _fetch exclude parts] + (rclone-run verbose parts exclude))}}) + +(def backend-order ["git" "tarsnap" "plakar" "rclone"]) + +(defn- list-targets [] + (each name backend-order + (((backends name) :list)))) + +(defn- backup-target [target verbose push fetch exclude] + (def parts (string/split ":" target)) + (when (< (length parts) 1) + (fatal (string "Bad target: " target))) + (def bname (parts 0)) + (def rest (slice parts 1)) + (def backend (backends bname)) + (unless backend (fatal (string "Unknown target: " target))) + ((backend :run) verbose push fetch exclude rest)) + +(defn- usage [prog] + (string + "Usage: " prog " [options] [target]\n" + " no target: list all configured targets (same as -l)\n" + " target: git, plakar, tarsnap, rclone, :\n" + " plakar sources may be comma-separated: plakar::\n" + " -e may exclude sources: " prog " plakar: -e \n" + " only one target per run\n" + " targets come from " config-path "\n" + " -p, --push Commit, pull --ff-only, then push git targets\n" + " -f, --fetch Run git pull --ff-only for git targets before backup\n" + " -q, --quiet Suppress command output\n" + " -l, --list List all configured backup targets\n" + " -e, --exclude LIST Comma-separated list of sources/targets to skip\n" + " -h, --help")) + +(defn- parse-args [argv prog] + (def opts @{:verbose true :push false :fetch false + :list false :exclude @[]}) + (var target nil) + (var i 0) + (while (< i (length argv)) + (def arg (argv i)) + (cond + (or (= arg "-p") (= arg "--push")) + (put opts :push true) + (or (= arg "-f") (= arg "--fetch")) + (put opts :fetch true) + (or (= arg "-q") (= arg "--quiet")) + (put opts :verbose false) + (or (= arg "-l") (= arg "--list")) + (put opts :list true) + (or (= arg "-h") (= arg "--help")) + (do (print (usage prog)) (os/exit 0)) + (or (= arg "-e") (= arg "--exclude")) + (do + (++ i) + (when (>= i (length argv)) + (eprint "sursum: --exclude needs a value") + (os/exit 1)) + (each s (string/split "," (argv i)) + (def t (string/trim s)) + (unless (empty? t) + (array/push (opts :exclude) t)))) + (string/has-prefix? "-" arg) + (do (eprint (string "sursum: unknown option " arg "\n" (usage prog))) + (os/exit 1)) + (nil? target) + (set target arg) + (do + (eprint (string "sursum: unexpected argument " arg + " (only one target per run)\n" (usage prog))) + (os/exit 1))) + (++ i)) + [opts target]) + +(defn main [& args] + (def prog0 (if (> (length args) 0) (string (args 0)) "sursum")) + (def segs (string/split "/" prog0)) + (def prog (if (empty? segs) "sursum" (last segs))) + (def argv (slice args 1)) + (def [opts target] (parse-args argv prog)) + (when (opts :list) + (list-targets) + (os/exit 0)) + (when (nil? target) + (list-targets) + (os/exit 0)) + (when (opts :push) (put opts :fetch true)) + (backup-target target (opts :verbose) (opts :push) + (opts :fetch) (opts :exclude)) + (unless (empty? failures) + (fatal (string (length failures) " backup target(s) failed"))))