Package: guix-patches;
Reported by: paul <goodoldpaul <at> autistici.org>
Date: Sun, 25 Aug 2024 13:57:02 UTC
Severity: normal
Done: paul <goodoldpaul <at> autistici.org>
View this message in rfc822 format
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 72803 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>, Ludovic Courtès <ludo <at> gnu.org>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [bug#72803] [PATCH v4] services: restic-backup: Add more restic commands to the restic-guix package. Date: Mon, 23 Dec 2024 15:17:18 +0100
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 | 20 ++++++-
gnu/services/backup.scm | 129 ++++++++++++++++++++++++++++------------
2 files changed, 109 insertions(+), 40 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index f77b765933..aca87c7274 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41999,6 +41999,23 @@ Miscellaneous Services
sudo herd trigger remote-ftp-job
@end example
+The @code{restic-backup-service-type} installs as well @code{restic-guix}
+to the system profile, a @code{restic} utility wrapper that allows for easier
+interaction with the Guix configured backup jobs. For example the following
+could be used to list all the shapshots available on a given job's repository:
+
+@example
+restic-guix snapshots 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
@deftp {Data Type} restic-backup-configuration
@@ -42071,8 +42088,7 @@ Miscellaneous Services
@item @code{extra-flags} (default: @code{'()}) (type: list-of-lowerables)
A list of values that are lowered to strings. These will be passed as
-command-line arguments to the current job @command{restic backup}
-invokation.
+command-line arguments to the current @command{restic} invokation.
@end table
diff --git a/gnu/services/backup.scm b/gnu/services/backup.scm
index fc8934873b..5c693660e3 100644
--- a/gnu/services/backup.scm
+++ b/gnu/services/backup.scm
@@ -52,11 +52,12 @@ (define-module (gnu services backup)
restic-backup-configuration-fields
restic-backup-configuration-jobs
- restic-backup-job-program
- restic-backup-job->mcron-job
+ restic-action-program
+ restic-backup-job->shepherd-service
restic-guix
restic-guix-wrapper-package
restic-backup-service-profile
+ restic-backup-service-activation
restic-backup-service-type))
(define (gexp-or-string? value)
@@ -128,7 +129,7 @@ (define-configuration/no-serialization restic-backup-job
(extra-flags
(list-of-lowerables '())
"A list of values that are lowered to strings. These will be passed as
-command-line arguments to the current job @command{restic backup} invokation."))
+command-line arguments to the current @command{restic} invokation."))
(define list-of-restic-backup-jobs?
(list-of restic-backup-job?))
@@ -138,15 +139,27 @@ (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" "snapshots" "unlock"))
+
+(define* (restic-action-program config action)
+ (define (format name)
+ ;; Remove from NAME characters that cannot be used in the store.
+ (string-map (lambda (chr)
+ (if (and (char-set-contains? char-set:ascii chr)
+ (char-set-contains? char-set:graphic chr)
+ (not (memv chr '(#\. #\/ #\space))))
+ chr
+ #\-))
+ name))
(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
@@ -154,55 +167,90 @@ (define (restic-backup-job-program config)
'("--verbose")
'())))
(program-file
- "restic-backup-job.scm"
+ (string-append "restic-" action "-" (format 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)))
+ 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 (get-program 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))
+ (define (get-program action name)
+ (assoc-table name (assoc-table action action-table)))
(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 action job-name))
+ (rest (if (> argc 3)
+ (take-right args (- argc 3))
+ '())))
+ (values program 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)))))
@@ -216,6 +264,10 @@ (define (restic-job-log-file job)
(define (restic-backup-job->shepherd-service config)
(let ((schedule (restic-backup-job-schedule config))
(name (restic-backup-job-name config))
+ (files (string-join
+ (map (lambda (f) (string-append "'" f "'"))
+ (restic-backup-job-files config))
+ " "))
(user (restic-backup-job-user config))
(group (restic-backup-job-group config))
(max-duration (restic-backup-job-max-duration config))
@@ -238,7 +290,8 @@ (define (restic-backup-job->shepherd-service config)
(list
(string-append #+bash-minimal "/bin/bash")
"-l" "-c"
- (string-append "restic-guix backup " #$name))
+ (string-append
+ "restic-guix backup " #$name " " #$files))
#:user #$user
#:group #$group
#:environment-variables
@@ -283,7 +336,7 @@ (define restic-backup-service-profile
(restic-guix-wrapper-package jobs))
'())))
-(define (restic-backup-activation config)
+(define (restic-backup-service-activation config)
#~(for-each
(lambda (log-file)
(mkdir-p (dirname log-file)))
@@ -295,7 +348,7 @@ (define restic-backup-service-type
(extensions
(list
(service-extension activation-service-type
- restic-backup-activation)
+ restic-backup-service-activation)
(service-extension profile-service-type
restic-backup-service-profile)
(service-extension shepherd-root-service-type
base-commit: f52cde358b609d18f43bf62f1dfe63835c1a57b9
--
2.46.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.