commit - dd8f2033e5ebf2237b990d491d2f316f5f46334c
commit + 8db7f2f182028f85b475eb3d211ce3dc635638b0
blob - f4aabcc6d1a6e8e53d41d199755d345992318a87
blob + 2ea74eb829c8b5510f80b2003f1fb0574c108010
--- README.md
+++ README.md
# tools
-[](https://builds.sr.ht/~mtmn/tools?)
+[](https://builds.sr.ht/~mtmn/tools)
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
| 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`:
binaries. Deployed Python tools
(diggah, lazymaster, nts, shuffle) are thin shims that run out of this
repository's `.venv`, and deployed Ruby tools (hue, reflink-snap) run
-straight from the checkout; both need the checkout to stay in place.
+straight from the checkout. Both need the checkout to stay in place.
## Development
blob - d0252a3e90028a99fc73e68f95ce17067c731e31
blob + ccf34c4011c26376e9cd26b3c1921a5d583df2a2
--- knitfile
+++ knitfile
go_bins := bin/wrd
python_bins := bin/diggah bin/lazymaster bin/nts bin/shuffle bin/kundali
ruby_bins := bin/hue bin/reflink-snap
+janet_bins := bin/sursum
mpd_queue_bins := bin/mpd_add_to_queue bin/mpd_edit_queue bin/mpd_update_queue bin/mpd_insert_next bin/mpd_trim_queue
mpd_playlist_bins := bin/mpd_add_to_playlist bin/mpd_edit_playlist bin/mpd_update_library
mpd_report_bins := bin/mpd_now_playing bin/mpd_report bin/mpd_report_monthly bin/mpd_report_daily
mpd_bins := $mpd_queue_bins $mpd_playlist_bins $mpd_report_bins
-bins := $rust_bins $zig_bins $go_bins $mpd_bins $python_bins $ruby_bins
+bins := $rust_bins $zig_bins $go_bins $mpd_bins $python_bins $ruby_bins $janet_bins
cflags := -std=c17 -D_POSIX_C_SOURCE=200809L -Wall -Wextra -Wconversion -Wstrict-prototypes -O2 -march=native -mtune=native -fanalyzer -Wshadow -fstack-protector-strong -D_FORTIFY_SOURCE=2 -fPIE -Wformat -Werror=format-security -Wnull-dereference -Wdangling-pointer -Wtrampolines -Walloca -Wcast-align=strict -Wdate-time -Wfloat-equal -Wpointer-arith -Wredundant-decls -Wswitch-default -Wvla -Wwrite-strings
ldflags := -lmpdclient -Wl,-z,relro -Wl,-z,now
printf '#!/bin/sh\nexec ruby "%s/reflink-snap/reflink-snap.rb" "$$@"\n' $root > $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
+# 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
+# ~/.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
+#!/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:<name>")))
+ (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:<name>")))
+ (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:<name>")))
+ (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:<store>:<src1,src2>"))
+ (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:<store>[:<src1,src2>]")))
+
+(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, <backend>:<name>\n"
+ " plakar sources may be comma-separated: plakar:<store>:<src1,src2>\n"
+ " -e may exclude sources: " prog " plakar:<store> -e <src1,src2>\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"))))
