[bug#72803] Add restic commands to the restic-guix package

[bug#72803] Add restic commands to the restic-guix package

[paul via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 302 bytes --]

Dear all,

I'm sending a patch adding some more restic commands to the restic-guix 
package provided by the restic-backup-service-type. It allows for 
commands like the following:

restic-guix restore remote-ftp -t `pwd`/restored -i .config/guix/channels.scm latest


Thank you for your work,

giacomo

[-- Attachment #2: Type: text/html, Size: 563 bytes --]

[bug#72803] [PATCH] services: restic-backup: Add more restic commands to the restic-guix package.

[Giacomo Leidi via Guix-patches via]

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

[bug#72803] Add restic commands to the restic-guix package

[Fabio Natali via Guix-patches via]

Hi Giacomo,

Thanks for the patch and for the Restic service in the first place.

> diff --git a/doc/guix.texi b/doc/guix.texi

In the manual, consider the "extra-flags" section where we say:

> A list of values that are lowered to strings. These will be passed as
> command-line arguments to the current job restic backup invokation.

Perhaps this should now read "...the current job restic invokation..."
or "...the current restic invokation...", as the action is no longer
limited to "backup"?

>      (program-file
> -     "restic-backup-job.scm"
> +     (string-append "restic-" action "-" name "-program.scm")

Should 'name' be slug-ified in any way here? E.g. to avoid spaces,
capital letters, symbols that might be confusing when part of a file
name, etc.

> +  (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)))

Could this be (marginally) simpler if we used two nested association
lists? That way, 'get-program' might simply use 'assoc-ref' (twice) and
'assoc-table' would be redundant?

Everything else looks fine to me. For what it's worth, here's how I've
been testing this.

Initialise a Restic repository as follows (warning: this overwrites
'/some-temporary-folder/password'):

--8<---------------cut here---------------start------------->8---
mkdir /some-temporary-folder
export RESTIC_PASSWORD=password
restic init --repo=/some-temporary-folder/repository
echo "${RESTIC_PASSWORD}" > /some-temporary-folder/password
--8<---------------cut here---------------end--------------->8---

Save the following system definition as
'/some-temporary-folder/config.scm'.

--8<---------------cut here---------------start------------->8---
(use-modules (gnu))
(use-package-modules backup)
(use-service-modules backup)

(operating-system
  (host-name "host")
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets '("/dev/vda"))))
  (file-systems (cons (file-system
                        (device "/dev/vda1")
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (packages (cons* restic %base-packages))
  (services (cons*
             (service restic-backup-service-type
                      (restic-backup-configuration
                       (jobs
                        (list (restic-backup-job
                               (name "test")
                               (repository "/restic/repository")
                               (password-file "/restic/password")
                               (schedule "* * * * *")
                               (files '("/root")))))))
             %base-services)))
--8<---------------cut here---------------end--------------->8---

From a Guix checkout where this patch has been applied, launch a test VM
as follows:

--8<---------------cut here---------------start------------->8---
$(./pre-inst-env guix system vm \
    --no-graphic \
    --share=/some-temporary-folder=/restic \
    /tmp/config.scm) \
    -m 2048 -smp 2
--8<---------------cut here---------------end--------------->8---

Log in as root, then check that the cron schedule is correctly defined
with 'herd schedule mcron', backup jobs should be scheduled every
minute.

Mount the Restic repository to see that snapshots have been actually
created every minute since boot. This can be done either on the guest or
on the host system. E.g. on the guest:

--8<---------------cut here---------------start------------->8---
restic mount \
    --password-file=/restic/password \
    --repo=/restic/repository \
    /mnt
--8<---------------cut here---------------end--------------->8---

Unfortunately I don't have commit access to push this, but hopefully
someone else will have a second look and push it soon.

It'd be nice to have a little test suite for this, but in case this can
be part of a future patch.

HTH, thanks, Fabio.

[bug#72803] Add restic commands to the restic-guix package

[Fabio Natali via Guix-patches via]

> Mount the Restic repository to see that snapshots have been actually
> created every minute since boot.

Ha, sorry, I should have mentioned the revised 'restic-guix' script too,
which I tested with various commands and that also seemed to be working
fine.

Thanks, cheers, Fabio.

[bug#72803] Add restic commands to the restic-guix package

[paul via Guix-patches via]

Hi Fabio,

thank you very much for your detailed testing and review.

On 9/3/24 00:50, Fabio Natali wrote:
> Perhaps this should now read "...the current job restic invokation..."
> or "...the current restic invokation...", as the action is no longer
> limited to "backup"?

Definitely, good catch.

>>       (program-file
>> -     "restic-backup-job.scm"
>> +     (string-append "restic-" action "-" name "-program.scm")
> Should 'name' be slug-ified in any way here? E.g. to avoid spaces,
> capital letters, symbols that might be confusing when part of a file
> name, etc.
It should, right. I'll use the same approach used for the 
home-dotfiles-service-type (i.e. replacing illegal characters with "-").
>> +  (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)))
> Could this be (marginally) simpler if we used two nested association
> lists? That way, 'get-program' might simply use 'assoc-ref' (twice) and
> 'assoc-table' would be redundant?
I thought that as well, in fact my first implementation was with Guile's 
vhashes but it appears that neither alists nor vhashesh can be correctly 
ungexped, or at least I didn't find a way to do so. This is why I'm 
using plain lists and I need assoc-table. If you have some pointer where 
I could look how to lower alists it would be very helpful.
> It'd be nice to have a little test suite for this, but in case this can
> be part of a future patch.

There are already some tests Richard made at #71639 , once they get in 
I'll make sure to expand them for additional restic-guix subcommands.

Thank your for your review Fabio, I'm sending a patchset addressing your 
comments.

giacomo

[bug#72803] [PATCH v2] services: restic-backup: Add more restic commands to the restic-guix package.

[Giacomo Leidi via Guix-patches via]

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           |  13 +++-
 gnu/services/backup.scm | 127 +++++++++++++++++++++++++++++-----------
 2 files changed, 104 insertions(+), 36 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 16c697586a..8e3ecb80c2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41611,7 +41611,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
@@ -41667,8 +41675,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 555e9fc959..83d388143e 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
@@ -97,7 +97,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?))
@@ -107,15 +107,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" "run" "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
@@ -123,55 +135,104 @@ (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)))
+     ;; 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 +244,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: 9a03ab25ba889be27b34d5cebea05d5ac3b0a033
-- 
2.45.2

[bug#72803] Add restic commands to the restic-guix package

[paul via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 121 bytes --]

Hi Guix , this is a friendly ping. I'm sending a patchset rebased on 
current master.

Thank you for your work,

giacomo

[-- Attachment #2: Type: text/html, Size: 557 bytes --]

[bug#72803] [PATCH v2] services: restic-backup: Add more restic commands to the restic-guix package.

[Giacomo Leidi via Guix-patches via]

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           |  13 +++-
 gnu/services/backup.scm | 127 +++++++++++++++++++++++++++++-----------
 2 files changed, 104 insertions(+), 36 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ac3a7adef0..f8a73abdce 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41711,7 +41711,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
@@ -41767,8 +41775,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 555e9fc959..83d388143e 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
@@ -97,7 +97,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?))
@@ -107,15 +107,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" "run" "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
@@ -123,55 +135,104 @@ (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)))
+     ;; 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 +244,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: 5ab3c4c1e43ebb637551223791db0ea3519986e1
-- 
2.46.0

[bug#72803] [PATCH v4] services: restic-backup: Add more restic commands to the restic-guix package.

[Giacomo Leidi via Guix-patches via]

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