From 2fb7a62710d17cee87c5cf4c73df49fdee3b668f Mon Sep 17 00:00:00 2001
From: raingloom <raingloom@riseup.net>
Date: Fri, 8 Jan 2021 23:02:01 +0100
Subject: [PATCH 3/3] WIP: gnu: services: Added basics of snapper service.
---
gnu/packages/linux.scm | 7 ++++-
gnu/services/linux.scm | 60 ++++++++++++++++++++++++++++++++++++++++++
2 files changed, 66 insertions(+), 1 deletion(-)
@@ -5083,6 +5083,10 @@ obviously it can be shared with files outside our set).")
(license license:gpl2+)))
(define-public snapper
+ ;; TODO: create full system tests
+ ;; FIXME: client can't find "config template". what even is that.
+ ;; TODO: generate /etc/sysconfig/snapper from Guix
+ ;; TODO: snapperd should take a command line argument instead of hardcoding config path
(package
(name "snapper")
(version "0.8.15")
@@ -5146,7 +5150,8 @@ obviously it can be shared with files outside our set).")
(("(pam_snapperdir = )/usr(/lib/pam_snapper)" _ before after)
(string-append before out after)))
(substitute* "data/Makefile.am"
- (("\\$\\(DESTDIR\\)") out))
+ (("\\$\\(DESTDIR\\)") out)
+ (("/usr/") "/"))
(substitute* "pam/Makefile.am"
(("(securelibdir = )\\$\\(shell echo /`basename \\$\\(libdir\\)`/security\\)" _ before)
(string-append before out "/lib/security"))))))
@@ -24,6 +24,7 @@
#:use-module (guix modules)
#:use-module (gnu services)
#:use-module (gnu services base)
+ #:use-module (gnu services dbus)
#:use-module (gnu services shepherd)
#:use-module (gnu packages linux)
#:use-module (srfi srfi-1)
@@ -46,6 +47,11 @@
kernel-module-loader-service-type
+ snapper-configuration
+ snapper-configuration?
+ snapper-configuration-snapper
+ snapper-service-type
+
zram-device-configuration
zram-device-configuration?
zram-device-configuration-size
@@ -187,6 +193,60 @@ representation."
(extend append)
(default-value '())))
+
+;;;
+;;; File system snapshotter
+;;;
+
+;; TODO: other services might want to extend it with filters
+;; TODO: extend PAM and snapshot home on login (see man pam_snapper)
+;; TODO: convert pam_snapper_homeconvert.sh into a shepherd service
+;; TODO: data type for snapper configs
+
+(define-record-type* <snapper-configuration>
+ snapper-configuration make-snapper-configuration
+ snapper-configuration?
+ (snapper snapper-configuration-snapper
+ (default snapper)))
+
+(define (snapper-scm->config key)
+ (let* ((key-lo (string-downcase key))
+ (maybe-scm-key (assoc-ref
+ '(("file-system-type" . "fstype")
+ ("quote-group" . "qgroup"))
+ key-lo)))
+ (string-upcase
+ (string-map
+ (lambda (c)
+ (if (eq? #\- c)
+ #\_
+ c))
+ (or maybe-scm-key key-lo)))))
+
+(define (snapper-shepherd-service config)
+ (shepherd-service
+ (documentation "Run the Snapper daemon (snapperd).")
+ (provision '(snapperd))
+ (start #~(make-forkexec-constructor
+ '#$(list (file-append
+ (snapper-configuration-snapper config)
+ "/sbin/snapperd"))
+ #:log-file "/var/log/snapperd.log"))
+ (stop #~(make-kill-destructor))))
+
+(define snapper-service-type
+ (service-type
+ (name 'snapper)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ (compose list snapper-shepherd-service))
+ (service-extension dbus-root-service-type
+ (compose list snapper-configuration-snapper))))
+ (default-value (snapper-configuration))
+ (description
+ "Create periodic snapshots on BTRFS subvolumes and thin LVM volumes")))
+
;;;
;;; Kernel module loader.
--
2.30.0