From: Giacomo Leidi via Guix-patches via <guix-patches@gnu.org>
To: 72803@debbugs.gnu.org
Cc: "Giacomo Leidi" <goodoldpaul@autistici.org>,
"Florian Pelz" <pelzflorian@pelzflorian.de>,
"Ludovic Courtès" <ludo@gnu.org>,
"Matthew Trzcinski" <matt@excalamus.com>,
"Maxim Cournoyer" <maxim.cournoyer@gmail.com>
Subject: [bug#72803] [PATCH] services: restic-backup: Add more restic commands to the restic-guix package.
Date: Sun, 25 Aug 2024 15:56:41 +0200 [thread overview]
Message-ID: <1084765da10bf285803cbb7457997f73f785983d.1724594201.git.goodoldpaul@autistici.org> (raw)
In-Reply-To: <db336bf4-14d8-e969-b998-dd5f98108066@autistici.org>
This patch refactors the way restic commands can be added to the
restic-guix package with a more general approach. This way new
subcommands for restic-guix can be added more easily.
* gnu/services/backup.scm (restic-backup-job-program): Generalize to
restic-action-program;
(restic-guix): allow for multiple actions.
* doc/guix.texi: Document it.
Change-Id: Ib2b5d74bebc51e35f1ae6e1aa32cedee0da59697
---
doc/guix.texi | 10 +++-
gnu/services/backup.scm | 116 +++++++++++++++++++++++++++++-----------
2 files changed, 93 insertions(+), 33 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index fcaf6b3fbb..9bbc2694ec 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41589,7 +41589,15 @@ Miscellaneous Services
configuration, without waiting for the scheduled job:
@example
-restic-guix backup remote-ftp
+restic-guix run remote-ftp
+@end example
+
+All arguments passed after the job name will be passed to the underlying
+@code{restic} command, together with the @code{extra-flags} field from the
+@code{restic-backup-job} record:
+
+@example
+restic-guix restore remote-ftp -t `pwd`/restored -i .config/guix/channels.scm latest
@end example
@c %start of fragment
diff --git a/gnu/services/backup.scm b/gnu/services/backup.scm
index 555e9fc959..f304361263 100644
--- a/gnu/services/backup.scm
+++ b/gnu/services/backup.scm
@@ -46,7 +46,7 @@ (define-module (gnu services backup)
restic-backup-configuration-fields
restic-backup-configuration-jobs
- restic-backup-job-program
+ restic-action-program
restic-backup-job->mcron-job
restic-guix
restic-guix-wrapper-package
@@ -107,15 +107,18 @@ (define-configuration/no-serialization restic-backup-configuration
(list-of-restic-backup-jobs '())
"The list of backup jobs for the current system."))
-(define (restic-backup-job-program config)
+(define %restic-guix-supported-actions
+ '("backup" "mount" "prune" "restore" "run" "unlock"))
+
+(define* (restic-action-program config action)
(let ((restic
(file-append (restic-backup-job-restic config) "/bin/restic"))
+ (name
+ (restic-backup-job-name config))
(repository
(restic-backup-job-repository config))
(password-file
(restic-backup-job-password-file config))
- (files
- (restic-backup-job-files config))
(extra-flags
(restic-backup-job-extra-flags config))
(verbose
@@ -123,55 +126,104 @@ (define (restic-backup-job-program config)
'("--verbose")
'())))
(program-file
- "restic-backup-job.scm"
+ (string-append "restic-" action "-" name "-program.scm")
#~(begin
(use-modules (ice-9 popen)
- (ice-9 rdelim))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define cli-arguments
+ (let* ((cl (command-line))
+ (argc (length cl)))
+ (if (> argc 1)
+ (take-right cl (- argc 1))
+ '())))
+
(setenv "RESTIC_PASSWORD"
(with-input-from-file #$password-file read-line))
- (execlp #$restic #$restic #$@verbose
- "-r" #$repository
- #$@extra-flags
- "backup" #$@files)))))
+ (apply execlp `(#$restic #$restic #$@verbose
+ "-r" #$repository
+ #$@extra-flags
+ #$action ,@cli-arguments))))))
+
+(define* (restic-guix jobs #:key (supported-actions
+ %restic-guix-supported-actions))
+ (define action-table
+ (map
+ (lambda (action)
+ (list action
+ (map (lambda (job)
+ (list (restic-backup-job-name job)
+ (restic-action-program job action)))
+ jobs)))
+ ;; run is an alias for backup
+ (filter (lambda (a) (not (string=? a "run"))) supported-actions)))
-(define (restic-guix jobs)
(program-file
"restic-guix"
#~(begin
(use-modules (ice-9 match)
(srfi srfi-1))
+ (define action-table '#$action-table)
+ (define (assoc-table key table)
+ (first
+ (filter-map
+ (match-lambda
+ ((k v)
+ (and (string=? key k) v)))
+ table)))
(define names '#$(map restic-backup-job-name jobs))
- (define programs '#$(map restic-backup-job-program jobs))
+ (define backup-files
+ '#$(map restic-backup-job-files jobs))
+
+ (define (get-program action name)
+ (assoc-table name (assoc-table action action-table)))
- (define (get-program name)
+ (define (get-backup-files name)
(define idx
(list-index (lambda (n) (string=? n name)) names))
- (unless idx
- (error (string-append "Unknown job name " name "\n\n"
- "Possible job names are: "
- (string-join names " "))))
- (list-ref programs idx))
-
- (define (backup args)
- (define name (third args))
- (define program (get-program name))
- (execlp program program))
+ (list-ref backup-files idx))
(define (validate-args args)
- (when (not (>= (length args) 3))
- (error (string-append "Usage: " (basename (car args))
- " backup NAME"))))
+ (unless (>= (length args) 2)
+ (error (string-append "Usage: " (basename (first args))
+ " ACTION [ARGS]\n\nSupported actions are: "
+ #$(string-join supported-actions ", ") ".")))
+ (unless (member (second args) '#$supported-actions)
+ (error (string-append "Unknown action: " (second args) ". Supported"
+ "actions are: "
+ #$(string-join supported-actions ", ") "."))))
+
+ (define (validate-action-args action args)
+ (define argc (length args))
+ (when (not (>= argc 3))
+ (error (string-append "Usage: " (basename (first args))
+ " " action " JOB_NAME [ARGS]\n\nPossible job "
+ "names are: " (string-join names ", ") ".")))
+ (define job-name (third args))
+ (unless (member job-name names)
+ (error (string-append "Unknown job name: " job-name ". Possible job "
+ "names are: " (string-join names ", ") ".")))
+ (let ((program
+ (get-program
+ ;; run is just backup called with restic-backup-job-files
+ (if (string=? action "run") "backup" action)
+ job-name))
+ (rest (if (> argc 3)
+ (take-right args (- argc 3))
+ '())))
+ (values program
+ (if (string=? action "run")
+ (append rest (get-backup-files job-name))
+ rest))))
(define (main args)
(validate-args args)
(define action (second args))
- (match action
- ("backup"
- (backup args))
- (_
- (error (string-append "Unknown action: " action)))))
+ (define-values (program action-args) (validate-action-args action args))
+ (apply execlp (append (list program program) action-args)))
(main (command-line)))))
@@ -183,7 +235,7 @@ (define (restic-backup-job->mcron-job config)
(name
(restic-backup-job-name config)))
#~(job #$schedule
- #$(string-append "restic-guix backup " name)
+ #$(string-append "restic-guix run " name)
#:user #$user)))
(define (restic-guix-wrapper-package jobs)
base-commit: d48af5cca84914d44b032d0bf0820640ebbe7a4b
--
2.45.2
next prev parent reply other threads:[~2024-08-25 13:57 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-08-25 13:54 [bug#72803] Add restic commands to the restic-guix package paul via Guix-patches via
2024-08-25 13:56 ` Giacomo Leidi via Guix-patches via [this message]
2024-09-02 22:50 ` Fabio Natali via Guix-patches via
2024-09-02 23:01 ` Fabio Natali via Guix-patches via
2024-09-04 22:19 ` paul via Guix-patches via
2024-09-04 22:29 ` [bug#72803] [PATCH v2] services: restic-backup: Add more " Giacomo Leidi via Guix-patches via
2024-10-20 22:58 ` [bug#72803] Add " paul via Guix-patches via
2024-10-20 22:58 ` [bug#72803] [PATCH v2] services: restic-backup: Add more " Giacomo Leidi via Guix-patches via
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1084765da10bf285803cbb7457997f73f785983d.1724594201.git.goodoldpaul@autistici.org \
--to=guix-patches@gnu.org \
--cc=72803@debbugs.gnu.org \
--cc=goodoldpaul@autistici.org \
--cc=ludo@gnu.org \
--cc=matt@excalamus.com \
--cc=maxim.cournoyer@gmail.com \
--cc=pelzflorian@pelzflorian.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.