aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/linux.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 16:57:37 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 17:15:08 -0400
commit3bacd3c76a58ebe70f98be654f09cbd4166093ab (patch)
tree89f687565205971a9925d33400235968a569a069 /gnu/services/linux.scm
parentdf3391c0309443ac37f9a9a6b1038a85454b8ee6 (diff)
parent97ed675718b948319e6f6e51f2d577971bea1176 (diff)
downloadguix-3bacd3c76a58ebe70f98be654f09cbd4166093ab.tar
guix-3bacd3c76a58ebe70f98be654f09cbd4166093ab.tar.gz
Merge branch 'master' into core-updates.
Conflicts: gnu/local.mk gnu/packages/build-tools.scm gnu/packages/certs.scm gnu/packages/check.scm gnu/packages/compression.scm gnu/packages/cups.scm gnu/packages/fontutils.scm gnu/packages/gnuzilla.scm gnu/packages/guile.scm gnu/packages/ibus.scm gnu/packages/image-processing.scm gnu/packages/linux.scm gnu/packages/music.scm gnu/packages/nss.scm gnu/packages/pdf.scm gnu/packages/python-xyz.scm gnu/packages/qt.scm gnu/packages/ruby.scm gnu/packages/shells.scm gnu/packages/tex.scm gnu/packages/video.scm gnu/packages/vulkan.scm gnu/packages/web.scm gnu/packages/webkit.scm gnu/packages/wm.scm
Diffstat (limited to 'gnu/services/linux.scm')
-rw-r--r--gnu/services/linux.scm101
1 files changed, 101 insertions, 0 deletions
diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm
index 60e2093e1d..4f28044112 100644
--- a/gnu/services/linux.scm
+++ b/gnu/services/linux.scm
@@ -5,6 +5,7 @@
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,12 +31,15 @@
#:use-module (guix ui)
#:use-module (gnu services)
#:use-module (gnu services base)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (gnu packages linux)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (earlyoom-configuration
earlyoom-configuration?
@@ -50,6 +54,16 @@
earlyoom-configuration-send-notification-command
earlyoom-service-type
+ fstrim-configuration
+ fstrim-configuration?
+ fstrim-configuration-package
+ fstrim-configuration-schedule
+ fstrim-configuration-listed-in
+ fstrim-configuration-verbose?
+ fstrim-configuration-quiet-unsupported?
+ fstrim-configuration-extra-arguments
+ fstrim-service-type
+
kernel-module-loader-service-type
rasdaemon-configuration
@@ -152,6 +166,93 @@ representation."
;;;
+;;; fstrim
+;;;
+
+(define (mcron-time? x)
+ (or (procedure? x) (string? x) (list? x)))
+
+(define-maybe list-of-strings (prefix fstrim-))
+
+(define (fstrim-serialize-boolean field-name value)
+ (list (format #f "~:[~;--~a~]" value
+ ;; Drop trailing '?' character.
+ (string-drop-right (symbol->string field-name) 1))))
+
+(define (fstrim-serialize-list-of-strings field-name value)
+ (list (string-append "--" (symbol->string field-name))
+ #~(string-join '#$value ":")))
+
+(define-configuration fstrim-configuration
+ (package
+ (file-like util-linux)
+ "The package providing the @command{fstrim} command."
+ empty-serializer)
+ (schedule
+ (mcron-time "0 0 * * 0")
+ "Schedule for launching @command{fstrim}. This can be a procedure, a list
+or a string. For additional information, see @ref{Guile Syntax,,
+Job specification, mcron, the mcron manual}. By default this is set to run
+weekly on Sunday at 00:00."
+ empty-serializer)
+ ;; The following are fstrim-related options.
+ (listed-in
+ (maybe-list-of-strings '("/etc/fstab" "/proc/self/mountinfo"))
+ ;; Note: documentation sourced from the fstrim manpage.
+ "List of files in fstab or kernel mountinfo format. All missing or
+empty files are silently ignored. The evaluation of the list @emph{stops}
+after the first non-empty file. File systems with @code{X-fstrim.notrim} mount
+option in fstab are skipped.")
+ (verbose?
+ (boolean #t)
+ "Verbose execution.")
+ (quiet-unsupported?
+ (boolean #t)
+ "Suppress error messages if trim operation (ioctl) is unsupported.")
+ (extra-arguments
+ maybe-list-of-strings
+ "Extra options to append to @command{fstrim} (run @samp{man fstrim} for
+more information)."
+ (serializer
+ (lambda (_ value)
+ (if (maybe-value-set? value)
+ value '()))))
+ (prefix fstrim-))
+
+(define (serialize-fstrim-configuration config)
+ (concatenate
+ (filter list?
+ (map (lambda (field)
+ ((configuration-field-serializer field)
+ (configuration-field-name field)
+ ((configuration-field-getter field) config)))
+ fstrim-configuration-fields))))
+
+(define (fstrim-mcron-job config)
+ (match-record config <fstrim-configuration> (package schedule)
+ #~(job
+ ;; Note: The “if” below is to ensure that
+ ;; lists are ungexp'd correctly since @var{schedule}
+ ;; can be either a procedure, a string or a list.
+ #$(if (list? schedule)
+ #~'(#$@schedule)
+ schedule)
+ (lambda ()
+ (system* #$(file-append package "/sbin/fstrim")
+ #$@(serialize-fstrim-configuration config)))
+ "fstrim")))
+
+(define fstrim-service-type
+ (service-type
+ (name 'fstrim)
+ (extensions
+ (list (service-extension mcron-service-type
+ (compose list fstrim-mcron-job))))
+ (description "Discard unused blocks from file systems.")
+ (default-value (fstrim-configuration))))
+
+
+;;;
;;; Kernel module loader.
;;;