path: root/tw/services/restic.scm

(define-module (tw services restic)
  #:use-module (gnu)
  #:use-module (gnu home services mcron)
  #:use-module ((gnu packages admin)
                #:select (shadow))
  #:use-module ((gnu packages backup)
                #:select (restic restic-rest-server))
  #:use-module ((gnu packages password-utils)
                #:select (password-store))
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services mcron)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #: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-scheduled-cleanup
            home-restic-backup-service-type
            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-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

(define-maybe/no-serialization integer)
(define-maybe/no-serialization string)

;; TODO: implement --tls, --tls-cert and --tls-key, maybe using certbot-service-type?
;; TODO: implement --log
(define-configuration/no-serialization restic-server-configuration
  (repository-path (string "/var/lib/restic") "The directory containing
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}
package to create and/or update this file.")
  (auth? (boolean #t) "Whether to authenticate users at all (using .htpasswd).")
  (verify-upload? (boolean #t) "Whether to verify the integrity of uploaded
data.  @emph{Do not disable} unless the restic server is to be run on a very
low-power device.")
  (append-only? (boolean #f) "Whether to run the restic server in append-only mode.")
  (max-repository-size (maybe-integer) "Maximum repository size in bytes, if any.")
  (private-repos-only? (boolean #f) "Whether to let users only access their
private restic repos.")
  (prometheus? (boolean #f) "Whether to serve Prometheus metrics.")
  (prometheus-auth? (boolean #t) "Whether to require authentication as the
@code{metrics} user to access the Prometheus /metrics endpoint."))

(define (restic-server-arguments config)
  "Turn CONFIG into a list of arguments to the restic-rest-server executable."
  (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."
  (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."
  (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
   (name 'restic-server)
   (extensions
    (list (service-extension shepherd-root-service-type restic-server-service)
          (service-extension account-service-type restic-server-accounts)))
   (description
    "Restic REST server, running as a service user instead of root.")))


;; Restic cleanup cronjobs

(define-maybe/no-serialization list-of-strings)

(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}).")
  (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.")
  (prune? (boolean #t) "Immediately prune the repo after deleting snapshots.")
  (keep-last (maybe-integer) "Keep the last N snapshots.")
  (keep-hourly (maybe-integer) "Keep the last N hourly snapshots.")
  (keep-daily (maybe-integer) "Keep the last N daily snapshots.")
  (keep-weekly (maybe-integer) "Keep the last N weekly snapshots.")
  (keep-monthly (maybe-integer) "Keep the last N monthly snapshots.")
  (keep-yearly (maybe-integer) "Keep the last N yearly snapshots.")
  (keep-within (maybe-string) "Keep snapshots newer than the given duration
relative to the latest snapshot."))

(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 (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 arg+single-value value))
     (else
      (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 (norm-keep number)
    ;; Guix' restic version doesn't seem to support "--keep-X=-1" to keep all
    ;; snapshots in the specified interval, so pass a very high number instead.
    (if (and (number? number)
             (= -1 number))
        1000000
        number))

  (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" (norm-keep keep-hourly))
                            #$@(arg-with-value "--keep-daily" (norm-keep keep-daily))
                            #$@(arg-with-value "--keep-weekly" (norm-keep keep-weekly))
                            #$@(arg-with-value "--keep-monthly" (norm-keep keep-monthly))
                            #$@(arg-with-value "--keep-yearly" (norm-keep keep-yearly)))))
             #$@(if (maybe-value-set? user) (list #:user user) '()))))

  (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
   (name 'restic-cleanup)
   (extensions
    (list (service-extension mcron-service-type restic-cleanup-cronjobs)))
   (compose concatenate)
   (extend append)
   (default-value '())
   (description "Clean up old restic snapshots on a schedule.")))


;; Restic scheduled backup jobs

(define (nonempty-list-of-strings? thing)
  (and (pair? thing) (list-of-strings? thing)))

(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}.")
  (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 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
   (name 'restic-backup)
   (extensions
    (list (service-extension home-mcron-service-type restic-backup-cronjobs)))
   (compose concatenate)
   (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.")))