Generalise Restic declarations

* rename confusingly named restic-*-repository variables to restic-scheduled-*
* generalise repository handling, allowing local and REST repositories both as
  backup and cleanup targets
* generalise password handling, allowing passwords from pass or from files for
  backup, for cleanup and as part of a REST URL

1 files changed, 192 insertions, 114 deletions

diff --git a/tw/services/restic.scm b/tw/services/restic.scm
index 60fc965a..68bab007 100644
--- a/tw/services/restic.scm
+++ b/tw/services/restic.scm
@@ -15,17 +15,75 @@
   #:use-module (guix packages)
   #:use-module ((guix records)
                 #:select (match-record))
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (restic-server-service-type
             restic-server-configuration
+            restic-password-source
+            restic-local-repository
+            restic-rest-repository
+            home-restic-cleanup-service-type
             restic-cleanup-service-type
-            restic-cleanup-repository
+            restic-scheduled-cleanup
             home-restic-backup-service-type
-            restic-rest-repository
-            restic-backup-repository))
+            restic-backup-service-type
+            restic-scheduled-backup))
+
+;; Common constants and records
+
+(define (password-source-kind? thing)
+  (and (symbol? thing)
+       (memq thing '(file pass))))
+
+(define-configuration/no-serialization restic-password-source
+  (type password-source-kind "Where the password is retrieved from;
+@code{file} to read a file or @code{pass} to take the first line of a
+password-store entry.")
+  (name string "The name of the file or password-store key to read."))
 
-(define %restic-user "restic")
-(define %restic-group "restic")
+(define-configuration/no-serialization restic-rest-repository
+  (username string "The HTTP username for the repository.")
+  (password restic-password-source "Where to get the repo's HTTP password.")
+  (hostname string "The hostname serving the repository.")
+  (port (integer 80) "The port number to connect to.")
+  (path (string "/") "The HTTP path at which the repository is found."))
+
+(define-configuration/no-serialization restic-local-repository
+  (path string "The directory name at which the repository is located."))
+
+(define (restic-repository? thing)
+  (or (restic-local-repository? thing)
+      (restic-rest-repository? thing)))
+
+(define (set-restic-variables repository password-source)
+  (define repo-string
+    (match repository
+      (($ <restic-local-repository> path)
+       path)
+      (($ <restic-rest-repository> username repo-pw hostname port path)
+       (let ((password-reader
+              (match repo-pw
+                (($ <restic-password-source> 'pass key)
+                 #~(let* ((pass #$(file-append password-store "/bin/pass"))
+                          (pipe (open-pipe* OPEN_READ pass "show" #$key))
+                          (line (get-line pipe)))
+                     (close-pipe pipe)
+                     line))
+                (($ <restic-password-source> 'file name)
+                 #~(string-trim-right
+                    #\newline (call-with-input-file #$name get-string-all))))))
+         #~(format #f "rest:http://~a:~a@~a:~a/~a" #$username #$password-reader
+                   #$hostname #$port #$(string-trim path #\/))))))
+
+  #~(begin
+      (setenv "RESTIC_REPOSITORY" #$repo-string)
+      #$(match password-source
+          (($ <restic-password-source> 'pass key)
+           #~(setenv "RESTIC_PASSWORD_COMMAND"
+                     (string-append
+                      #$(file-append password-store "/bin/pass") " show " #$key)))
+          (($ <restic-password-source> 'file name)
+           #~(setenv "RESTIC_PASSWORD_FILE" #$name)))))
 
 
 ;; Restic REST server
@@ -40,6 +98,9 @@
 restic's repositories and @code{.htpasswd} file, unless otherwise configured
 using @code{htpasswd-file}.")
   (restic-server (package restic-rest-server) "The restic REST server package to use.")
+  (user (string "restic") "The UNIX user to run the server as.  This user will be created.")
+  (group (string "restic") "The UNIX group to assign the server user to.  This
+group will be created.")
   (bind-address (string ":8000") "The listen address (including port) to bind to.")
   (htpasswd-file (maybe-string) "Location of @code{.htpasswd} file (default:
 @code{REPOSITORY-PATH/.htpasswd}).  Use @code{htpasswd} from the @code{httpd}
@@ -58,44 +119,48 @@ private restic repos.")
 
 (define (restic-server-arguments config)
   "Turn CONFIG into a list of arguments to the restic-rest-server executable."
-  `("--path" ,(restic-server-configuration-repository-path config)
-    "--listen" ,(restic-server-configuration-bind-address config)
-    ,@(let ((htpasswd-file (restic-server-configuration-htpasswd-file config)))
-        (if (string? htpasswd-file) `("--htpasswd-file" ,htpasswd-file) '()))
-    ,@(if (restic-server-configuration-auth? config) '() '("--no-auth"))
-    ,@(if (restic-server-configuration-verify-upload? config) '() '("--no-verify-upload"))
-    ,@(if (restic-server-configuration-append-only? config) '("--append-only") '())
-    ,@(let ((max-size (restic-server-configuration-max-repository-size config)))
-        (if (integer? max-size) `("--max-size" ,max-size) '()))
-    ,@(if (restic-server-configuration-private-repos-only? config) '("--private-repos") '())
-    ,@(if (restic-server-configuration-prometheus? config) '("--prometheus") '())
-    ,@(if (restic-server-configuration-prometheus-auth? config) '() '("--prometheus-no-auth"))))
+  (match-record config <restic-server-configuration>
+    (repository-path bind-address htpasswd-file auth? verify-upload? append-only?
+                     max-repository-size private-repos-only? prometheus? prometheus-auth?)
+    `("--path" ,repository-path
+      "--listen" ,bind-address
+      ,@(if (string? htpasswd-file) `("--htpasswd-file" ,htpasswd-file) '())
+      ,@(if auth? '() '("--no-auth"))
+      ,@(if verify-upload? '() '("--no-verify-upload"))
+      ,@(if append-only? '("--append-only") '())
+      ,@(if (integer? max-repository-size) `("--max-size" ,max-repository-size) '())
+      ,@(if private-repos-only? '("--private-repos") '())
+      ,@(if prometheus? '("--prometheus") '())
+      ,@(if prometheus-auth? '() '("--prometheus-no-auth")))))
 
 (define (restic-server-service config)
   "Create a `shepherd-service' for the restic REST server from CONFIG."
-  (list (shepherd-service
-         (provision '(restic-server))
-         (requirement '(networking))
-         (documentation "Run the Restic REST server to serve backup repositories via HTTP.")
-         (start #~(make-forkexec-constructor
-                   (list #$(file-append (restic-server-configuration-restic-server config)
-                                        "/bin/restic-rest-server")
-                         #$@(restic-server-arguments config))
-                   #:user #$%restic-user #:group #$%restic-group))
-         (stop #~(make-kill-destructor)))))
+  (match-record config <restic-server-configuration>
+    (restic-server user group)
+    (list (shepherd-service
+           (provision '(restic-server))
+           (requirement '(networking))
+           (documentation "Run the Restic REST server to serve backup repositories via HTTP.")
+           (start #~(make-forkexec-constructor
+                     (list #$(file-append restic-server "/bin/restic-rest-server")
+                           #$@(restic-server-arguments config))
+                     #:user #$user #:group #$group))
+           (stop #~(make-kill-destructor))))))
 
 (define (restic-server-accounts config)
   "Create user accounts and groups for the restic REST server defined in CONFIG."
-  (list (user-account
-         (name %restic-user)
-         (group %restic-group)
-         (comment "Restic server user")
-         (system? #t)
-         (home-directory (restic-server-configuration-repository-path config))
-         (shell (file-append shadow "/sbin/nologin")))
-        (user-group
-         (name %restic-group)
-         (system? #t))))
+  (match-record config <restic-server-configuration>
+    (user group repository-path)
+    (list (user-account
+           (name user)
+           (group group)
+           (comment "Restic server user")
+           (system? #t)
+           (home-directory repository-path)
+           (shell (file-append shadow "/sbin/nologin")))
+          (user-group
+           (name group)
+           (system? #t)))))
 
 (define restic-server-service-type
   (service-type
@@ -109,16 +174,20 @@ private restic repos.")
 
 ;; Restic cleanup cronjobs
 
-(define-maybe list-of-strings)
+(define-maybe/no-serialization list-of-strings)
 
-(define-configuration/no-serialization restic-cleanup-repository
+(define-configuration/no-serialization restic-scheduled-cleanup
   (schedule gexp "An mcron schedule, specified as a gexp (@pxref{G-Expressions}),
  to use for the cleanup job.  String, list or lambda syntax is fine
 (@pxref{Syntax, mcron job specifications,, mcron,GNU@tie{}mcron}).")
-  (url string "The directory path (or URL) of the restic repository to clean up.")
-  (password-file string "The file name containing the repository password.
-Must be readable by the @code{%restic-user}.")
+  (repo restic-repository "The restic repository to clean up, e.g. a
+@code{restic-local-repository}.")
+  (password restic-password-source "Where to get the repository password from.
+If it's of @code{file} type, must be readable by the @code{user} given below.")
   (restic (package restic) "The restic package to use.")
+  (user maybe-string "The UNIX user to run the cleanup as.  By default, run as
+@code{root} for system services, or the current user for home services.  The
+user given must already exist on the system; it is not declared.")
   (snapshot-host (maybe-string) "Only consider snapshots from this host.")
   (snapshot-paths (maybe-list-of-strings) "Only consider snapshots which
 include these paths.")
@@ -132,53 +201,68 @@ include these paths.")
   (keep-within (maybe-string) "Keep snapshots newer than the given duration
 relative to the latest snapshot."))
 
-(define (restic-cleanup-cronjobs repositories)
+(define (restic-cleanup-cronjobs configs)
   (define (arg-with-value arg value)
     "Produce a list for the given command-line argument with optional value.
 The result is inteded to be substituted into a `gexp' using `#$@', e.g. into
 an `execl' call.  Numbers are converted to strings as if by `display'.  Lists
 are turned into multiple arguments.  For booleans, ARG is returned if VALUE is
 true."
-    (define (to-string thing)
-      (format #f "~a" thing))
+    (define (arg+single-value single-value)
+      (list arg (format #f "~a" single-value)))
     (cond
      ((not (maybe-value-set? value))
       '())
      ((boolean? value)
       (if value (list arg) '()))
      ((list? value)
-      (append-map (lambda (item)
-                    (list arg (to-string item)))
-                  value))
+      (append-map arg+single-value value))
      (else
-      (list arg (to-string value)))))
+      (arg+single-value value))))
+
+  (define (repo-path-basename repo)
+    (string-trim-right
+     (basename
+      (match repo
+        (($ <restic-local-repository> path) path)
+        (($ <restic-rest-repository> _ _ _ _ path) path)))
+     #\/))
 
-  (define (cronjob repo)
-    #~(job #$(restic-cleanup-repository-schedule repo)
-           #$(program-file
-                 ;; Make cron commands for different repos easier to distinguish.
-                 (format #f "restic-cleanup-~a-command"
-                         (string-trim-right (basename (restic-cleanup-repository-url repo)) #\/))
-               #~(begin
-                   ;; `setgid' first, while we're still root.
-                   (setgid (group:gid (getgr #$%restic-group)))
-                   (setuid (passwd:uid (getpw #$%restic-user)))
-                   (setenv "RESTIC_REPOSITORY" '#$(restic-cleanup-repository-url repo))
-                   (setenv "RESTIC_PASSWORD_FILE" '#$(restic-cleanup-repository-password-file repo))
-                   (execl #$(file-append (restic-cleanup-repository-restic repo) "/bin/restic")
-                          "restic" "forget" "--no-cache"
-                          #$@(arg-with-value "--prune" (restic-cleanup-repository-prune? repo))
-                          #$@(arg-with-value "--host" (restic-cleanup-repository-snapshot-host repo))
-                          #$@(arg-with-value "--path" (restic-cleanup-repository-snapshot-paths repo))
-                          #$@(arg-with-value "--keep-within" (restic-cleanup-repository-keep-within repo))
-                          #$@(arg-with-value "--keep-last" (restic-cleanup-repository-keep-last repo))
-                          #$@(arg-with-value "--keep-hourly" (restic-cleanup-repository-keep-hourly repo))
-                          #$@(arg-with-value "--keep-daily" (restic-cleanup-repository-keep-daily repo))
-                          #$@(arg-with-value "--keep-weekly" (restic-cleanup-repository-keep-weekly repo))
-                          #$@(arg-with-value "--keep-monthly" (restic-cleanup-repository-keep-monthly repo))
-                          #$@(arg-with-value "--keep-yearly" (restic-cleanup-repository-keep-yearly repo)))))))
+  (define (cronjob config)
+    (match-record config <restic-scheduled-cleanup>
+      (schedule repo password restic user snapshot-host snapshot-paths prune?
+                keep-last keep-hourly keep-daily keep-weekly keep-monthly keep-yearly keep-within)
+      #~(job #$schedule
+             #$(program-file
+                   ;; Make cron commands for different repos easier to distinguish.
+                   (string-append "restic-cleanup-" (repo-path-basename repo) "-command")
+                 #~(begin
+                     #$(set-restic-variables repo password)
+                     (execl #$(file-append restic "/bin/restic")
+                            "restic" "forget" "--no-cache"
+                            #$@(arg-with-value "--prune" prune?)
+                            #$@(arg-with-value "--host" snapshot-host)
+                            #$@(arg-with-value "--path" snapshot-paths)
+                            #$@(arg-with-value "--keep-within" keep-within)
+                            #$@(arg-with-value "--keep-last" keep-last)
+                            #$@(arg-with-value "--keep-hourly" keep-hourly)
+                            #$@(arg-with-value "--keep-daily" keep-daily)
+                            #$@(arg-with-value "--keep-weekly" keep-weekly)
+                            #$@(arg-with-value "--keep-monthly" keep-monthly)
+                            #$@(arg-with-value "--keep-yearly" keep-yearly))))
+             #$@(if (maybe-value-set? user) (list #:user user) '()))))
 
-  (map cronjob repositories))
+  (map cronjob configs))
+
+(define home-restic-cleanup-service-type
+  (service-type
+   (name 'restic-cleanup)
+   (extensions
+    (list (service-extension home-mcron-service-type restic-cleanup-cronjobs)))
+   (compose concatenate)
+   (extend append)
+   (default-value '())
+   (description "Clean up old restic snapshots on a schedule.")))
 
 (define restic-cleanup-service-type
   (service-type
@@ -196,55 +280,39 @@ true."
 (define (nonempty-list-of-strings? thing)
   (and (pair? thing) (list-of-strings? thing)))
 
-(define-configuration/no-serialization restic-rest-repository
-  (username string "The HTTP username for the repository.")
-  (password-key string "The password-store key of the repo's HTTP password.")
-  (hostname string "The hostname serving the repository.")
-  (port (integer 80) "The port number to connect to.")
-  (path (string "/") "The HTTP path at which the repository is found."))
-
-(define-configuration/no-serialization restic-backup-repository
+(define-configuration/no-serialization restic-scheduled-backup
   (schedule gexp "An mcron schedule, specified as a gexp
 (@pxref{G-Expressions}), to use for the backup job.  String, list or lambda
 syntax is fine (@pxref{Syntax, mcron job specifications,, mcron,
 GNU@tie{}mcron}).")
   (paths nonempty-list-of-strings "List of paths to back up.  At least one
 must be given.  Leading @code{~/} are replaced with @code{$HOME}.")
-  (url restic-rest-repository "Back up to the given @code{rest:} repository.")
-  (password-key string "Obtain the repository password from password-store at
-the given key.")
+  (repo restic-repository "Back up to the given repository, e.g. a
+@code{restic-local-repository} or a @code{restic-rest-repository}.")
+  (password restic-password-source "Obtain the repository password from this source.")
   (tags (list-of-strings '()) "Optional tags to add to the snapshot.")
   (restic (package restic) "The restic package to use."))
 
-(define (restic-backup-cronjobs repositories)
-  (define (cronjob repo)
-    (match-record repo <restic-backup-repository>
-      (schedule paths url password-key tags restic)
-      (match-record url <restic-rest-repository>
-        (username hostname port path)
-        #~(job #$schedule
-               #$(program-file "restic-backup-command"
-                   #~(begin
-                       (use-modules (ice-9 popen)
-                                    (ice-9 textual-ports)
-                                    (srfi srfi-1))
-                       (define pass #$(file-append password-store "/bin/pass"))
-                       (define (replace-home path)
-                         (if (string-prefix? "~/" path)
-                             (string-replace path (getenv "HOME") 0 1)
-                             path))
-                       (let ((pipe (open-pipe* OPEN_READ pass #$(restic-rest-repository-password-key url))))
-                         (setenv "RESTIC_REPOSITORY"
-                                 (format #f "rest:http://~a:~a@~a:~a/~a"
-                                         #$username (get-line pipe) #$hostname #$port
-                                         (string-trim #$path #\/)))
-                         (close-pipe pipe))
-                       (setenv "RESTIC_PASSWORD_COMMAND" (string-append pass " " #$password-key))
-                       (apply execl #$(file-append restic "/bin/restic")
-                              "restic" "backup" "--cleanup-cache"
-                              #$@(append-map (lambda (tag) (list "--tag" tag)) tags)
-                              (map replace-home '#$paths))))))))
-  (map cronjob repositories))
+(define (restic-backup-cronjobs configs)
+  (define (cronjob config)
+    (match-record config <restic-scheduled-backup>
+      (schedule paths repo password tags restic)
+      #~(job #$schedule
+             #$(program-file "restic-backup-command"
+                 #~(begin
+                     (use-modules (ice-9 popen)
+                                  (ice-9 textual-ports)
+                                  (srfi srfi-1))
+                     (define (replace-home path)
+                       (if (string-prefix? "~/" path)
+                           (string-replace path (getenv "HOME") 0 1)
+                           path))
+                     #$(set-restic-variables repo password)
+                     (apply execl #$(file-append restic "/bin/restic")
+                            "restic" "backup" "--cleanup-cache"
+                            #$@(append-map (lambda (tag) (list "--tag" tag)) tags)
+                            (map replace-home '#$paths)))))))
+  (map cronjob configs))
 
 (define home-restic-backup-service-type
   (service-type
@@ -255,3 +323,13 @@ the given key.")
    (extend append)
    (default-value '())
    (description "Back up local directories on a schedule.")))
+
+(define restic-backup-service-type
+  (service-type
+   (name 'restic-backup)
+   (extensions
+    (list (service-extension mcron-service-type restic-backup-cronjobs)))
+   (compose concatenate)
+   (extend append)
+   (default-value '())
+   (description "Back up local directories on a schedule.")))