[bug#58086] [PATCH] gnu: Add fstrim-service-type.

[iyzsong]

From: 宋文武 <iyzsong@member.fsf.org>

A timestamp file "/var/lib/mcron/fstrim.stamp" is used to ensure we will
catch up on missed job runs when the system was powered down.

* gnu/services/mcron.scm (%mcron-activation): New extension to create
'/var/lib/mcron'.
* gnu/services/admin.scm (fstrim-configuration): New record type.
(fstrim-mcron-jobs): New procedure.
(fstrim-service-type): New service type.
---
 gnu/services/admin.scm | 56 +++++++++++++++++++++++++++++++++++++++++-
 gnu/services/mcron.scm |  8 ++++++
 2 files changed, 63 insertions(+), 1 deletion(-)

diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 252bedb0bd..2b22fc5b33 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -21,6 +21,7 @@
 (define-module (gnu services admin)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages certs)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages package-management)
   #:use-module (gnu services)
   #:use-module (gnu services mcron)
@@ -30,6 +31,7 @@ (define-module (gnu services admin)
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:export (%default-rotations
             %rotated-files
@@ -63,7 +65,11 @@ (define-module (gnu services admin)
             unattended-upgrade-configuration-services-to-restart
             unattended-upgrade-configuration-system-expiration
             unattended-upgrade-configuration-maximum-duration
-            unattended-upgrade-configuration-log-file))
+            unattended-upgrade-configuration-log-file
+
+            fstrim-service-type
+            fstrim-configuration
+            fstrim-configuration?))
 
 ;;; Commentary:
 ;;;
@@ -376,4 +382,52 @@ (define unattended-upgrade-service-type
     "Periodically upgrade the system from the current configuration.")
    (default-value (unattended-upgrade-configuration))))
 
+
+;;;
+;;; fstrim.
+;;;
+
+(define-record-type* <fstrim-configuration>
+  fstrim-configuration make-fstrim-configuration fstrim-configuration?
+  (command  fstrim-configuration-command
+            (default
+              (list (file-append util-linux "/sbin/fstrim")
+                    "--verbose" "--quiet-unsupported"
+                    "--listed-in" "/etc/fstab")))
+  (interval fstrim-configuration-interval (default (* 60 60 24 7)))) ; weekly
+
+;;; By storing the time of job's last run in a file, we can catch up on missed
+;;; runs when the system was powered down.
+(define fstrim-mcron-stamp "/var/lib/mcron/fstrim.stamp")
+
+(define fstrim-mcron-jobs
+  (match-lambda
+    (($ <fstrim-configuration> command interval)
+     (list
+      #~(job
+         (let ((last-time
+                (catch #t
+                  (lambda ()
+                    (with-input-from-file #$fstrim-mcron-stamp read))
+                  ;; We schedule a first run immediately.
+                  (const 0))))
+           (lambda (current-time)
+             (let ((next-time (max current-time (+ #$interval last-time))))
+               (set! last-time next-time)
+               next-time)))
+         (lambda ()
+           (apply system* '#$command)
+           (with-output-to-file #$fstrim-mcron-stamp
+             (lambda () (write (current-time))))))))))
+
+(define fstrim-service-type
+  (service-type
+   (name 'fstrim)
+   (extensions
+    (list (service-extension mcron-service-type
+                             fstrim-mcron-jobs)))
+   (description
+    "Periodically discard unused blocks on filesystems.")
+   (default-value (fstrim-configuration))))
+
 ;;; admin.scm ends here
diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm
index 23760ebda4..833d979ab4 100644
--- a/gnu/services/mcron.scm
+++ b/gnu/services/mcron.scm
@@ -154,6 +154,12 @@ (define mcron-shepherd-services
               (actions
                (list (shepherd-schedule-action mcron files)))))))))
 
+(define %mcron-activation
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+        (mkdir-p "/var/lib/mcron"))))
+
 (define mcron-service-type
   (service-type (name 'mcron)
                 (description
@@ -161,6 +167,8 @@ (define mcron-service-type
                 (extensions
                  (list (service-extension shepherd-root-service-type
                                           mcron-shepherd-services)
+                       (service-extension activation-service-type
+                                          (const %mcron-activation))
                        (service-extension profile-service-type
                                           (compose list
                                                    
mcron-configuration-mcron))))
-- 
2.37.3