GNU bug report logs - #72803
Add restic commands to the restic-guix package

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: paul <goodoldpaul@HIDDEN>; dated Sun, 25 Aug 2024 13:57:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.
Added indication that bug 72803 blocks76169 Request was from paul <goodoldpaul@HIDDEN> to control <at> debbugs.gnu.org. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 9 Feb 2025 23:01:29 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Feb 09 18:01:29 2025
Received: from localhost ([127.0.0.1]:46824 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thGIq-0005C8-Hz
	for submit <at> debbugs.gnu.org; Sun, 09 Feb 2025 18:01:29 -0500
Received: from confino.investici.org ([2a11:7980:1::2:0]:40487)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <goodoldpaul@HIDDEN>)
 id 1thGIo-0005Bz-Tx
 for 72803 <at> debbugs.gnu.org; Sun, 09 Feb 2025 18:01:27 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1739142086;
 bh=2Afa+ZXsna+5ZmA8KFAoW2aZBS17iX0GfYB449wcRfg=;
 h=From:To:Cc:Subject:Date:From;
 b=U5oWgdOsu0acidZjdcSQWfWIFRFL+qG1+q+Sh81gulNeLG4eN5Xtq5RBbUCPVE45H
 pIbJ6tLhwwlj5KzQdna2bvi8Ca8mKuWP30uJJZTJrMwEgSL+bYbuyL/Gqza8W4/GQ8
 JzYYB+C2iX+qwQPPwyCIp031kSXblSWm0QeOuDhE=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4Yrjr60tGNz1118;
 Sun,  9 Feb 2025 23:01:26 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4Yrjr56z9jz110n; Sun,  9 Feb 2025 23:01:25 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v6] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Mon, 10 Feb 2025 00:01:19 +0100
Message-ID: <a1fac696c4ef5e20d0412ec22ae6a0d77ea26682.1739142079.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.48.1
MIME-Version: 1.0
X-Debbugs-Cc: Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

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

diff --git a/doc/guix.texi b/doc/guix.texi
index ce780682ed0..86582fb4785 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42837,6 +42837,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
@@ -42910,8 +42927,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 99a79ff5fbe..dcbed890e13 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} invokation."))
+command-line arguments to the current @command{restic} invokation."))
 
 (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" "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

base-commit: e27e63e6fe72d3a6cb6a8755f290ec710d339a9a
-- 
2.48.1





Information forwarded to ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 9 Feb 2025 23:00:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Feb 09 18:00:49 2025
Received: from localhost ([127.0.0.1]:46820 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thGID-0005AX-20
	for submit <at> debbugs.gnu.org; Sun, 09 Feb 2025 18:00:49 -0500
Received: from confino.investici.org ([2a11:7980:1::2:0]:33677)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <goodoldpaul@HIDDEN>)
 id 1thGIA-0005AL-0x
 for 72803 <at> debbugs.gnu.org; Sun, 09 Feb 2025 18:00:47 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1739142042;
 bh=5Wj6aEAfU9hM5OLDrktbSIqqKHBWxzEM0bYpzuOh02k=;
 h=Date:Subject:From:To:References:In-Reply-To:From;
 b=nWiQdbYG3xT2VEDOgCHnSTHY13xUjzlT5bX9mM6c3VdCkQY3LPIVDZAdmxMFM98T2
 RfwtP91LNhLBc60Ct0JcfYbkixpb4K6Un0SNC/IEi+UluA7SKlMDlaCLWi6KZ67Ku9
 SKFkIXsKLYKbWtfQ84/MusPzGG4jT3vS/ZmqQ0HM=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4YrjqG5X61z1118
 for <72803 <at> debbugs.gnu.org>; Sun,  9 Feb 2025 23:00:42 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4YrjqG51yHz110n
 for <72803 <at> debbugs.gnu.org>; Sun,  9 Feb 2025 23:00:42 +0000 (UTC)
Message-ID: <de6259a5-5c42-4158-a407-8c12d24036bd@HIDDEN>
Date: Mon, 10 Feb 2025 00:00:41 +0100
MIME-Version: 1.0
User-Agent: Icedove Daily
Subject: Re: Add restic commands to the restic-guix package
From: paul <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
References: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
 <c5977a15-dedd-4396-8327-fa9a52710f80@HIDDEN>
 <08b873f4-26da-478a-bd61-91a03da51fb5@HIDDEN>
 <b6841b0b-2715-48e2-8928-837764e5df96@HIDDEN>
Content-Language: en-US
In-Reply-To: <b6841b0b-2715-48e2-8928-837764e5df96@HIDDEN>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Hi Guix,

I'm sending a v6. Compared to v5 it has the nice property of greatly 
simplifying the restic-guix script. Now there are no more multiple guile 
entrypoints (it used to be number of jobs * number of supported actions, 
so quite bad), there is only a single script which has embedded the 
information of all jobs, implements multiple actions and should be 
easily extendible to include more actions (like the init one proposed in 
https://issues.guix.gnu.org/71639 ).


Please let me know your thoughts on this!


Thank you all for your work,

giacomo





Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 24 Jan 2025 23:48:26 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Jan 24 18:48:26 2025
Received: from localhost ([127.0.0.1]:47656 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tbTPV-0002ri-Hb
	for submit <at> debbugs.gnu.org; Fri, 24 Jan 2025 18:48:26 -0500
Received: from confino.investici.org ([93.190.126.19]:23803)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <goodoldpaul@HIDDEN>)
 id 1tbTPS-0002rU-Cr
 for 72803 <at> debbugs.gnu.org; Fri, 24 Jan 2025 18:48:23 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1737762501;
 bh=IIHJ3kZNhXTNhnyagkg1KFUD7TdeqqV/BOYtO6/rMzw=;
 h=From:To:Cc:Subject:Date:From;
 b=gnKyl3yUX10xtt2feUB4lTHMZZycisvtDHqVnBne8DptpMe6oKP3WrEvi1QCDTqzP
 VTgAzphpV2okGpByvuM9VXyLx71FJxo/hDpTvOljwt6QK8si1XOV80Tio7do4MOEKu
 jQfEGtVt4hmgiXYWmfWy5W6qT9d2yFYum8b92fH4=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4Yfvdd3SZSz11Qc;
 Fri, 24 Jan 2025 23:48:21 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4Yfvdd2571z11LD; Fri, 24 Jan 2025 23:48:21 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v5] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Sat, 25 Jan 2025 00:47:54 +0100
Message-ID: <757f3b471a0b994c34fd6c8371aa19072ed04431.1737762473.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.47.1
MIME-Version: 1.0
X-Debbugs-Cc: Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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 9a53bdcd374..716dd312cd2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42722,6 +42722,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
@@ -42795,8 +42812,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 99a79ff5fbe..49655d1d930 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)
@@ -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} invokation."))
+command-line arguments to the current @command{restic} invokation."))
 
 (define list-of-restic-backup-jobs?
   (list-of restic-backup-job?))
@@ -139,15 +140,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
@@ -155,55 +168,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)))))
 
@@ -217,6 +265,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 +294,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
@@ -287,7 +340,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)))
@@ -299,7 +352,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: 646202bf73f90de4f9b7cc66248b8f8e6e381014
-- 
2.47.1





Information forwarded to ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 24 Jan 2025 23:47:37 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Fri Jan 24 18:47:37 2025
Received: from localhost ([127.0.0.1]:47652 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tbTOj-0002pj-2M
	for submit <at> debbugs.gnu.org; Fri, 24 Jan 2025 18:47:37 -0500
Received: from confino.investici.org ([93.190.126.19]:53587)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <goodoldpaul@HIDDEN>)
 id 1tbTOg-0002pY-JP
 for 72803 <at> debbugs.gnu.org; Fri, 24 Jan 2025 18:47:35 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1737762452;
 bh=WJ7KblwsFOpZrAtNm9mMEZ+rCEmXhC1XE5jRQDUprBw=;
 h=Date:Subject:From:To:References:In-Reply-To:From;
 b=mxFAJdx88ZWvd/LysQuFCvkNy9XW3KUnzT1/8iMhVsASSIO+jRSfq5JVjC6pGrEXS
 Um1Fj1lxsHyYCNLFUNh4TINq4avgYm4oTKotsDY65xrVtltrVee15ZQsD5e6lOAQnv
 bphBD41SYMg+LBSv76GE0HVwRNpu2I2Y9HL9uohA=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4Yfvch5rSpz11LD
 for <72803 <at> debbugs.gnu.org>; Fri, 24 Jan 2025 23:47:32 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4Yfvch57t4z11JZ
 for <72803 <at> debbugs.gnu.org>; Fri, 24 Jan 2025 23:47:32 +0000 (UTC)
Message-ID: <b6841b0b-2715-48e2-8928-837764e5df96@HIDDEN>
Date: Sat, 25 Jan 2025 00:47:30 +0100
MIME-Version: 1.0
User-Agent: Icedove Daily
Subject: Re: Add restic commands to the restic-guix package
From: paul <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
References: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
 <c5977a15-dedd-4396-8327-fa9a52710f80@HIDDEN>
 <08b873f4-26da-478a-bd61-91a03da51fb5@HIDDEN>
Content-Language: en-US
In-Reply-To: <08b873f4-26da-478a-bd61-91a03da51fb5@HIDDEN>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

Hi Guix, I'm sending a v5 rebased on current master, thank you for your 
time!




Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 23 Dec 2024 14:17:40 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 09:17:40 2024
Received: from localhost ([127.0.0.1]:53808 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tPjFb-0007hw-MQ
	for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 09:17:40 -0500
Received: from confino.investici.org ([93.190.126.19]:20769)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1tPjFY-0007hi-Nl
 for 72803 <at> debbugs.gnu.org; Mon, 23 Dec 2024 09:17:38 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1734963446;
 bh=34HVHqduCm+/2K5JxrJLwyP9CveFW3NN119T1uXcqLQ=;
 h=From:To:Cc:Subject:Date:From;
 b=XUNG0jtbQZr2i7tA+J14slY3QpDCG7h37VXgnJoDXgLUCvKb07w9cbcBYMkizblon
 5d0fY0TIl2xbkua8jgavEzWo+0rV4N1bezSDMaTiSqCvDXZE3aPZYwepB8gAHDC0ax
 AJKMknTK848L3G99QbeqpIsumCtcsbrehFm9xfqk=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4YH0Tf5rYfz10xL;
 Mon, 23 Dec 2024 14:17:26 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4YH0Tf4TQxz10wM; Mon, 23 Dec 2024 14:17:26 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v4] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Mon, 23 Dec 2024 15:17:18 +0100
Message-ID: <e78157d5ce65108ac29f44f612ca68664b0eab6d.1734963438.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.46.0
MIME-Version: 1.0
X-Debbugs-Cc: Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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





Information forwarded to ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 23 Dec 2024 11:32:50 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 06:32:50 2024
Received: from localhost ([127.0.0.1]:53569 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tPgg2-0008SY-EM
	for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:32:50 -0500
Received: from confino.investici.org ([93.190.126.19]:31521)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1tPgg0-0008SP-4E
 for 72803 <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:32:44 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1734953563;
 bh=n0ETKCzKhbZqkwo3HnRizwofUI+AHdKe8NhVn7ujIRU=;
 h=Date:Subject:From:To:References:In-Reply-To:From;
 b=S8tyKDG2xigGfVhpUgZExKmJpBJFHSpKrubTqhwyZBhyQvFsnzwZU3ClGiNyINc0o
 sb0eD9uMALcyJ9viOe5+W18C6PR9htH8C6LI7k/bdIE71WjJHSYhQjVBXi1LVNsdnz
 wBfefq6EVMNSIrqk6qU99x37VFGMxJtX/jFvi/2s=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4YGwqb43qVz10wH
 for <72803 <at> debbugs.gnu.org>; Mon, 23 Dec 2024 11:32:43 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4YGwqb3YsKz10wG
 for <72803 <at> debbugs.gnu.org>; Mon, 23 Dec 2024 11:32:43 +0000 (UTC)
Message-ID: <08b873f4-26da-478a-bd61-91a03da51fb5@HIDDEN>
Date: Mon, 23 Dec 2024 12:32:43 +0100
MIME-Version: 1.0
User-Agent: Icedove Daily
Subject: Re: Add restic commands to the restic-guix package
From: paul <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
References: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
 <c5977a15-dedd-4396-8327-fa9a52710f80@HIDDEN>
Content-Language: en-US
In-Reply-To: <c5977a15-dedd-4396-8327-fa9a52710f80@HIDDEN>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

Actually I'm sending a v4 dropping the "run" subcommand from 
restic-guix, since now we can use


sudo herd trigger job-name


Apologies for the noise,

giacomo





Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.
Added blocking bug(s) 75045 Request was from paul <goodoldpaul@HIDDEN> to control <at> debbugs.gnu.org. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 23 Dec 2024 11:24:52 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 06:24:52 2024
Received: from localhost ([127.0.0.1]:53540 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tPgYN-00080I-L7
	for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:24:52 -0500
Received: from confino.investici.org ([93.190.126.19]:42205)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1tPgYL-000805-JQ
 for 72803 <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:24:50 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1734953089;
 bh=r1VcuuOk4BSX38U0UpLYPs7vHmd4BVzkLlQRAUCEw7k=;
 h=From:To:Cc:Subject:Date:From;
 b=UdGR9BnvDydHqeSxtswDTYUdb9eJ0/N54EUdZAffbSgACQimll1627Y7MKjRjM9Eo
 L4bUcjFSMshLLaEP6F5lvDsrRBIUKNxUHA8LDv5ixaMVHFPY1lNHALmrQSNNiS52Nn
 GvefuYmuspbK9l/iCjkLNdCcvP3s6mhy0ATsZiBA=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4YGwfT14KCz10vx;
 Mon, 23 Dec 2024 11:24:49 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4YGwfT04sbz10vv; Mon, 23 Dec 2024 11:24:48 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v3] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Mon, 23 Dec 2024 12:24:35 +0100
Message-ID: <9e1eec4968529a6f8bdcf6b4a14c91ce1595d0ad.1734953075.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.46.0
MIME-Version: 1.0
X-Debbugs-Cc: Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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 | 125 ++++++++++++++++++++++++++++++----------
 2 files changed, 111 insertions(+), 34 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..8d1959f9bf 100644
--- a/gnu/services/backup.scm
+++ b/gnu/services/backup.scm
@@ -52,7 +52,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
@@ -128,7 +128,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 +138,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
@@ -154,55 +166,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 name)
+       (define (get-program action name)
+         (assoc-table name (assoc-table action action-table)))
+
+       (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)))))
 

base-commit: f52cde358b609d18f43bf62f1dfe63835c1a57b9
-- 
2.46.0





Information forwarded to ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 23 Dec 2024 11:24:11 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Dec 23 06:24:11 2024
Received: from localhost ([127.0.0.1]:53533 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tPgXj-0007yr-20
	for submit <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:24:11 -0500
Received: from confino.investici.org ([93.190.126.19]:52283)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1tPgXg-0007yi-TO
 for 72803 <at> debbugs.gnu.org; Mon, 23 Dec 2024 06:24:09 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1734953047;
 bh=UrAJCIbpoBRDZf2it0lTid5iQZw9BZdJbl566iEpp5Q=;
 h=Date:Subject:From:To:References:In-Reply-To:From;
 b=XrdvD034Kisny6aACTpUJZdO5znbDntm00b0o5oBlipExGFabNPwUAm0oKspTxq8c
 F/Z5VvfCQlIi8JQAlUgq9XS2r+2LmvQ4ts0nnKFSzhBO7TtAljTk8fTEn1N03I08wx
 T2R4zpUVIeo0kWzVhY/wFbpC+jGrSCWOnmu617CY=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4YGwdg4CGzz10wp
 for <72803 <at> debbugs.gnu.org>; Mon, 23 Dec 2024 11:24:07 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4YGwdg3jYcz10w5
 for <72803 <at> debbugs.gnu.org>; Mon, 23 Dec 2024 11:24:07 +0000 (UTC)
Message-ID: <c5977a15-dedd-4396-8327-fa9a52710f80@HIDDEN>
Date: Mon, 23 Dec 2024 12:24:07 +0100
MIME-Version: 1.0
User-Agent: Icedove Daily
Subject: Re: Add restic commands to the restic-guix package
From: paul <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
References: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
Content-Language: en-US
In-Reply-To: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

Hi,


I'm sending a v3 based on issue#75045.


Thank you for your work,

cheers

giacomo





Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 20 Oct 2024 22:59:09 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Oct 20 18:59:09 2024
Received: from localhost ([127.0.0.1]:49271 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1t2etA-0002J8-PA
	for submit <at> debbugs.gnu.org; Sun, 20 Oct 2024 18:59:09 -0400
Received: from confino.investici.org ([93.190.126.19]:61213)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1t2et8-0002J0-Qh
 for 72803 <at> debbugs.gnu.org; Sun, 20 Oct 2024 18:59:07 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1729465120;
 bh=f67Gt87r8aNspn8YlYsFKNef2NKrXCJNKPq2YcLH4bQ=;
 h=From:To:Cc:Subject:Date:From;
 b=OFZN2eQpSmCfD90yIilvkxgE/PTtHyHhbZUhXZDwPHjRDjG1XP3vUsP7/PYJwYMOX
 DrV2WS3u9SlPXhrxOgfgJN95EC/Cjp0qkvs9aWYC9E6upLDnjYFq2N4CovKcVkOPDm
 FN6SjRLu65sIC+WRTnexT8qV2a4szMUlz10mok6s=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4XWv4c4CfKz10y2;
 Sun, 20 Oct 2024 22:58:40 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4XWv4b6J04z10xr; Sun, 20 Oct 2024 22:58:39 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v2] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Mon, 21 Oct 2024 00:58:31 +0200
Message-ID: <31413c193ddf6caccb7e23dd75796b6d89d5ceb7.1729465111.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.46.0
MIME-Version: 1.0
X-Debbugs-Cc: Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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





Information forwarded to ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 20 Oct 2024 22:59:01 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Oct 20 18:59:01 2024
Received: from localhost ([127.0.0.1]:49267 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1t2et3-0002IO-Cg
	for submit <at> debbugs.gnu.org; Sun, 20 Oct 2024 18:59:01 -0400
Received: from confino.investici.org ([93.190.126.19]:42323)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1t2et2-0002IH-5l
 for 72803 <at> debbugs.gnu.org; Sun, 20 Oct 2024 18:59:00 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1729465106;
 bh=naoZA5+Bl0ONg4fz7DziC0fcpvd8l2Wz/hAB061hA/E=;
 h=Date:To:From:Subject:From;
 b=C8Y4malt1mYbgGLDyns/vTDeK5lJ4Lu1LiqWWyEyYED5HdsYZ/5D9/KLRY/DKi0wm
 jvEhslNS1NFZENy/ACIHnrmtYsVgSky48FU9KvljA6RBJC3xrwveAB09WI5PvJNl5D
 OoLf6PSYqL79LelJgm+CGZ2jerzcCuVzNl69faq8=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4XWv4L4gZ1z10y2
 for <72803 <at> debbugs.gnu.org>; Sun, 20 Oct 2024 22:58:26 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4XWv4L4GzLz10xr
 for <72803 <at> debbugs.gnu.org>; Sun, 20 Oct 2024 22:58:26 +0000 (UTC)
Content-Type: multipart/alternative;
 boundary="------------2pT8kZ5kP4Ob0Y3A60w5rWFC"
Message-ID: <dd908cb9-d4b7-4c5e-84f8-d9a7d6e625c9@HIDDEN>
Date: Mon, 21 Oct 2024 00:58:26 +0200
MIME-Version: 1.0
User-Agent: Icedove Daily
Content-Language: en-US
To: 72803 <at> debbugs.gnu.org
From: paul <goodoldpaul@HIDDEN>
Subject: Re: Add restic commands to the restic-guix package
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

This is a multi-part message in MIME format.
--------------2pT8kZ5kP4Ob0Y3A60w5rWFC
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit

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

Thank you for your work,

giacomo

--------------2pT8kZ5kP4Ob0Y3A60w5rWFC
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: 7bit

<!DOCTYPE html>
<html>
  <head>

    <meta http-equiv="content-type" content="text/html; charset=UTF-8">
  </head>
  <body>
    <p> </p>
    <div class="moz-text-html" lang="x-unicode">
      <p> </p>
      <div class="moz-text-flowed"
        style="font-family: -moz-fixed; font-size: 12px;"
        lang="x-unicode">Hi Guix , this is a friendly ping. I'm sending
        a patchset rebased on current master. <br>
        <br>
        Thank you for your work, <br>
        <br>
        giacomo <br>
        <br>
      </div>
    </div>
  </body>
</html>

--------------2pT8kZ5kP4Ob0Y3A60w5rWFC--




Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 4 Sep 2024 22:30:32 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Sep 04 18:30:32 2024
Received: from localhost ([127.0.0.1]:35678 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1slyWF-0003dP-If
	for submit <at> debbugs.gnu.org; Wed, 04 Sep 2024 18:30:32 -0400
Received: from confino.investici.org ([93.190.126.19]:60313)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1slyWE-0003dI-Dr
 for 72803 <at> debbugs.gnu.org; Wed, 04 Sep 2024 18:30:31 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1725488958;
 bh=7HwOFB1BF1Uq8kEoj3V/SDn9X2A6eD4zAo9AVcKztT0=;
 h=From:To:Cc:Subject:Date:From;
 b=Lwhvgbn1Kv+TkuMHHf8v7zrbmxdcBMqwbrc/br/23Xs10l/EByEjCQ5+rPSOqLnBs
 kedMmywa9YWIVoadZ7JN2aLA/dY+lSHRPlcbpgSDPzotAlXCNCn+ZHpJQ6o+xtVEWk
 7b5y2/GcKakl/RvTuftGciWoz/TqOJHIz7xNwH10=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4Wzcby3hwQz115w;
 Wed,  4 Sep 2024 22:29:18 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4Wzcby2wR3z114S; Wed,  4 Sep 2024 22:29:18 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH v2] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Thu,  5 Sep 2024 00:29:04 +0200
Message-ID: <cba87a67ff4b6dfdc7620b45c9fec4d1ee0321bc.1725488944.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Florian Pelz <pelzflorian@HIDDEN>, Ludovic Courtès <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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





Information forwarded to pelzflorian@HIDDEN, ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 4 Sep 2024 22:28:32 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Sep 04 18:28:32 2024
Received: from localhost ([127.0.0.1]:35668 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1slyUJ-0003Xv-Qv
	for submit <at> debbugs.gnu.org; Wed, 04 Sep 2024 18:28:32 -0400
Received: from confino.investici.org ([93.190.126.19]:53753)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1slyUH-0003Xm-Gi
 for 72803 <at> debbugs.gnu.org; Wed, 04 Sep 2024 18:28:30 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1725488370;
 bh=vT0v2NinRalB07FtU5TYR734hAVl9aFfeLVRv6hEXno=;
 h=Date:Subject:To:References:From:In-Reply-To:From;
 b=lncECCmmyp3dWmzhDEcJwQTx0Aa6wNMpMNhBc+23Px5F6NG6hSn2ru4mbLp0RlE1i
 sITSltcirCLPgiIg4ZQCp95wQ8RrVkfAN1GsqdMZ6CKP0vxlwPznRrQilwtezpPE/2
 z0wsZaBdz+oJXbhYw2wtoFNDnJsVfc/NgnFIYqhQ=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4WzcNf5PGGz1143;
 Wed,  4 Sep 2024 22:19:30 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4WzcNf4mcGz112X; Wed,  4 Sep 2024 22:19:30 +0000 (UTC)
Message-ID: <2d83c75b-b750-b80d-5d7c-b4a6c89b4434@HIDDEN>
Date: Thu, 5 Sep 2024 00:19:30 +0200
MIME-Version: 1.0
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101
 Thunderbird/102.15.0
Subject: Re: Add restic commands to the restic-guix package
To: Fabio Natali <me@HIDDEN>, 72803 <at> debbugs.gnu.org
References: <8734mhfz6e.fsf@HIDDEN>
Content-Language: en-US
From: paul <goodoldpaul@HIDDEN>
In-Reply-To: <8734mhfz6e.fsf@HIDDEN>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -1.9 (-)
X-Debbugs-Envelope-To: 72803
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.9 (--)

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





Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 2 Sep 2024 23:03:05 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 02 19:03:05 2024
Received: from localhost ([127.0.0.1]:52887 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1slG4f-0001fV-0W
	for submit <at> debbugs.gnu.org; Mon, 02 Sep 2024 19:03:05 -0400
Received: from relay7-d.mail.gandi.net ([217.70.183.200]:39915)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <me@HIDDEN>) id 1slG4b-0001el-N1
 for 72803 <at> debbugs.gnu.org; Mon, 02 Sep 2024 19:03:03 -0400
Received: by mail.gandi.net (Postfix) with ESMTPSA id 7A70C20005;
 Mon,  2 Sep 2024 23:01:53 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fabionatali.com;
 s=gm1; t=1725318113;
 h=from:from:reply-to:subject:subject:date:date:message-id:message-id:
 to:to:cc:cc:mime-version:mime-version:content-type:content-type:
 in-reply-to:in-reply-to; bh=YoLMbn0Frt9hrziQFuh/qhto9XBxskKAfmlmo+xsbmE=;
 b=CD7PABTgIbM8+YW/WDu5vY8FMckLy6z8piMYnZ5Bf7ZL5n1Iayiw2K91wFrts9rOmif7r4
 2cz+13CjACRO9xo7ZLEt9Dv5lqPW/pmH90bQTaqM5gluXriXeTt+66vabnnw+X/3bGudD/
 iTJ0D8/bXlLm6Jlth416ShAE1qgNNO5qkWvmJvIvUh4ApaqijEPezUIVYVepoVdRD5RkYi
 6/WvKD1TLU+nLHywYRLStHuujB5pXc55tDLvyonEzXn8P7iFb77RfUmkbeFalaTtLWp6bD
 p77o+sP7PCxlwUpb6mSQd+XllRf6fykJU4va0QUmPZDfw2sX/RkaIoqqpxlNGg==
From: Fabio Natali <me@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: Re: Add restic commands to the restic-guix package
In-Reply-To: <8734mhfz6e.fsf@HIDDEN>
Date: Tue, 03 Sep 2024 00:01:53 +0100
Message-ID: <87zfopek2m.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain
X-GND-Sasl: me@HIDDEN
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>,
 Fabio Natali <me@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

> 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.




Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 2 Sep 2024 22:51:31 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 02 18:51:31 2024
Received: from localhost ([127.0.0.1]:52863 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1slFtS-0001EJ-JQ
	for submit <at> debbugs.gnu.org; Mon, 02 Sep 2024 18:51:31 -0400
Received: from relay7-d.mail.gandi.net ([217.70.183.200]:45891)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <me@HIDDEN>) id 1slFtP-0001Dy-5E
 for 72803 <at> debbugs.gnu.org; Mon, 02 Sep 2024 18:51:29 -0400
Received: by mail.gandi.net (Postfix) with ESMTPSA id 0276020002;
 Mon,  2 Sep 2024 22:50:18 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fabionatali.com;
 s=gm1; t=1725317419;
 h=from:from:reply-to:subject:subject:date:date:message-id:message-id:
 to:to:cc:cc:mime-version:mime-version:content-type:content-type:
 in-reply-to:in-reply-to; bh=zVwD/Hx7vdZFJhIk5GDsRn673VPz4/5kMwYrr0fM0fE=;
 b=Vt2lesrIFuR1uRv2RqeKHTpF54DDporhHOKlQ/jF43KpPuio4d+7tIxlBAb3xIeFocn5f4
 Up3OG7wboT02ab9P/mevL0tgdTg2ffMk+UmGMO5o3urlrVG6NtRGN/PxXSFpxuoi1BWaxf
 fn4b5/N9GiZFEcj18ONqmHzJ8gQgXtd497t0wOQGyU/Iw9QI1yx59ZMk0rKHxKPY51L+nt
 4T2Bl+HjmSTd++PavUO4kqbTWEq3MxisIfTdixoDUqainB6OqWTTdJXoIkb1uv7ry+oRcs
 dvpH6ms4ax4eYYsha7cFvNDdDbbmya/g7DDGcE3WsH917gIRvbGyB4Sv9asz9Q==
From: Fabio Natali <me@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: Re: Add restic commands to the restic-guix package
In-Reply-To: <1084765da10bf285803cbb7457997f73f785983d.1724594201.git.goodoldpaul@HIDDEN>
Date: Mon, 02 Sep 2024 23:50:17 +0100
Message-ID: <8734mhfz6e.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain
X-GND-Sasl: me@HIDDEN
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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.




Information forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at 72803 <at> debbugs.gnu.org:


Received: (at 72803) by debbugs.gnu.org; 25 Aug 2024 13:57:49 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Aug 25 09:57:49 2024
Received: from localhost ([127.0.0.1]:43091 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1siDkb-00077M-6v
	for submit <at> debbugs.gnu.org; Sun, 25 Aug 2024 09:57:49 -0400
Received: from confino.investici.org ([93.190.126.19]:57469)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1siDkZ-00077C-61
 for 72803 <at> debbugs.gnu.org; Sun, 25 Aug 2024 09:57:47 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1724594216;
 bh=obTm9VPEfy4bu0nhnzP6EaZ233KgHgSRRgaVBiUO5MA=;
 h=From:To:Cc:Subject:Date:From;
 b=ouY7Tyr3LBJqhFa4edtamjqvXWkZao4rIEn3T0B3/VrrhDSrY9X0RtDWLAD5M4eGI
 2sjyxLUDZDHDc95ESeEtCZe+zPfC6XlhvN749vc+7HCEw3FX7f615VW5+Fp5LISwY3
 KGXDLgm1v8d12tWqaqxBP/rnZm11DLxPDng6cGdA=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4WsFjN1CB1z112m;
 Sun, 25 Aug 2024 13:56:56 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4WsFjN0Ry3z112c; Sun, 25 Aug 2024 13:56:56 +0000 (UTC)
From: Giacomo Leidi <goodoldpaul@HIDDEN>
To: 72803 <at> debbugs.gnu.org
Subject: [PATCH] services: restic-backup: Add more restic commands to the
 restic-guix package.
Date: Sun, 25 Aug 2024 15:56:41 +0200
Message-ID: <1084765da10bf285803cbb7457997f73f785983d.1724594201.git.goodoldpaul@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Florian Pelz <pelzflorian@HIDDEN>, Ludovic Courtès <ludo@HIDDEN>, Matthew Trzcinski <matt@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-Debbugs-Envelope-To: 72803
Cc: Giacomo Leidi <goodoldpaul@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.7 (-)

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





Information forwarded to pelzflorian@HIDDEN, ludo@HIDDEN, matt@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 25 Aug 2024 13:56:09 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Aug 25 09:56:09 2024
Received: from localhost ([127.0.0.1]:43086 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1siDiy-00071A-KH
	for submit <at> debbugs.gnu.org; Sun, 25 Aug 2024 09:56:09 -0400
Received: from lists.gnu.org ([209.51.188.17]:42250)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <goodoldpaul@HIDDEN>) id 1siDiv-000710-Lg
 for submit <at> debbugs.gnu.org; Sun, 25 Aug 2024 09:56:06 -0400
Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <goodoldpaul@HIDDEN>)
 id 1siDi7-0008Iw-FW
 for guix-patches@HIDDEN; Sun, 25 Aug 2024 09:55:15 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <goodoldpaul@HIDDEN>)
 id 1siDi3-0006Ja-GH
 for guix-patches@HIDDEN; Sun, 25 Aug 2024 09:55:14 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1724594095;
 bh=Vz4VSDfdJ/LyrTrg6upNKi9qoKxmavoHzmUWAk+bq0M=;
 h=Date:To:From:Subject:From;
 b=ERFKIqo1AT5KMUZqrqc3KexFHGGFHAph+qOitlgaco3qINIRYp3fnTbtusrIeWzEP
 Eew8pJjh+WNAst8jm6wy+LBHfwJyNh2wXIxOOjZkDLY/q3coryxq8RhvdzZAg9GVHV
 wo70pLEbTXit07vmVb6EfVLHaA/7ur66sl6KMSkQ=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4WsFg34Jbwz114Q
 for <guix-patches@HIDDEN>; Sun, 25 Aug 2024 13:54:55 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@HIDDEN) by localhost (Postfix) with
 ESMTPSA id 4WsFg33xvzz112c
 for <guix-patches@HIDDEN>; Sun, 25 Aug 2024 13:54:55 +0000 (UTC)
Content-Type: multipart/alternative;
 boundary="------------9Llavbym5vDHYS1kfkBlgJnK"
Message-ID: <db336bf4-14d8-e969-b998-dd5f98108066@HIDDEN>
Date: Sun, 25 Aug 2024 15:54:55 +0200
MIME-Version: 1.0
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101
 Thunderbird/102.15.0
To: guix-patches@HIDDEN
Content-Language: en-US
From: paul <goodoldpaul@HIDDEN>
Subject: Add restic commands to the restic-guix package
Received-SPF: pass client-ip=2a11:7980:1::2:0;
 envelope-from=goodoldpaul@HIDDEN; helo=confino.investici.org
X-Spam_score_int: -27
X-Spam_score: -2.8
X-Spam_bar: --
X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, HTML_MESSAGE=0.001,
 RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001,
 T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.4 (-)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.4 (--)

This is a multi-part message in MIME format.
--------------9Llavbym5vDHYS1kfkBlgJnK
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit

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

--------------9Llavbym5vDHYS1kfkBlgJnK
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: 7bit

<html>
  <head>

    <meta http-equiv="content-type" content="text/html; charset=UTF-8">
  </head>
  <body>
    <p>Dear all,<br>
      <br>
      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:<br>
      <br>
    </p>
    <pre>restic-guix restore remote-ftp -t `pwd`/restored -i .config/guix/channels.scm latest
</pre>
    <p><br>
    </p>
    <p>Thank you for your work,<br>
      <br>
      giacomo<br>
    </p>
  </body>
</html>

--------------9Llavbym5vDHYS1kfkBlgJnK--




Acknowledgement sent to paul <goodoldpaul@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#72803; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Mon, 10 Feb 2025 00:15:01 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.