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

Message ID f87b0019e7a43e5f74d338278fc807aac68a3a01.1740329004.git.goodoldpaul@autistici.org
State New
Headers
Series [bug#72803,v7] services: restic-backup: Add more restic commands to the restic-guix package. |

Commit Message

paul Feb. 23, 2025, 4:43 p.m. UTC
  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-program;
(restic-guix): allow for multiple actions.

* doc/guix.texi: Document it.

Change-Id: Ib2b5d74bebc51e35f1ae6e1aa32cedee0da59697
---
 doc/guix.texi           |  20 +++++-
 gnu/services/backup.scm | 138 ++++++++++++++++++++++++++--------------
 2 files changed, 108 insertions(+), 50 deletions(-)


base-commit: 23b068c036223e70bdea9d7d579850a1cffc02a7
  

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index 83ba0f32923..5c99521f8e6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43271,6 +43271,23 @@  Miscellaneous Services
 sudo herd trigger remote-ftp
 @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
@@ -43344,8 +43361,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}
-invocation.
+command-line arguments to the current @command{restic} invocation.
 
 @end table
 
diff --git a/gnu/services/backup.scm b/gnu/services/backup.scm
index 4d8cf167f04..dc095593432 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-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)
@@ -129,7 +130,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} invocation."))
+command-line arguments to the current @command{restic} invocation."))
 
 (define list-of-restic-backup-jobs?
   (list-of restic-backup-job?))
@@ -139,71 +140,107 @@  (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" "list" "ls" "mount" "prune" "restore" "snapshots" "unlock"))
+
+(define (restic-backup-job->kv config)
   (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
+        (verbose?
          (if (restic-backup-job-verbose? config)
              '("--verbose")
              '())))
-    (program-file
-     "restic-backup-job.scm"
-     #~(begin
-         (use-modules (ice-9 popen)
-                      (ice-9 rdelim))
-         (setenv "RESTIC_PASSWORD"
-                 (with-input-from-file #$password-file read-line))
+    #~(list #$name (list #$restic #$repository #$password-file
+                         (list #$@verbose?) (list #$@extra-flags)))))
+
+(define (restic-program config)
+  #~(lambda* (action action-args job-restic repository password-file verbose? extra-flags)
+      (use-modules (ice-9 format)
+                   (ice-9 popen)
+                   (ice-9 rdelim))
+      ;; This can be extended later, i.e. to have a
+      ;; centrally defined restic package.
+      ;; See https://issues.guix.gnu.org/71639
+      (define restic job-restic)
+
+      (define command
+        `(,restic ,@verbose?
+          "-r" ,repository
+          ,@extra-flags
+          ,action ,@action-args))
+
+      (setenv "RESTIC_PASSWORD"
+              (with-input-from-file password-file read-line))
 
-         (execlp #$restic #$restic #$@verbose
-                 "-r" #$repository
-                 #$@extra-flags
-                 "backup" #$@files)))))
+      (when (> (length verbose?) 0)
+        (format #t "Running~{ ~a~}~%" command))
 
-(define (restic-guix jobs)
+      (apply execlp `(,restic ,@command))))
+
+(define* (restic-guix config #:key (supported-actions
+                                    %restic-guix-supported-actions))
   (program-file
    "restic-guix"
    #~(begin
        (use-modules (ice-9 match)
                     (srfi srfi-1))
 
-       (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 jobs
+         (list
+          #$@(map restic-backup-job->kv
+                  (restic-backup-configuration-jobs config))))
+       (define names (map first jobs))
+       (define (get-job key)
+         (first
+          (filter-map
+           (match-lambda
+             ((k v)
+              (and (string=? key k) v)))
+           jobs)))
 
-       (define (backup args)
-         (define name (third args))
-         (define program (get-program name))
-         (execlp program program))
+       (define restic-exec
+         #$(restic-program config))
 
        (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 ((job (get-job job-name))
+               (action-args
+                (if (> argc 3)
+                    (take-right args (- argc 3))
+                    '())))
+           (values job action-args)))
 
        (define (main args)
          (validate-args args)
          (define action (second args))
-         (match action
-           ("backup"
-            (backup args))
-           (_
-            (error (string-append "Unknown action: " action)))))
+         (define-values (job action-args) (validate-action-args action args))
+         (apply restic-exec `(,action ,action-args ,@job)))
 
        (main (command-line)))))
 
@@ -217,6 +254,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))
@@ -242,7 +283,8 @@  (define (restic-backup-job->shepherd-service config)
                             ;; backends require, such as rclone.
                             (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
@@ -261,11 +303,11 @@  (define (restic-backup-job->shepherd-service config)
 without waiting for the scheduled time.")
                                       (procedure #~trigger-timer)))))))
 
-(define (restic-guix-wrapper-package jobs)
+(define (restic-guix-wrapper-package config)
   (package
     (name "restic-backup-service-wrapper")
     (version "0.0.0")
-    (source (restic-guix jobs))
+    (source (restic-guix config))
     (build-system copy-build-system)
     (arguments
      (list #:install-plan #~'(("./" "/bin"))))
@@ -284,10 +326,10 @@  (define restic-backup-service-profile
     (define jobs (restic-backup-configuration-jobs config))
     (if (> (length jobs) 0)
         (list
-         (restic-guix-wrapper-package jobs))
+         (restic-guix-wrapper-package config))
         '())))
 
-(define (restic-backup-activation config)
+(define (restic-backup-service-activation config)
   #~(for-each
      (lambda (log-file)
        (mkdir-p (dirname log-file)))
@@ -299,7 +341,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