Rosenthal/modules/rosenthal/services/file-systems.scm

;;; SPDX-FileCopyrightText: 2024, 2025 Hilton Chain <hako@ultrarare.space>
;;;
;;; SPDX-License-Identifier: GPL-3.0-or-later

(define-module (rosenthal services file-systems)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (gnu packages backup)
  #:use-module (gnu packages file-systems)
  #:use-module (rosenthal packages admin)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services linux)
  #:use-module (gnu services mcron)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:export (btrbk-service-type
            btrbk-configuration

            dumb-runtime-dir-service-type

            zfs-service-type
            zfs-configuration))


;;;
;;; Btrbk
;;;


(define-configuration btrbk-configuration
  (btrbk
   (file-like btrbk)
   "@code{btrbk} package to use.")
  (config-file
   (file-like (plain-file "empty" ""))
   "File-like object for btrbk configuration, see also @code{btrbk.conf(5)}.")
  (no-serialization))

(define (btrbk-etc-service config)
  `(("btrbk/btrbk.conf" ,(btrbk-configuration-config-file config))))

(define (btrbk-mcron-jobs config)
  (list #~(job next-hour-from
               #$(file-append (btrbk-configuration-btrbk config)
                              "/bin/btrbk run --quiet"))))

(define btrbk-service-type
  (service-type
   (name 'btrbk)
   (extensions
    (list (service-extension etc-service-type
                             btrbk-etc-service)
          (service-extension mcron-service-type
                             btrbk-mcron-jobs)))
   (default-value (btrbk-configuration))
   (description "Configure and run btrbk hourly.")))


;;;
;;; pam-dumb-runtime-dir
;;;


(define dumb-runtime-dir-activation
  #~(begin
      (use-modules (guix build utils))
      (mkdir-p "/run/user")
      (chmod "/run/user" #o0755)))

(define dumb-runtime-dir-pam-service
  (let ((optional-pam-entry
         (pam-entry
          (control "optional")
          (module
           (file-append
            pam-dumb-runtime-dir "/lib/security/pam_dumb_runtime_dir.so")))))
    (list (pam-extension
           (transformer
            (lambda (pam)
              (if (string=? (pam-service-name pam) "login")
                  (pam-service
                   (inherit pam)
                   (session
                    (cons optional-pam-entry
                          (pam-service-session pam))))
                  pam)))))))

(define dumb-runtime-dir-service-type
  (service-type
   (name 'dumb-runtime-dir)
   (extensions
    (list (service-extension activation-service-type
                             (const dumb-runtime-dir-activation))
          (service-extension pam-root-service-type
                             (const dumb-runtime-dir-pam-service))))
   (default-value #f)                   ;No default value required.
   (description "Create @code{XDG_RUNTIME_DIR} on login and never remove it.")))


;;;
;;; ZFS
;;;

(define-configuration/no-serialization zfs-configuration
  (volumes?
   (boolean #f)
   "")
  (auto-mount?
   (boolean #t)
   ""))

(define zfs-shepherd
  (match-record-lambda <zfs-configuration>
      (volumes? auto-mount?)
    (append
     (list
      (shepherd-service
        (provision '(file-system-zfs))
        (requirement
         `(zfs-import
           ,@(if volumes? '(zfs-volumes) '())
           ,@(if auto-mount? '(zfs-mount) '())))
        (start #~(const #t))
        (stop #~(const #f)))
      (shepherd-service
        (provision '(zfs-import))
        (requirement '(kernel-module-loader))
        (start
         #~(make-system-constructor
            (string-join
             (list #$(file-append zfs "/sbin/zpool") "import" "-a" "-N"))))
        (stop #~(const #f))))
     (if volumes?
         (list
          (shepherd-service
            (provision '(zfs-volumes))
            (requirement '(zfs-import))
            (start
             #~(make-system-constructor
                (string-join
                 ;; TODO: Patch references within zfs package instead.
                 (list "PATH=/run/current-system/profile/bin:/run/current-system/profile/sbin"
                       #$(file-append zfs "/bin/zvol_wait")))))
            (stop #~(const #f))))
         '())
     (if auto-mount?
         (list
          (shepherd-service
            (provision '(zfs-mount))
            (requirement '(zfs-import))
            (start
             #~(make-system-constructor
                (string-join
                 (list #$(file-append zfs "/sbin/zfs") "mount" "-a" "-l"))))
            (stop
             #~(make-system-destructor
                (string-join
                 (list #$(file-append zfs "/sbin/zfs") "unmount" "-a"))))))
         '()))))

(define zfs-service-type
  (service-type
    (name 'zfs)
    (extensions
     (list (service-extension linux-loadable-module-service-type
                              (const (list `(,zfs "module"))))
           (service-extension udev-service-type
                              (const (list zfs)))
           (service-extension kernel-module-loader-service-type
                              (const '("zfs")))
           (service-extension shepherd-root-service-type
                              zfs-shepherd)
           (service-extension user-processes-service-type
                              (const '(file-system-zfs)))
           (service-extension profile-service-type
                              (const (list zfs)))))
    (default-value (zfs-configuration))
    (description "")))