services: Add restic-backup service.

* gnu/services/backup.scm: New file.
* gnu/local.mk: Add this.
* doc/guix.texi: Document this.

Change-Id: I9efd5559bb445b484107a7c27c2d0a65ccad1e66
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

1 files changed, 236 insertions, 0 deletions

diff --git a/gnu/services/backup.scm b/gnu/services/backup.scm
new file mode 100644
index 0000000000..555e9fc959
--- /dev/null
+++ b/gnu/services/backup.scm
@@ -0,0 +1,236 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 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 services backup)
+  #:use-module (gnu packages backup)
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services mcron)
+  #:use-module (guix build-system copy)
+  #:use-module (guix gexp)
+  #:use-module ((guix licenses)
+                #:prefix license:)
+  #:use-module (guix modules)
+  #:use-module (guix packages)
+  #:use-module (srfi srfi-1)
+  #:export (restic-backup-job
+            restic-backup-job?
+            restic-backup-job-fields
+            restic-backup-job-restic
+            restic-backup-job-user
+            restic-backup-job-name
+            restic-backup-job-repository
+            restic-backup-job-password-file
+            restic-backup-job-schedule
+            restic-backup-job-files
+            restic-backup-job-verbose?
+            restic-backup-job-extra-flags
+
+            restic-backup-configuration
+            restic-backup-configuration?
+            restic-backup-configuration-fields
+            restic-backup-configuration-jobs
+
+            restic-backup-job-program
+            restic-backup-job->mcron-job
+            restic-guix
+            restic-guix-wrapper-package
+            restic-backup-service-profile
+            restic-backup-service-type))
+
+(define (gexp-or-string? value)
+  (or (gexp? value)
+      (string? value)))
+
+(define (lowerable? value)
+  (or (file-like? value)
+      (gexp-or-string? value)))
+
+(define list-of-lowerables?
+  (list-of lowerable?))
+
+(define-configuration/no-serialization restic-backup-job
+  (restic
+   (package restic)
+   "The restic package to be used for the current job.")
+  (user
+   (string "root")
+   "The user used for running the current job.")
+  (name
+   (string)
+   "A string denoting a name for this job.")
+  (repository
+   (string)
+   "The restic repository target of this job.")
+  (password-file
+   (string)
+   "Name of the password file, readable by the configured @code{user}, that
+will be used to set the @code{RESTIC_PASSWORD} environment variable for the
+current job.")
+  (schedule
+   (gexp-or-string)
+   "A string or a gexp that will be passed as time specification in the mcron
+job specification (@pxref{Syntax, mcron job specifications,, mcron,
+GNU@tie{}mcron}).")
+  (files
+   (list-of-lowerables '())
+   "The list of files or directories to be backed up.  It must be a list of
+values that can be lowered to strings.")
+  (verbose?
+   (boolean #f)
+   "Whether to enable verbose output for the current 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."))
+
+(define list-of-restic-backup-jobs?
+  (list-of restic-backup-job?))
+
+(define-configuration/no-serialization restic-backup-configuration
+  (jobs
+   (list-of-restic-backup-jobs '())
+   "The list of backup jobs for the current system."))
+
+(define (restic-backup-job-program config)
+  (let ((restic
+         (file-append (restic-backup-job-restic config) "/bin/restic"))
+        (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
+         (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)))))
+
+(define (restic-guix jobs)
+  (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 (backup args)
+         (define name (third args))
+         (define program (get-program name))
+         (execlp program program))
+
+       (define (validate-args args)
+         (when (not (>= (length args) 3))
+           (error (string-append "Usage: " (basename (car args))
+                                 " backup NAME"))))
+
+       (define (main args)
+         (validate-args args)
+         (define action (second args))
+         (match action
+           ("backup"
+            (backup args))
+           (_
+            (error (string-append "Unknown action: " action)))))
+
+       (main (command-line)))))
+
+(define (restic-backup-job->mcron-job config)
+  (let ((user
+         (restic-backup-job-user config))
+        (schedule
+         (restic-backup-job-schedule config))
+        (name
+         (restic-backup-job-name config)))
+    #~(job #$schedule
+           #$(string-append "restic-guix backup " name)
+           #:user #$user)))
+
+(define (restic-guix-wrapper-package jobs)
+  (package
+    (name "restic-backup-service-wrapper")
+    (version "0.0.0")
+    (source (restic-guix jobs))
+    (build-system copy-build-system)
+    (arguments
+     (list #:install-plan #~'(("./" "/bin"))))
+    (home-page "https://restic.net")
+    (synopsis
+     "Easily interact from the CLI with Guix configured backups")
+    (description
+     "This package provides a simple wrapper around @code{restic}, handled
+by the @code{restic-backup-service-type}.  It allows for easily interacting
+with Guix configured backup jobs, for example for manually triggering a backup
+without waiting for the scheduled job to run.")
+    (license license:gpl3+)))
+
+(define restic-backup-service-profile
+  (lambda (config)
+    (define jobs (restic-backup-configuration-jobs config))
+    (if (> (length jobs) 0)
+        (list
+         (restic-guix-wrapper-package jobs))
+        '())))
+
+(define restic-backup-service-type
+  (service-type (name 'restic-backup)
+                (extensions
+                 (list
+                  (service-extension profile-service-type
+                                     restic-backup-service-profile)
+                  (service-extension mcron-service-type
+                                     (lambda (config)
+                                       (map restic-backup-job->mcron-job
+                                            (restic-backup-configuration-jobs
+                                             config))))))
+                (compose concatenate)
+                (extend
+                 (lambda (config jobs)
+                   (restic-backup-configuration
+                    (inherit config)
+                    (jobs (append (restic-backup-configuration-jobs config)
+                                  jobs)))))
+                (default-value (restic-backup-configuration))
+                (description
+                 "This service configures @code{mcron} jobs for running backups
+with @code{restic}.")))