[bug#76169,v8] home: Add home-restic-backup service.

Message ID c26fa6a42c1d223cda6803f11a521279d488920f.1746577702.git.goodoldpaul@autistici.org
State New
Headers
Series [bug#76169,v8] home: Add home-restic-backup service. |

Commit Message

Giacomo Leidi May 7, 2025, 12:28 a.m. UTC
  * gnu/services/backup.scm: Drop mcron obsolete export.
(restic-backup-job-program): Generalize to restic-program.
(lower-restic-backup-job): New procedure implementing a standard way to
lower restic-backup-job records into lists.
(restic-program): Implement general way to run restic commands, for
example to initialize repositories.
(restic-backup-configuration): Reimplement
with (guix records).
(restic-backup-job-{logfile,command,requirement,modules}): Add new
procedures and add support for Guix Home environments.
(restic-backup-job->shepherd-service): Add support for Guix Home
environments.
(restic-backup-service-activation): Drop procedure as now the Shepherd
takes care of creating timers log file directories.
(restic-backup-service-type): Drop profile and activation services extensions.
* gnu/home/services/backup.scm: New file.
* gnu/local.mk: Add this.
* doc/guix.texi: Document this.

Change-Id: Ied1c0a5756b715fba176a0e42ea154246089e6be
---
 doc/guix.texi                |  82 ++++++++++++++-
 gnu/home/services/backup.scm |  38 +++++++
 gnu/local.mk                 |   1 +
 gnu/services/backup.scm      | 189 +++++++++++++++++++++++------------
 4 files changed, 245 insertions(+), 65 deletions(-)
 create mode 100644 gnu/home/services/backup.scm


base-commit: ec95c71c01144fcae1a3d079e0d0aec6087b9d2a
  

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index 889eab2ab35..c8d56678e39 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -465,6 +465,7 @@  Top
 * GPG: GNU Privacy Guard.       Setting up GPG and related tools.
 * Desktop: Desktop Home Services.  Services for graphical environments.
 * Guix: Guix Home Services.     Services for Guix.
+* Backup: Backup Home Services.   Services for backing up User's files.
 * Fonts: Fonts Home Services.   Services for managing User's fonts.
 * Sound: Sound Home Services.   Dealing with audio.
 * Mail: Mail Home Services.     Services for managing mail.
@@ -44788,7 +44789,8 @@  Miscellaneous Services
 @item @code{log-file} (type: maybe-string)
 The file system path to the log file for this job.  By default the file will
 have be @file{/var/log/restic-backup/@var{job-name}.log}, where @var{job-name} is the
-name defined in the @code{name} field.
+name defined in the @code{name} field.  For Guix Home services it defaults to
+@file{$XDG_STATE_HOME/shepherd/restic-backup/@var{job-name}.log}.
 
 @item @code{max-duration} (type: maybe-number)
 The maximum duration in seconds that a job may last.  Past
@@ -44815,8 +44817,10 @@  Miscellaneous Services
 evaluate to @code{calendar-event} records or to strings.  Strings must contain
 Vixie cron date lines.
 
-@item @code{requirement} (default: @code{'()}) (type: list-of-symbols)
-The list of Shepherd services that this backup job depends upon.
+@item @code{requirement} (type: maybe-list-of-symbols)
+The list of Shepherd services that this backup job depends upon.  When unset it
+defaults to @code{'()}, for Guix Home.  Otherwise to
+@code{'(user-processes file-systems)}.
 
 @item @code{files} (default: @code{'()}) (type: list-of-lowerables)
 The list of files or directories to be backed up.  It must be a list of
@@ -48717,6 +48721,7 @@  Home Services
 * GPG: GNU Privacy Guard.       Setting up GPG and related tools.
 * Desktop: Desktop Home Services.  Services for graphical environments.
 * Guix: Guix Home Services.     Services for Guix.
+* Backup: Backup Home Services.   Services for backing up User's files.
 * Fonts: Fonts Home Services.   Services for managing User's fonts.
 * Sound: Sound Home Services.   Dealing with audio.
 * Mail: Mail Home Services.     Services for managing mail.
@@ -50307,6 +50312,77 @@  Guix Home Services
 @end lisp
 @end defvar
 
+@node Backup Home Services
+@subsection Backup Services
+
+The @code{(gnu home services backup)} module offers services for backing up
+file system trees.  For now, it provides the @code{home-restic-backup-service-type}.
+
+With @code{home-restic-backup-service-type}, you can periodically back up
+directories and files with @uref{https://restic.net/, Restic}, which
+supports end-to-end encryption and deduplication.  Consider the
+following configuration:
+
+@lisp
+(use-modules (gnu home services backup) ;for 'restic-backup-job', 'home-restic-backup-service-type'
+             (gnu packages sync)        ;for 'rclone'
+             @dots{})
+
+(home-environment
+
+  (packages (list rclone    ;for use by restic
+                  @dots{}))
+  (services
+    (list
+      @dots{}
+      (simple-service 'backup-jobs
+                      home-restic-backup-service-type
+                      (list (restic-backup-job
+                              (name "remote-ftp")
+                              (repository "rclone:remote-ftp:backup/restic")
+                              (password-file "/home/alice/.restic")
+                              ;; Every day at 23.
+                              (schedule "0 23 * * *")
+                              (files '("/home/alice/.restic"
+                                       "/home/alice/.config/rclone"
+                                       "/home/alice/Pictures"))))))))
+@end lisp
+
+In general it is preferrable to extend the @code{home-restic-backup-service-type},
+as shown in the example above.  This is because it takes care of wrapping everything
+with @code{for-home}, which enables the @code{home-restic-backup-service-type} and
+@code{restic-backup-service-type} to share the same codebase.
+
+For a custom configuration, wrap your @code{restic-backup-configuration} in
+@code{for-home}, as in this example:
+
+@lisp
+(use-modules (gnu services)             ;for 'for-home'
+             (gnu services backup)      ;for 'restic-backup-job' and 'restic-backup-configuration'
+             (gnu home services backup) ;for 'home-restic-backup-service-type'
+             (gnu packages sync)        ;for 'rclone'
+             @dots{})
+
+(home-environment
+
+  (packages (list rclone    ;for use by restic
+                  @dots{}))
+  (services
+    (list
+      @dots{}
+      (service home-restic-backup-service-type
+               (for-home
+                (restic-backup-configuration
+                 (jobs (list @dots{}))))))))
+@end lisp
+
+You can refer to @pxref{Miscellaneous Services,
+@code{restic-backup-service-type}} for details about
+@code{restic-backup-configuration} and @code{restic-backup-job}.
+The only difference is that the @code{home-restic-backup-service-type}
+will ignore the @code{user} and @code{group} field of
+@code{restic-backup-job}.
+
 @node Fonts Home Services
 @subsection Fonts Home Services
 
diff --git a/gnu/home/services/backup.scm b/gnu/home/services/backup.scm
new file mode 100644
index 00000000000..ac977f835b6
--- /dev/null
+++ b/gnu/home/services/backup.scm
@@ -0,0 +1,38 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services backup)
+  #:use-module (gnu services)
+  #:use-module (gnu services backup)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd)
+  #:export (home-restic-backup-service-type)
+  #:re-export (restic-backup-configuration
+               restic-backup-job))
+
+(define home-restic-backup-service-type
+  (service-type
+   (inherit (system->home-service-type restic-backup-service-type))
+   (extend
+    (lambda (config jobs)
+      (for-home
+       (restic-backup-configuration
+        (inherit config)
+        (jobs (append (restic-backup-configuration-jobs config)
+                      jobs))))))
+   (default-value (for-home (restic-backup-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index e6ece8cc483..3d4316454a8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -103,6 +103,7 @@  GNU_SYSTEM_MODULES =				\
   %D%/home.scm					\
   %D%/home/services.scm			\
   %D%/home/services/admin.scm			\
+  %D%/home/services/backup.scm			\
   %D%/home/services/desktop.scm			\
   %D%/home/services/dict.scm			\
   %D%/home/services/dotfiles.scm		\
diff --git a/gnu/services/backup.scm b/gnu/services/backup.scm
index 6e066bd3d66..06f68302682 100644
--- a/gnu/services/backup.scm
+++ b/gnu/services/backup.scm
@@ -28,6 +28,7 @@  (define-module (gnu services backup)
                 #:prefix license:)
   #:use-module (guix modules)
   #:use-module (guix packages)
+  #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:export (restic-backup-job
             restic-backup-job?
@@ -47,16 +48,21 @@  (define-module (gnu services backup)
             restic-backup-job-verbose?
             restic-backup-job-extra-flags
 
+            lower-restic-backup-job
+
             restic-backup-configuration
             restic-backup-configuration?
-            restic-backup-configuration-fields
             restic-backup-configuration-jobs
 
             restic-backup-job-program
-            restic-backup-job->mcron-job
+            restic-backup-job->shepherd-service
             restic-guix
             restic-guix-wrapper-package
             restic-backup-service-profile
+            restic-program
+            restic-job-log-file
+            restic-backup-job-command
+            restic-backup-job-modules
             restic-backup-service-type))
 
 (define (gexp-or-string? value)
@@ -75,6 +81,7 @@  (define list-of-symbols?
 
 (define-maybe/no-serialization string)
 (define-maybe/no-serialization number)
+(define-maybe/no-serialization symbol)
 
 (define-configuration/no-serialization restic-backup-job
   (restic
@@ -90,7 +97,8 @@  (define-configuration/no-serialization restic-backup-job
    (maybe-string)
    "The file system path to the log file for this job.  By default the file will
 have be @file{/var/log/restic-backup/@var{job-name}.log}, where @var{job-name} is the
-name defined in the @code{name} field.")
+name defined in the @code{name} field.  For Guix Home services it defaults to
+@file{$XDG_STATE_HOME/shepherd/restic-backup/@var{job-name}.log}.")
   (max-duration
    (maybe-number)
    "The maximum duration in seconds that a job may last.  Past
@@ -117,8 +125,10 @@  (define-configuration/no-serialization restic-backup-job
 evaluate to @code{calendar-event} records or to strings.  Strings must contain
 Vixie cron date lines.")
   (requirement
-   (list-of-symbols '())
-   "The list of Shepherd services that this backup job depends upon.")
+   (maybe-list-of-symbols)
+   "The list of Shepherd services that this backup job depends upon.  When unset it
+defaults to @code{'()}, for Guix Home.  Otherwise to
+@code{'(user-processes file-systems)}.")
   (files
    (list-of-lowerables '())
    "The list of files or directories to be backed up.  It must be a list of
@@ -131,15 +141,20 @@  (define-configuration/no-serialization restic-backup-job
    "A list of values that are lowered to strings.  These will be passed as
 command-line arguments to the current job @command{restic backup} invocation."))
 
-(define list-of-restic-backup-jobs?
-  (list-of restic-backup-job?))
+;; (for-home (restic-backup-configuration ...)) is not able to replace for-home? with #t,
+;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the
+;; record can be migrated back to define-configuration.
+(define-record-type* <restic-backup-configuration>
+  restic-backup-configuration
+  make-restic-backup-configuration
+  restic-backup-configuration?
+  this-restic-backup-configuration
 
-(define-configuration/no-serialization restic-backup-configuration
-  (jobs
-   (list-of-restic-backup-jobs '())
-   "The list of backup jobs for the current system."))
+  (jobs  restic-backup-configuration-jobs  (default '()))     ; list of restic-backup-job
+  (home-service? restic-backup-configuration-home-service?
+                 (default for-home?) (innate)))
 
-(define (restic-backup-job-program config)
+(define (lower-restic-backup-job config)
   (let ((restic
          (file-append (restic-backup-job-restic config) "/bin/restic"))
         (repository
@@ -150,22 +165,42 @@  (define (restic-backup-job-program config)
          (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))
-
-         (execlp #$restic #$restic #$@verbose
-                 "-r" #$repository
-                 #$@extra-flags
-                 "backup" #$@files)))))
+    #~(list (list #$@files) #$restic #$repository #$password-file
+            (list #$@verbose?) (list #$@extra-flags))))
+
+(define restic-program
+  #~(lambda (action action-args job-restic repository password-file verbose? extra-flags)
+      (use-modules (ice-9 format))
+      ;; 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_FILE" password-file)
+
+      (when (> (length verbose?) 0)
+        (format #t "Running~{ ~a~}~%" command))
+
+      (apply execlp `(,restic ,@command))))
+
+(define (restic-backup-job-program config)
+  (program-file
+   "restic-backup"
+   #~(let ((restic-exec
+            #$restic-program)
+           (job #$(lower-restic-backup-job config)))
+
+       (apply restic-exec `("backup" ,@job)))))
 
 (define (restic-guix jobs)
   (program-file
@@ -207,55 +242,92 @@  (define (restic-guix jobs)
 
        (main (command-line)))))
 
-(define (restic-job-log-file job)
+(define* (restic-job-log-file job #:key (home-service? #f))
   (let ((name (restic-backup-job-name job))
         (log-file (restic-backup-job-log-file job)))
     (if (maybe-value-set? log-file)
         log-file
-        (string-append "/var/log/restic-backup/" name ".log"))))
+        (if home-service?
+            #~(begin
+                (use-modules (shepherd support))
+                (string-append %user-log-dir "/restic-backup/" #$name ".log"))
+            (string-append "/var/log/restic-backup/" name ".log")))))
+
+(define* (restic-backup-job-command name files #:key (home-service? #f))
+  (if home-service?
+      #~(list
+         "restic-guix" "backup" #$name)
+      ;; We go through bash, instead of executing
+      ;; restic-guix directly, because the login shell
+      ;; gives us the correct user environment that some
+      ;; backends require, such as rclone.
+      #~(list
+          (string-append #$bash-minimal "/bin/bash")
+          "-l" "-c"
+          (string-append "restic-guix backup " #$name))))
 
-(define (restic-backup-job->shepherd-service config)
+(define (restic-backup-job-modules)
+ `((shepherd service timer)))
+
+(define* (restic-job-requirement config #:key (home-service? #f))
+  (define maybe-requirement (restic-backup-job-requirement config))
+  (if (maybe-value-set? maybe-requirement)
+      maybe-requirement
+      (if home-service?
+          '()
+          '(user-processes file-systems))))
+
+(define* (restic-backup-job-modules #:key (home-service? #f))
+ `((shepherd service timer)
+   ,@(if home-service?
+         ;;for %user-log-dir
+         '((shepherd support))
+         '())))
+
+(define* (restic-backup-job->shepherd-service config #:key (home-service? #f))
   (let ((schedule (restic-backup-job-schedule config))
         (name (restic-backup-job-name config))
+        (files (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))
         (wait-for-termination? (restic-backup-job-wait-for-termination? config))
-        (log-file (restic-job-log-file config))
-        (requirement (restic-backup-job-requirement config)))
+        (log-file (restic-job-log-file
+                   config #:home-service? home-service?))
+        (requirement
+         (restic-job-requirement config #:home-service? home-service?)))
     (shepherd-service (provision `(,(string->symbol name)))
-                      (requirement
-                       `(user-processes file-systems ,@requirement))
+                      (requirement requirement)
                       (documentation
-                       "Run @code{restic} backed backups on a regular basis.")
-                      (modules '((shepherd service timer)))
+                       "Run restic backed backups on a regular basis.")
+                      (modules (restic-backup-job-modules
+                                #:home-service? home-service?))
                       (start
                        #~(make-timer-constructor
                           (if (string? #$schedule)
                               (cron-string->calendar-event #$schedule)
                               #$schedule)
                           (command
-                           (list
-                            ;; We go through bash, instead of executing
-                            ;; restic-guix directly, because the login shell
-                            ;; gives us the correct user environment that some
-                            ;; backends require, such as rclone.
-                            (string-append #+bash-minimal "/bin/bash")
-                            "-l" "-c"
-                            (string-append "restic-guix backup " #$name))
-                           #:user #$user
-                           #:group #$group
-                           #:environment-variables
-                           (list
-                            (string-append
-                             "HOME=" (passwd:dir (getpwnam #$user)))))
+                           #$(restic-backup-job-command
+                              name files #:home-service? home-service?)
+                           #$@(if home-service? '() (list #:user user))
+                           #$@(if home-service? '() (list #:group group))
+                           #$@(if home-service? '()
+                                  (list
+                                   #:environment-variables
+                                   #~(list
+                                      (string-append
+                                       "HOME=" (passwd:dir (getpwnam #$user)))))))
                           #:log-file #$log-file
                           #:wait-for-termination? #$wait-for-termination?
                           #:max-duration #$(and (maybe-value-set? max-duration)
                                                 max-duration)))
                       (stop
                        #~(make-timer-destructor))
-                      (actions (list shepherd-trigger-action)))))
+                      (actions (list (shepherd-action
+                                      (inherit shepherd-trigger-action)
+                                      (documentation "Manually trigger a backup,
+without waiting for the scheduled time.")))))))
 
 (define (restic-guix-wrapper-package jobs)
   (package
@@ -283,26 +355,19 @@  (define restic-backup-service-profile
          (restic-guix-wrapper-package jobs))
         '())))
 
-(define (restic-backup-activation config)
-  #~(for-each
-     (lambda (log-file)
-       (mkdir-p (dirname log-file)))
-     (list #$@(map restic-job-log-file
-                   (restic-backup-configuration-jobs config)))))
-
 (define restic-backup-service-type
   (service-type (name 'restic-backup)
                 (extensions
                  (list
-                  (service-extension activation-service-type
-                                     restic-backup-activation)
                   (service-extension profile-service-type
                                      restic-backup-service-profile)
                   (service-extension shepherd-root-service-type
-                                     (lambda (config)
-                                       (map restic-backup-job->shepherd-service
-                                            (restic-backup-configuration-jobs
-                                             config))))))
+                                     (match-record-lambda <restic-backup-configuration>
+                                         (jobs home-service?)
+                                       (map (lambda (job)
+                                              (restic-backup-job->shepherd-service
+                                               job #:home-service? home-service?))
+                                            jobs)))))
                 (compose concatenate)
                 (extend
                  (lambda (config jobs)