backup (24882B)
1 #!/usr/bin/env janet 2 3 (var failures @[]) 4 (var current-proc nil) 5 6 (try 7 (do 8 (defn- on-signal [proc] 9 (when proc 10 (try (os/proc-kill proc) ([_] nil)))) 11 (os/sigaction :int (fn [&] (on-signal current-proc) (os/exit 130))) 12 (os/sigaction :term (fn [&] (on-signal current-proc) (os/exit 143)))) 13 ([_] nil)) 14 15 (var- tz-cache nil) 16 (defn- tz [] 17 (when (nil? tz-cache) 18 (set tz-cache 19 (try 20 (do 21 (def p (os/spawn ["date" "+%z"] :p {:out :pipe :err :pipe})) 22 (def out (ev/read (p :out) :all)) 23 (os/proc-wait p) 24 (os/proc-close p) 25 (string/trim (string (or out "")))) 26 ([_] "")))) 27 tz-cache) 28 29 (defn- ts [] 30 (string (os/strftime "%Y-%m-%dT%H:%M:%S" nil false) (tz))) 31 32 (defn- log [msg] 33 (print (string "[" (ts) "]: " msg)) 34 (file/flush stdout)) 35 36 (defn- err [msg] 37 (eprint (string "[" (ts) "]: " msg)) 38 (file/flush stderr)) 39 40 (defn- fatal [msg] 41 (err msg) 42 (os/exit 1)) 43 44 (defn- record-failure [msg] 45 (array/push failures msg) 46 (err (string "ERROR: " msg))) 47 48 (defn- check [msg res] 49 (if (res :ok) true 50 (do 51 (def detail (string/trim (string (or (res :err) "")))) 52 (record-failure (if (= detail "") msg (string msg ": " detail))) 53 false))) 54 55 56 (def home (or (os/getenv "HOME") (fatal "HOME not set"))) 57 58 (def default-config-path 59 (string (or (os/getenv "XDG_CONFIG_HOME") (string home "/.config")) 60 "/backup/config.janet")) 61 (def config-path default-config-path) 62 63 (defn- cfg-key [t k] 64 (or (get t k) (get t (keyword (string k))))) 65 66 (defn- fatal-config [msg] 67 (fatal (string config-path ": " msg))) 68 69 (defn- var-char? [c] 70 (or (and (>= c 48) (<= c 57)) 71 (and (>= c 65) (<= c 90)) 72 (= c 95) 73 (and (>= c 97) (<= c 122)))) 74 75 (defn- expand-env [s] 76 (def buf @"") 77 (var i 0) 78 (def n (length s)) 79 (while (< i n) 80 (def c (s i)) 81 (if (= c 36) 82 (cond 83 (and (< (+ i 1) n) (= (s (+ i 1)) 123)) 84 (do 85 (def j (string/find "}" s (+ i 2))) 86 (unless j (fatal-config (string "unclosed ${ in path: " s))) 87 (def vname (string/slice s (+ i 2) j)) 88 (when (empty? vname) (fatal-config (string "empty ${} in path: " s))) 89 (def val (os/getenv vname)) 90 (unless val (fatal-config (string "unknown env var $" vname " in path: " s))) 91 (buffer/push-string buf val) 92 (set i (+ j 1))) 93 (let [j (do (var k (+ i 1)) 94 (while (and (< k n) (var-char? (s k))) (++ k)) 95 k)] 96 (if (= j (+ i 1)) 97 (do (buffer/push-string buf "$") (set i (+ i 1))) 98 (do 99 (def vname (string/slice s (+ i 1) j)) 100 (def val (os/getenv vname)) 101 (unless val (fatal-config (string "unknown env var $" vname " in path: " s))) 102 (buffer/push-string buf val) 103 (set i j))))) 104 (do (buffer/push-byte buf c) (++ i)))) 105 (string buf)) 106 107 (defn- expand-path [raw what] 108 (unless (string? raw) 109 (fatal-config (string what " must be a string, got: " (string/format "%p" raw)))) 110 (def t (string/trim raw)) 111 (when (empty? t) 112 (fatal-config (string what " must not be empty"))) 113 (def home-expanded 114 (if (or (= t "~") (string/has-prefix? "~/" t)) 115 (string home (string/slice t 1)) 116 t)) 117 (def full (expand-env home-expanded)) 118 (unless (string/has-prefix? "/" full) 119 (fatal-config (string what " must be absolute after expansion: " raw))) 120 full) 121 122 (defn- check-name [raw backend] 123 (unless (string? raw) 124 (fatal (string "Invalid " backend " target name (not a string): " (string/format "%p" raw)))) 125 (def n (string/trim raw)) 126 (when (empty? n) 127 (fatal (string "Invalid " backend " target name: empty"))) 128 (when (not= n raw) 129 (fatal (string "Invalid " backend " target name with outer whitespace: '" raw "'"))) 130 (each sep [":" ","] 131 (when (string/find sep n) 132 (fatal (string "Invalid " backend " target name '" n "': must not contain '" sep "'")))) 133 n) 134 135 (defn- strict-keys [section where allowed] 136 (each k (keys section) 137 (unless (find |(= (string $) (string k)) allowed) 138 (fatal-config (string where ": unknown key :" (string k) 139 " (want " (string/join allowed ", ") ")"))))) 140 141 (defn- load-targets [section backend] 142 (def out @{}) 143 (when (nil? section) (break out)) 144 (unless (or (table? section) (struct? section)) 145 (fatal-config (string ":" backend " must be a table"))) 146 (def has-targets (not (nil? (cfg-key section :targets)))) 147 (when has-targets 148 (strict-keys section (string ":" backend) ["targets"])) 149 (def targets (or (cfg-key section :targets) section)) 150 (unless (or (table? targets) (struct? targets)) 151 (fatal-config (string ":" backend ":targets must be a table of name to dir"))) 152 (eachp [k v] targets 153 (def n (check-name (string k) backend)) 154 (when (get out n) 155 (fatal-config (string "duplicate " backend " target: '" n "'"))) 156 (put out n (expand-path v (string backend "/" n)))) 157 out) 158 159 (defn- load-config [path] 160 (unless (os/stat path) 161 (fatal (string "Missing config file: " path))) 162 (def text 163 (try (slurp path) 164 ([e] (fatal (string "Failed to read " path ": " e))))) 165 (when (or (nil? text) (empty? (string/trim (string text)))) 166 (fatal (string "Empty config file: " path))) 167 (def data 168 (try (parse (string text)) 169 ([e] (fatal (string "Failed to parse " path ": " e))))) 170 (unless (or (table? data) (struct? data)) 171 (fatal (string "Bad config " path ": top level must be a table, see config.example.janet"))) 172 (each k (keys data) 173 (def ks (string k)) 174 (unless (or (= ks "git") (= ks "tarsnap") (= ks "rclone") (= ks "plakar")) 175 (fatal-config (string "unknown section :" ks " (want git, tarsnap, rclone, plakar)")))) 176 data) 177 178 (def config (load-config config-path)) 179 180 (def git-dirs (load-targets (cfg-key config :git) "git")) 181 (def tarsnap-dirs (load-targets (cfg-key config :tarsnap) "tarsnap")) 182 183 (def rclone-section (or (cfg-key config :rclone) {})) 184 (unless (or (table? rclone-section) (struct? rclone-section)) 185 (fatal-config ":rclone must be a table")) 186 (strict-keys rclone-section ":rclone" 187 ["remote" "transfers" "checkers" "checksum" "extra-args" "targets"]) 188 (def rclone-remote 189 (let [r (or (cfg-key rclone-section :remote) "backup")] 190 (unless (string? r) (fatal-config ":rclone :remote must be a string")) 191 (def t (string/trim r)) 192 (when (empty? t) (fatal-config ":rclone :remote must not be empty")) 193 (each bad [":" "/" " "] 194 (when (string/find bad t) 195 (fatal-config (string ":rclone :remote must not contain '" bad "'")))) 196 t)) 197 (defn- cfg-int [key fallback lo] 198 (def v (or (cfg-key rclone-section key) fallback)) 199 (unless (and (int? v) (>= v lo)) 200 (fatal-config (string ":rclone " key " must be an integer >= " lo))) 201 v) 202 (def rclone-transfers (cfg-int :transfers 4 1)) 203 (def rclone-checkers (cfg-int :checkers 8 1)) 204 (def rclone-checksum 205 (let [v (cfg-key rclone-section :checksum)] 206 (if (nil? v) true (not (not v))))) 207 (def rclone-extra-args 208 (let [v (or (cfg-key rclone-section :extra-args) [])] 209 (unless (indexed? v) (fatal-config ":rclone :extra-args must be an array")) 210 (each a v 211 (unless (and (string? a) (not (empty? (string/trim a)))) 212 (fatal-config ":rclone :extra-args must hold non-empty strings"))) 213 v)) 214 (def rclone-targets 215 (let [v (cfg-key rclone-section :targets)] 216 (when v (load-targets {:targets v} "rclone")))) 217 218 (def plakar-section (or (cfg-key config :plakar) {})) 219 (unless (or (table? plakar-section) (struct? plakar-section)) 220 (fatal-config ":plakar must be a table")) 221 (strict-keys plakar-section ":plakar" ["config-dir"]) 222 (def plakar-config-dir 223 (let [v (cfg-key plakar-section :config-dir)] 224 (if (nil? v) 225 (string home "/.config/plakar") 226 (expand-path v "plakar config-dir")))) 227 228 229 (defn- run-capture [args] 230 (try 231 (do 232 (def proc (os/spawn args :p {:out :pipe :err :pipe})) 233 (def res 234 (try 235 (do 236 (def [out errout] 237 (ev/gather 238 (ev/read (proc :out) :all) 239 (ev/read (proc :err) :all))) 240 (def code (os/proc-wait proc)) 241 {:ok (zero? code) :code code 242 :out (string (or out "")) 243 :err (string (or errout ""))}) 244 ([e] 245 (try (os/proc-kill proc) ([_] nil)) 246 (try (os/proc-wait proc) ([_] nil)) 247 {:ok false :code 127 :out "" :err (string e)}))) 248 (try (os/proc-close proc) ([_] nil)) 249 res) 250 ([e] {:ok false :code 127 :out "" :err (string e)}))) 251 252 (defn- run-verbose [args] 253 (try 254 (do 255 (file/flush stdout) 256 (file/flush stderr) 257 (set current-proc (os/spawn args :p)) 258 (def code (os/proc-wait current-proc)) 259 (set current-proc nil) 260 {:ok (zero? code) :code code :out "" :err ""}) 261 ([e] 262 (set current-proc nil) 263 {:ok false :code 127 :out "" :err (string e)}))) 264 265 (defn- run-cmd [verbose args] 266 (if verbose (run-verbose args) (run-capture args))) 267 268 269 (defn- git [dir verbose & args] 270 (run-cmd verbose (array/concat @["git" "-C" dir] args))) 271 272 (defn- commit-changes [dir verbose] 273 (def r (git dir false "diff" "--cached" "--name-only")) 274 (if (not (check (string "Failed to list staged changes in " dir) r)) 275 false 276 (do 277 (def files 278 (filter |(not= $ "") 279 (map string/trim (string/split "\n" (r :out))))) 280 (if (empty? files) 281 (do (log (string "Nothing to commit in " dir)) true) 282 (do 283 (def n (length files)) 284 (def listed (string/join (slice files 0 (min n 5)) ", ")) 285 (def short 286 (if (> (length listed) 400) 287 (string (string/slice listed 0 400) "...") 288 listed)) 289 (def suffix (if (> n 5) (string ", and " (- n 5) " more") "")) 290 (def msg (string short suffix)) 291 (def r2 (git dir verbose "commit" "-m" msg)) 292 (if (not (check (string "Failed to commit changes in " dir) r2)) 293 false 294 (do 295 (log (string "Committed changes in " dir)) 296 true))))))) 297 298 (defn- capitalize [s] 299 (if (empty? s) s 300 (string (string/ascii-upper (string/slice s 0 1)) (string/slice s 1)))) 301 302 (defn- git-remote [dir action verb verbose] 303 (log (string (capitalize verb) " changes from " dir)) 304 (def r (git dir verbose ;action)) 305 (if (r :ok) 306 (do (log (string "Done " verb "ing " dir)) true) 307 (do 308 (record-failure (string (capitalize verb) " failed for " dir 309 " (exit " (r :code) "): " 310 (string/trim (r :err)))) 311 false))) 312 313 (defn- push-changes [dir verbose] (git-remote dir ["push"] "push" verbose)) 314 (defn- fetch-changes [dir verbose] (git-remote dir ["pull" "--ff-only"] "fetch" verbose)) 315 316 (defn- sync-repo [name dir verbose push fetch] 317 (log (string "git/" name)) 318 (if (nil? (os/stat dir)) 319 (do 320 (record-failure (string "Missing directory for git/" name ": " dir)) 321 false) 322 (do 323 (def r (git dir verbose "add" "-A")) 324 (if (not (check (string "Failed to stage changes in " dir) r)) 325 false 326 (do 327 (def diff (git dir false "diff" "--cached" "--quiet")) 328 (def ready 329 (cond 330 (= (diff :code) 1) 331 (commit-changes dir verbose) 332 (diff :ok) 333 (do (log (string "Nothing to commit in " dir)) true) 334 (do 335 (record-failure 336 (string "Failed to check staged changes in " dir 337 " (exit " (diff :code) "): " 338 (string/trim (diff :err)))) 339 false))) 340 (if (not ready) 341 false 342 (do 343 (def fetched (if fetch (fetch-changes dir verbose) true)) 344 (if (not fetched) 345 false 346 (if push (push-changes dir verbose) true))))))))) 347 348 349 (defn- tarsnap-archive [name dir verbose] 350 (if (nil? (os/stat dir)) 351 (record-failure (string "Missing directory for tarsnap/" name ": " dir)) 352 (do 353 (def stamp (os/strftime "%Y-%m-%d_%H-%M-%S" nil false)) 354 (log (string "Archiving tarsnap/" name " from " dir)) 355 (def r (run-cmd verbose 356 ["tarsnap" "-c" "-f" (string name "-" stamp) "-C" dir "."])) 357 (when (check (string "tarsnap failed for " name) r) 358 (log (string "Done tarsnap/" name)))))) 359 360 361 (defn- rclone-backup [name dir verbose] 362 (if (nil? (os/stat dir)) 363 (record-failure (string "Missing directory for rclone/" name ": " dir)) 364 (do 365 (def remote-path (string rclone-remote ":" name)) 366 (log (string "Syncing rclone/" name " from " dir " to " remote-path)) 367 (def args @["rclone" "copy" dir remote-path]) 368 (if verbose 369 (do (array/push args "--progress") (array/push args "--verbose")) 370 (array/push args "--stats-one-line")) 371 (array/push args "--transfers" (string rclone-transfers)) 372 (array/push args "--checkers" (string rclone-checkers)) 373 (def with-checksum rclone-checksum) 374 (if with-checksum (array/push args "--checksum") nil) 375 (each a rclone-extra-args (array/push args a)) 376 (def r (run-cmd verbose args)) 377 (when (check (string "rclone failed for " name) r) 378 (log (string "Done rclone/" name)))))) 379 380 381 (defn- leading-spaces [line] 382 (var n 0) 383 (while (and (< n (length line)) (= (line n) 32)) (++ n)) 384 n) 385 386 (defn- strip-quotes [s] 387 (def t (string/trim (string s))) 388 (if (and (>= (length t) 2) 389 (or (= (t 0) 39) (= (t 0) 34)) 390 (= (t (- (length t) 1)) (t 0))) 391 (string/slice t 1 -2) t)) 392 393 (defn- split-kv [stripped] 394 (def parts (string/split ":" stripped 0 2)) 395 (when (= (length parts) 2) 396 (def k (string/trim (parts 0))) 397 (def v (string/trim (parts 1))) 398 (when (not (empty? k)) [k v]))) 399 400 (defn- header-name [stripped] 401 (def kv (split-kv stripped)) 402 (when kv 403 (def [k v] kv) 404 (when (or (empty? v) (string/has-prefix? "#" v)) k))) 405 406 (defn- parse-plakar-show [text] 407 (def records @{}) 408 (var name nil) 409 (each line (string/split "\n" (or text "")) 410 (def stripped (string/trim line)) 411 (unless (empty? stripped) 412 (if (or (string/has-prefix? " " line) (string/has-prefix? "\t" line)) 413 (do 414 (def kv (split-kv stripped)) 415 (when (and name kv) 416 (def [k v] kv) 417 (put (records name) k (strip-quotes v)))) 418 (do 419 (def h (header-name stripped)) 420 (set name (or h stripped)) 421 (put records name @{}))))) 422 records) 423 424 (defn- plakar-query [subcommand] 425 (def r (run-capture ["plakar" subcommand "show"])) 426 (if (r :ok) (parse-plakar-show (r :out)) @{})) 427 428 (defn- load-plakar-yml [name] 429 (def path (string plakar-config-dir "/" name ".yml")) 430 (if (not (os/stat path)) 431 nil 432 (do 433 (def text 434 (try (slurp path) 435 ([e] (fatal (string "Failed to read " path ": " e))))) 436 (when (or (nil? text) (empty? (string text))) 437 (fatal (string "Failed to read " path ": empty file"))) 438 (def section @{}) 439 (var in-section false) 440 (var entry nil) 441 (each line (string/split "\n" (string text)) 442 (def stripped (string/trim line)) 443 (unless (or (empty? stripped) (string/has-prefix? "#" stripped)) 444 (def indent (leading-spaces line)) 445 (cond 446 (zero? indent) 447 (do 448 (def h (header-name stripped)) 449 (if h 450 (do (set in-section (= h name)) (set entry nil)) 451 (set in-section false))) 452 (and in-section (> indent 0)) 453 (do 454 (def h (header-name stripped)) 455 (if h 456 (do (set entry h) (put section entry @{})) 457 (do 458 (def kv (split-kv stripped)) 459 (when (and entry kv) 460 (def [k v] kv) 461 (unless (string/has-prefix? "#" v) 462 (put (section entry) k (strip-quotes v)))))))))) 463 section))) 464 465 (var- stores-cache nil) 466 (var- sources-cache nil) 467 468 (defn- plakar-stores [] 469 (when (nil? stores-cache) 470 (set stores-cache (or (load-plakar-yml "stores") (plakar-query "store")))) 471 stores-cache) 472 473 (defn- plakar-sources [] 474 (when (nil? sources-cache) 475 (set sources-cache (or (load-plakar-yml "sources") (plakar-query "source")))) 476 sources-cache) 477 478 (defn- plakar-stores-list [] (sorted (keys (plakar-stores)))) 479 (defn- plakar-sources-list [] (sorted (keys (plakar-sources)))) 480 481 (defn- plakar-source-dirs [] 482 (def out @{}) 483 (eachp [k cfg] (plakar-sources) 484 (def loc (cfg "location")) 485 (when (and (string? loc) (not (empty? (string/trim loc)))) 486 (put out k (string/trim loc)))) 487 out) 488 489 (defn- rclone-dirs [] 490 (or rclone-targets (plakar-source-dirs))) 491 492 (defn- plakar-ignore-file [store] 493 (def path (string plakar-config-dir "/" store ".ignore")) 494 (if (os/stat path) path nil)) 495 496 (defn- plakar-source [store source verbose] 497 (def ignore (plakar-ignore-file store)) 498 (def args @["plakar" "at" (string "@" store) "backup"]) 499 (when ignore (array/concat args ["-ignore-file" ignore])) 500 (array/push args (string "@" source)) 501 (log (string "Syncing plakar/" store "/" source)) 502 (def r (run-cmd verbose args)) 503 (when (check (string "plakar @" store " failed for " source) r) 504 (log (string "Done plakar/" store "/" source)))) 505 506 (defn- plakar-store [store verbose exclude] 507 (unless (find |(= $ store) (plakar-stores-list)) 508 (fatal (string "Unknown plakar store: " store))) 509 (each src (plakar-sources-list) 510 (unless (find |(= $ src) exclude) 511 (plakar-source store src verbose)))) 512 513 (defn- backup-plakar [verbose exclude] 514 (each store (plakar-stores-list) 515 (plakar-store store verbose exclude))) 516 517 518 (defn- list-flat [name dirs] 519 (print name) 520 (each k (sorted (keys dirs)) 521 (print (string " " k)))) 522 523 (defn- list-plakar [] 524 (print "plakar") 525 (print " sources") 526 (each s (plakar-sources-list) 527 (print (string " " s))) 528 (each store (plakar-stores-list) 529 (def loc (or ((plakar-stores) store) @{})) 530 (print (string " " store " (" (or (loc "location") "?") ")")))) 531 532 (defn- list-rclone [] 533 (print "rclone") 534 (print " sources") 535 (each s (sorted (keys (rclone-dirs))) 536 (print (string " " s))) 537 (print (string " " rclone-remote))) 538 539 (defn- excluded? [name exclude] 540 (truthy? (find |(= $ name) exclude))) 541 542 (defn- git-run [verbose push fetch parts exclude] 543 (when (> (length parts) 1) 544 (fatal (string "Too many parts in git target: use git:<name>"))) 545 (if (empty? parts) 546 (each n (sorted (keys git-dirs)) 547 (unless (excluded? n exclude) 548 (sync-repo n (git-dirs n) verbose push fetch))) 549 (do 550 (def name (parts 0)) 551 (unless (excluded? name exclude) 552 (sync-repo name (or (git-dirs name) 553 (fatal (string "Unknown git target: " name))) 554 verbose push fetch))))) 555 556 (defn- tarsnap-run [verbose parts exclude] 557 (when (> (length parts) 1) 558 (fatal (string "Too many parts in tarsnap target: use tarsnap:<name>"))) 559 (if (empty? parts) 560 (each n (sorted (keys tarsnap-dirs)) 561 (unless (excluded? n exclude) 562 (tarsnap-archive n (tarsnap-dirs n) verbose))) 563 (do 564 (def name (parts 0)) 565 (unless (excluded? name exclude) 566 (tarsnap-archive name (or (tarsnap-dirs name) 567 (fatal (string "Unknown tarsnap target: " name))) 568 verbose))))) 569 570 (defn- rclone-run [verbose parts exclude] 571 (when (> (length parts) 1) 572 (fatal (string "Too many parts in rclone target: use rclone:<name>"))) 573 (def dirs (rclone-dirs)) 574 (if (empty? parts) 575 (each n (sorted (keys dirs)) 576 (unless (excluded? n exclude) 577 (rclone-backup n (dirs n) verbose))) 578 (do 579 (def name (parts 0)) 580 (unless (excluded? name exclude) 581 (rclone-backup name (or (dirs name) 582 (fatal (string "Unknown rclone target: " name))) 583 verbose))))) 584 585 (defn- plakar-run [verbose parts exclude] 586 (cond 587 (empty? parts) 588 (backup-plakar verbose exclude) 589 (= (length parts) 1) 590 (plakar-store (parts 0) verbose exclude) 591 (= (length parts) 2) 592 (do 593 (def store (parts 0)) 594 (unless (find |(= $ store) (plakar-stores-list)) 595 (fatal (string "Unknown plakar store: " store))) 596 (def known (plakar-sources-list)) 597 (def selected 598 (filter |(not (empty? $)) 599 (map string/trim (string/split "," (parts 1))))) 600 (when (empty? selected) 601 (fatal "Empty plakar source list: use plakar:<store>:<src1,src2>")) 602 (each source (filter |(not (excluded? $ exclude)) selected) 603 (unless (find |(= $ source) known) 604 (fatal (string "Unknown plakar source: " source))) 605 (plakar-source store source verbose))) 606 (fatal "Too many parts in plakar target: use plakar:<store>[:<src1,src2>]"))) 607 608 (def backends 609 {"git" {:list |(list-flat "git" git-dirs) 610 :run (fn [verbose push fetch exclude parts] 611 (git-run verbose push fetch parts exclude))} 612 "tarsnap" {:list |(list-flat "tarsnap" tarsnap-dirs) 613 :run (fn [verbose _push _fetch exclude parts] 614 (tarsnap-run verbose parts exclude))} 615 "plakar" {:list list-plakar 616 :run (fn [verbose _push _fetch exclude parts] 617 (plakar-run verbose parts exclude))} 618 "rclone" {:list list-rclone 619 :run (fn [verbose _push _fetch exclude parts] 620 (rclone-run verbose parts exclude))}}) 621 622 (def backend-order ["git" "tarsnap" "plakar" "rclone"]) 623 624 (defn- list-targets [] 625 (each name backend-order 626 (((backends name) :list)))) 627 628 (defn- backup-target [target verbose push fetch exclude] 629 (def parts (string/split ":" target)) 630 (when (< (length parts) 1) 631 (fatal (string "Bad target: " target))) 632 (def bname (parts 0)) 633 (def rest (slice parts 1)) 634 (def backend (backends bname)) 635 (unless backend (fatal (string "Unknown target: " target))) 636 ((backend :run) verbose push fetch exclude rest)) 637 638 (defn- usage [prog] 639 (string 640 "Usage: " prog " [options] [target]\n" 641 " no target: list all configured targets (same as -l)\n" 642 " target: git, plakar, tarsnap, rclone, <backend>:<name>\n" 643 " plakar sources may be comma-separated: plakar:<store>:<src1,src2>\n" 644 " -e may exclude sources: " prog " plakar:<store> -e <src1,src2>\n" 645 " only one target per run\n" 646 " targets come from " config-path "\n" 647 " -p, --push Commit, pull --ff-only, then push git targets\n" 648 " -f, --fetch Run git pull --ff-only for git targets before backup\n" 649 " -q, --quiet Suppress command output\n" 650 " -l, --list List all configured backup targets\n" 651 " -e, --exclude LIST Comma-separated list of sources/targets to skip\n" 652 " -h, --help")) 653 654 (defn- parse-args [argv prog] 655 (def opts @{:verbose true :push false :fetch false 656 :list false :exclude @[]}) 657 (var target nil) 658 (var i 0) 659 (while (< i (length argv)) 660 (def arg (argv i)) 661 (cond 662 (or (= arg "-p") (= arg "--push")) 663 (put opts :push true) 664 (or (= arg "-f") (= arg "--fetch")) 665 (put opts :fetch true) 666 (or (= arg "-q") (= arg "--quiet")) 667 (put opts :verbose false) 668 (or (= arg "-l") (= arg "--list")) 669 (put opts :list true) 670 (or (= arg "-h") (= arg "--help")) 671 (do (print (usage prog)) (os/exit 0)) 672 (or (= arg "-e") (= arg "--exclude")) 673 (do 674 (++ i) 675 (when (>= i (length argv)) 676 (eprint "backup: --exclude needs a value") 677 (os/exit 1)) 678 (each s (string/split "," (argv i)) 679 (def t (string/trim s)) 680 (unless (empty? t) 681 (array/push (opts :exclude) t)))) 682 (string/has-prefix? "-" arg) 683 (do (eprint (string "backup: unknown option " arg "\n" (usage prog))) 684 (os/exit 1)) 685 (nil? target) 686 (set target arg) 687 (do 688 (eprint (string "backup: unexpected argument " arg 689 " (only one target per run)\n" (usage prog))) 690 (os/exit 1))) 691 (++ i)) 692 [opts target]) 693 694 (defn main [& args] 695 (def prog0 (if (> (length args) 0) (string (args 0)) "backup")) 696 (def segs (string/split "/" prog0)) 697 (def prog (if (empty? segs) "backup" (last segs))) 698 (def argv (slice args 1)) 699 (def [opts target] (parse-args argv prog)) 700 (when (opts :list) 701 (list-targets) 702 (os/exit 0)) 703 (when (nil? target) 704 (list-targets) 705 (os/exit 0)) 706 (when (opts :push) (put opts :fetch true)) 707 (backup-target target (opts :verbose) (opts :push) 708 (opts :fetch) (opts :exclude)) 709 (unless (empty? failures) 710 (fatal (string (length failures) " backup target(s) failed"))))