commit ca289ff53182b010eed2dfea185d5fbbdd9aba9f
parent 8db7f2f182028f85b475eb3d211ce3dc635638b0
Author: mtmn <miro@haravara.org>
Date: Mon, 21 Sep 2026 22:52:17 +0200
rename to backup
Diffstat:
8 files changed, 769 insertions(+), 769 deletions(-)
diff --git a/README.md b/README.md
@@ -22,7 +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 |
+| [backup](backup/) | backup helper for git, tarsnap, plakar and rclone |
## Toolchains
diff --git a/backup/README.md b/backup/README.md
@@ -0,0 +1,41 @@
+# backup
+
+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/backup/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
+backup -l # list targets
+backup git:notes # commit, no push
+backup -p git:notes # commit, pull, push
+backup tarsnap:notes # timestamped archive
+backup plakar:hoo # back up every source to hoo
+backup 'plakar:hoo:src,notes' # back up two sources
+backup rclone:notes # copy to backup:notes
+backup 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.
diff --git a/backup/backup b/backup/backup
@@ -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"))
+ "/backup/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 "backup: --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 "backup: unknown option " arg "\n" (usage prog)))
+ (os/exit 1))
+ (nil? target)
+ (set target arg)
+ (do
+ (eprint (string "backup: 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)) "backup"))
+ (def segs (string/split "/" prog0))
+ (def prog (if (empty? segs) "backup" (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"))))
diff --git a/backup/config.example.janet b/backup/config.example.janet
@@ -0,0 +1,14 @@
+# ~/.config/backup/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 {}}
diff --git a/knitfile b/knitfile
@@ -8,7 +8,7 @@ zig_bins := bin/pmn bin/pracomer bin/speediness
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
+janet_bins := bin/backup
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
@@ -116,8 +116,8 @@ $ bin/reflink-snap: reflink-snap/reflink-snap.rb
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
+$ bin/backup: backup/backup
+ cp backup/backup $output
chmod +x $output
$ all:VB: $bins
diff --git a/sursum/README.md b/sursum/README.md
@@ -1,41 +0,0 @@
-# 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.
diff --git a/sursum/config.example.janet b/sursum/config.example.janet
@@ -1,14 +0,0 @@
-# ~/.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 {}}
diff --git a/sursum/sursum b/sursum/sursum
@@ -1,710 +0,0 @@
-#!/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"))))
