projects/guix·blob librewolf-updates · refs

1239 lines · 46.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2020 Maxim Cournoyer <[email protected]>
3;;; Copyright © 2020 Brice Waegeneire <[email protected]>
4;;; Copyright © 2020, 2023 Efraim Flashner <[email protected]>
5;;; Copyright © 2021 raid5atemyhomework <[email protected]>
6;;; Copyright © 2021 B. Wilson <[email protected]>
7;;; Copyright © 2022 Josselin Poiret <[email protected]>
8;;; Copyright © 2023 Bruno Victal <[email protected]>
9;;; Copyright © 2023 Felix Lechner <[email protected]>
10;;; Copyright © 2025 Edouard Klein <[email protected]>
11;;; Copyright © 2026 Giacomo Leidi <[email protected]>
12;;;
13;;; This file is part of GNU Guix.
14;;;
15;;; GNU Guix is free software; you can redistribute it and/or modify it
16;;; under the terms of the GNU General Public License as published by
17;;; the Free Software Foundation; either version 3 of the License, or (at
18;;; your option) any later version.
19;;;
20;;; GNU Guix is distributed in the hope that it will be useful, but
21;;; WITHOUT ANY WARRANTY; without even the implied warranty of
22;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;;; GNU General Public License for more details.
24;;;
25;;; You should have received a copy of the GNU General Public License
26;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
27
28(define-module (gnu services linux)
29 #:use-module (guix diagnostics)
30 #:use-module (guix gexp)
31 #:use-module (guix records)
32 #:use-module (guix modules)
33 #:use-module (guix i18n)
34 #:use-module (guix packages)
35 #:use-module (guix ui)
36 #:use-module (gnu services)
37 #:use-module (gnu services admin)
38 #:use-module (gnu services base)
39 #:use-module (gnu services configuration)
40 #:use-module (gnu services dbus)
41 #:use-module (gnu services shepherd)
42 #:use-module (gnu system file-systems)
43 #:use-module (gnu packages base)
44 #:use-module (gnu packages linux)
45 #:use-module (gnu packages power)
46 #:use-module (gnu packages file-systems)
47 #:use-module (srfi srfi-1)
48 #:use-module (srfi srfi-26)
49 #:use-module (srfi srfi-34)
50 #:use-module (srfi srfi-35)
51 #:use-module (srfi srfi-171)
52 #:use-module (ice-9 format)
53 #:use-module (ice-9 match)
54 #:use-module (ice-9 string-fun)
55 #:export (earlyoom-configuration
56 earlyoom-configuration?
57 earlyoom-configuration-earlyoom
58 earlyoom-configuration-minimum-available-memory
59 earlyoom-configuration-minimum-free-swap
60 earlyoom-configuration-prefer-regexp
61 earlyoom-configuration-avoid-regexp
62 earlyoom-configuration-memory-report-interval
63 earlyoom-configuration-ignore-positive-oom-score-adj?
64 earlyoom-configuration-show-debug-messages?
65 earlyoom-configuration-send-notification-command
66 earlyoom-service-type
67
68 fstrim-configuration
69 fstrim-configuration?
70 fstrim-configuration-package
71 fstrim-configuration-schedule
72 fstrim-configuration-listed-in
73 fstrim-configuration-verbose?
74 fstrim-configuration-quiet-unsupported?
75 fstrim-configuration-extra-arguments
76 fstrim-service-type
77
78 kernel-module-loader-service-type
79
80 cachefilesd-configuration
81 cachefilesd-configuration?
82 cachefilesd-configuration-cachefilesd
83 cachefilesd-configuration-debug-output?
84 cachefilesd-configuration-use-syslog?
85 cachefilesd-configuration-scan?
86 cachefilesd-configuration-cache-directory
87 cachefilesd-configuration-cache-name
88 cachefilesd-configuration-security-context
89 cachefilesd-configuration-pause-culling-for-block-percentage
90 cachefilesd-configuration-pause-culling-for-file-percentage
91 cachefilesd-configuration-resume-culling-for-block-percentage
92 cachefilesd-configuration-resume-culling-for-file-percentage
93 cachefilesd-configuration-pause-caching-for-block-percentage
94 cachefilesd-configuration-pause-caching-for-file-percentage
95 cachefilesd-configuration-log2-table-size
96 cachefilesd-configuration-cull?
97 cachefilesd-configuration-trace-function-entry-in-kernel-module
98 cachefilesd-configuration-trace-function-exit-in-kernel-module
99 cachefilesd-configuration-trace-internal-checkpoints-in-kernel-module
100 cachefilesd-service-type
101
102 rasdaemon-configuration
103 rasdaemon-configuration?
104 rasdaemon-configuration-record?
105 rasdaemon-service-type
106
107 %default-tuned-configuration-recommend.conf
108 %default-tuned-ppd-settings-battery
109 %default-tuned-ppd-settings-profiles
110
111 tuned-configuration
112 tuned-configuration?
113 tuned-configuration-fields
114 tuned-configuration-tuned
115 tuned-configuration-auto-start?
116 tuned-configuration-power-profiles-daemon-support?
117 tuned-configuration-profiles
118 tuned-configuration-settings
119 tuned-configuration-ppd-settings
120 tuned-configuration-recommend.conf
121
122 tuned-settings
123 tuned-settings?
124 tuned-settings-fields
125 tuned-settings-daemon?
126 tuned-settings-dynamic-tuning?
127 tuned-settings-default-instance-priority
128 tuned-settings-recommend-command?
129 tuned-settings-sleep-interval
130 tuned-settings-update-interval
131 tuned-settings-profile-dirs
132 tuned-settings-extra-content
133
134 tuned-ppd-settings
135 tuned-ppd-settings?
136 tuned-ppd-settings-fields
137 tuned-ppd-settings-default
138 tuned-ppd-settings-battery-detection?
139 tuned-ppd-settings-sysfs-acpi-monitor?
140 tuned-ppd-settings-profiles
141 tuned-ppd-settings-battery
142 tuned-ppd-settings-extra-content
143
144 tuned-file-systems
145 tuned-activation
146 tuned-shepherd-services
147
148 tuned-service-type
149
150 zram-device-configuration
151 zram-device-configuration?
152 zram-device-configuration-size
153 zram-device-configuration-compression-algorithm
154 zram-device-configuration-memory-limit
155 zram-device-configuration-priority
156 zram-device-service-type
157
158 vfs-mapping-service-type
159 vfs-mapping-configuration
160 vfs-mapping))
161
162
163;;;
164;;; Early OOM daemon.
165;;;
166
167(define-record-type* <earlyoom-configuration>
168 earlyoom-configuration make-earlyoom-configuration
169 earlyoom-configuration?
170 (earlyoom earlyoom-configuration-earlyoom
171 (default earlyoom))
172 (minimum-available-memory earlyoom-configuration-minimum-available-memory
173 (default 10)) ; in percent
174 (minimum-free-swap earlyoom-configuration-minimum-free-swap
175 (default 10)) ; in percent
176 (prefer-regexp earlyoom-configuration-prefer-regexp ; <string>
177 (default #f))
178 (avoid-regexp earlyoom-configuration-avoid-regexp ; <string>
179 (default #f))
180 (memory-report-interval earlyoom-configuration-memory-report-interval
181 (default 0)) ; in seconds; 0 means disabled
182 (ignore-positive-oom-score-adj?
183 earlyoom-configuration-ignore-positive-oom-score-adj? (default #f))
184 (run-with-higher-priority? earlyoom-configuration-run-with-higher-priority?
185 (default #f))
186 (show-debug-messages? earlyoom-configuration-show-debug-messages?
187 (default #f))
188 (send-notification-command
189 earlyoom-configuration-send-notification-command ; <string>
190 (default #f)))
191
192(define (earlyoom-configuration->command-line-args config)
193 "Translate a <earlyoom-configuration> object to its command line arguments
194representation."
195 (match config
196 (($ <earlyoom-configuration> earlyoom minimum-available-memory
197 minimum-free-swap prefer-regexp avoid-regexp
198 memory-report-interval
199 ignore-positive-oom-score-adj?
200 run-with-higher-priority? show-debug-messages?
201 send-notification-command)
202 `(,(file-append earlyoom "/bin/earlyoom")
203 ,@(if minimum-available-memory
204 (list "-m" (format #f "~s" minimum-available-memory))
205 '())
206 ,@(if minimum-free-swap
207 (list "-s" (format #f "~s" minimum-free-swap))
208 '())
209 ,@(if prefer-regexp
210 (list "--prefer" prefer-regexp)
211 '())
212 ,@(if avoid-regexp
213 (list "--avoid" avoid-regexp)
214 '())
215 "-r" ,(format #f "~s" memory-report-interval)
216 ,@(if ignore-positive-oom-score-adj?
217 (list "-i")
218 '())
219 ,@(if run-with-higher-priority?
220 (list "-p")
221 '())
222 ,@(if show-debug-messages?
223 (list "-d")
224 '())
225 ,@(if send-notification-command
226 (list "-N" send-notification-command)
227 '())))))
228
229(define (earlyoom-shepherd-service config)
230 (shepherd-service
231 (documentation "Run the Early OOM daemon.")
232 (provision '(earlyoom))
233 (requirement '(user-processes))
234 (start #~(make-forkexec-constructor
235 '#$(earlyoom-configuration->command-line-args config)
236 #:log-file "/var/log/earlyoom.log"))
237 (stop #~(make-kill-destructor))))
238
239(define earlyoom-service-type
240 (service-type
241 (name 'earlyoom)
242 (default-value (earlyoom-configuration))
243 (extensions
244 (list (service-extension shepherd-root-service-type
245 (compose list earlyoom-shepherd-service))))
246 (description "Run @command{earlyoom}, a daemon that quickly responds to
247@acronym{OOM, out-of-memory} conditions by terminating relevant processes.")))
248
249
250;;;
251;;; fstrim
252;;;
253
254(define (shepherd-calendar-event? x)
255 (or (string? x) (gexp? x)))
256
257(define-maybe list-of-strings (prefix fstrim-))
258
259(define (fstrim-serialize-boolean field-name value)
260 (list (format #f "~:[~;--~a~]" value
261 ;; Drop trailing '?' character.
262 (string-drop-right (symbol->string field-name) 1))))
263
264(define (fstrim-serialize-list-of-strings field-name value)
265 (list (string-append "--" (symbol->string field-name))
266 #~(string-join '#$value ":")))
267
268(define-configuration fstrim-configuration
269 (package
270 (file-like util-linux)
271 "The package providing the @command{fstrim} command."
272 empty-serializer)
273 (schedule
274 (shepherd-calendar-event "0 0 * * 0")
275 "Schedule for launching @command{fstrim}, expressed as a string in
276traditional cron syntax or as a gexp evaluating to a Shepherd calendar
277event (@pxref{Timers,,, shepherd, The GNU Shepherd Manual}). By default this
278is set to run weekly on Sunday at 00:00."
279 empty-serializer)
280 ;; The following are fstrim-related options.
281 (listed-in
282 (maybe-list-of-strings '("/etc/fstab" "/proc/self/mountinfo"))
283 ;; Note: documentation sourced from the fstrim manpage.
284 "List of files in fstab or kernel mountinfo format. All missing or
285empty files are silently ignored. The evaluation of the list @emph{stops}
286after the first non-empty file. File systems with @code{X-fstrim.notrim} mount
287option in fstab are skipped.")
288 (verbose?
289 (boolean #t)
290 "Verbose execution.")
291 (quiet-unsupported?
292 (boolean #t)
293 "Suppress error messages if trim operation (ioctl) is unsupported.")
294 (extra-arguments
295 maybe-list-of-strings
296 "Extra options to append to @command{fstrim} (run @samp{man fstrim} for
297more information)."
298 (serializer
299 (lambda (_ value)
300 (if (maybe-value-set? value)
301 value '()))))
302 (prefix fstrim-))
303
304(define (serialize-fstrim-configuration config)
305 (list-transduce (compose (base-transducer config) tconcatenate)
306 rcons
307 fstrim-configuration-fields))
308
309(define (fstrim-shepherd-services config)
310 (match-record config <fstrim-configuration>
311 (package schedule)
312 (list (shepherd-service
313 (provision '(fstrim))
314 (requirement '(user-processes))
315 (modules '((shepherd service timer)))
316 (start #~(make-timer-constructor
317 #$(if (string? schedule)
318 #~(cron-string->calendar-event #$schedule)
319 schedule)
320 (command
321 (list #$(file-append package "/sbin/fstrim")
322 #$@(serialize-fstrim-configuration config)))
323 #:wait-for-termination? #t))
324 (stop #~(make-timer-destructor))
325 (documentation "Periodically run the 'fstrim' command.")
326 (actions (list shepherd-trigger-action))))))
327
328(define fstrim-service-type
329 (service-type
330 (name 'fstrim)
331 (extensions
332 (list (service-extension shepherd-root-service-type
333 fstrim-shepherd-services)))
334 (description "Discard unused blocks from file systems.")
335 (default-value (fstrim-configuration))))
336
337
338;;;
339;;; Kernel module loader.
340;;;
341
342(define kernel-module-loader-shepherd-service
343 (match-lambda
344 ((and (? list? kernel-modules) ((? string?) ...))
345 (shepherd-service
346 (documentation "Load kernel modules.")
347 (provision '(kernel-module-loader))
348 (requirement '(udev))
349 (one-shot? #t)
350 (modules `((srfi srfi-1)
351 (srfi srfi-34)
352 (srfi srfi-35)
353 (rnrs io ports)
354 ,@%default-modules))
355 (start
356 #~(lambda _
357 (cond
358 ((null? '#$kernel-modules) #t)
359 ((file-exists? "/proc/sys/kernel/modprobe")
360 (let ((modprobe (call-with-input-file
361 "/proc/sys/kernel/modprobe" get-line)))
362 (guard (c ((message-condition? c)
363 (format (current-error-port) "~a~%"
364 (condition-message c))
365 #f))
366 (every (lambda (module)
367 (invoke/quiet modprobe "--" module))
368 '#$kernel-modules))))
369 (else
370 (format (current-error-port) "error: ~a~%"
371 "Kernel is missing loadable module support.")
372 #f))))))))
373
374(define kernel-module-loader-service-type
375 (service-type
376 (name 'kernel-module-loader)
377 (description "Load kernel modules.")
378 (extensions
379 (list (service-extension shepherd-root-service-type
380 (compose list kernel-module-loader-shepherd-service))))
381 (compose concatenate)
382 (extend append)
383 (default-value '())))
384
385
386;;;
387;;; Cachefilesd, an FS-Cache daemon
388;;;
389
390(define (serialize-string variable-symbol value)
391 #~(format #f "~a ~a~%" #$(symbol->string variable-symbol) #$value))
392
393(define-maybe string)
394
395(define (non-negative-integer? val)
396 (and (exact-integer? val) (not (negative? val))))
397
398(define (serialize-non-negative-integer variable-symbol value)
399 #~(format #f "~a ~d~%" #$(symbol->string variable-symbol) #$value))
400
401(define-maybe non-negative-integer)
402
403(define (make-option-serializer option-symbol)
404 (lambda (variable-symbol text)
405 (if (maybe-value-set? text)
406 #~(format #f "~a ~a~%" #$(symbol->string option-symbol) #$text)
407 "")))
408
409(define (make-percentage-threshold-serializer threshold-symbol)
410 (lambda (variable-symbol percentage)
411 (if (maybe-value-set? percentage)
412 #~(format #f "~a ~a%~%" #$(symbol->string threshold-symbol) #$percentage)
413 "")))
414
415(define-configuration cachefilesd-configuration
416 (cachefilesd
417 (file-like cachefilesd)
418 "The cachefilesd package to use."
419 (serializer empty-serializer))
420
421 ;; command-line options
422 (debug-output?
423 (boolean #f)
424 "Print debugging output to stderr."
425 (serializer empty-serializer))
426
427 (use-syslog?
428 (boolean #t)
429 "Log to syslog facility instead of stdout."
430 (serializer empty-serializer))
431
432 ;; culling is part of the configuration file
433 ;; despite the name of the command-line option
434 (scan?
435 (boolean #t)
436 "Scan for cacheable objects."
437 (serializer empty-serializer))
438
439 ;; sole required field in the configuration file
440 (cache-directory
441 maybe-string
442 "Location of the cache directory."
443 (serializer (make-option-serializer 'dir)))
444
445 (cache-name
446 (maybe-string "CacheFiles")
447 "Name of cache (keep unique)."
448 (serializer (make-option-serializer 'tag)))
449
450 (security-context
451 maybe-string
452 "SELinux security context."
453 (serializer (make-option-serializer 'secctx)))
454
455 ;; percentage thresholds in the configuration file
456 (pause-culling-for-block-percentage
457 (maybe-non-negative-integer 7)
458 "Pause culling when available blocks exceed this percentage."
459 (serializer (make-percentage-threshold-serializer 'brun)))
460
461 (pause-culling-for-file-percentage
462 (maybe-non-negative-integer 7)
463 "Pause culling when available files exceed this percentage."
464 (serializer (make-percentage-threshold-serializer 'frun)))
465
466 (resume-culling-for-block-percentage
467 (maybe-non-negative-integer 5)
468 "Start culling when available blocks drop below this percentage."
469 (serializer (make-percentage-threshold-serializer 'bcull)))
470
471 (resume-culling-for-file-percentage
472 (maybe-non-negative-integer 5)
473 "Start culling when available files drop below this percentage."
474 (serializer (make-percentage-threshold-serializer 'fcull)))
475
476 (pause-caching-for-block-percentage
477 (maybe-non-negative-integer 1)
478 "Pause further allocations when available blocks drop below this percentage."
479 (serializer (make-percentage-threshold-serializer 'bstop)))
480
481 (pause-caching-for-file-percentage
482 (maybe-non-negative-integer 1)
483 "Pause further allocations when available files drop below this percentage."
484 (serializer (make-percentage-threshold-serializer 'fstop)))
485
486 ;; run time optimizations in the configuration file
487 (log2-table-size
488 (maybe-non-negative-integer 12)
489 "Size of tables holding cullable objects in logarithm of base 2."
490 (serializer (make-option-serializer 'culltable)))
491
492 (cull?
493 (boolean #t)
494 "Create free space by culling (consumes system load)."
495 (serializer
496 (lambda (variable-symbol value)
497 (if value "" "nocull\n"))))
498
499 ;; kernel module debugging in the configuration file
500 (trace-function-entry-in-kernel-module?
501 (boolean #f)
502 "Trace function entry in the kernel module (for debugging)."
503 (serializer empty-serializer))
504
505 (trace-function-exit-in-kernel-module?
506 (boolean #f)
507 "Trace function exit in the kernel module (for debugging)."
508 (serializer empty-serializer))
509
510 (trace-internal-checkpoints-in-kernel-module?
511 (boolean #f)
512 "Trace internal checkpoints in the kernel module (for debugging)."
513 (serializer empty-serializer)))
514
515(define (serialize-cachefilesd-configuration configuration)
516 (mixed-text-file
517 "cachefilesd.conf"
518 (serialize-configuration configuration cachefilesd-configuration-fields)))
519
520(define (cachefilesd-shepherd-service config)
521 "Return a list of <shepherd-service> for cachefilesd for CONFIG."
522 (match-record
523 config <cachefilesd-configuration> (cachefilesd
524 debug-output?
525 use-syslog?
526 scan?
527 cache-directory)
528 (let ((configuration-file (serialize-cachefilesd-configuration config)))
529 (shepherd-service
530 (documentation "Run the cachefilesd daemon for FS-Cache.")
531 (provision '(cachefilesd))
532 (requirement (append '(user-processes file-systems)
533 (if use-syslog? '(syslogd) '())))
534 (start #~(begin
535 (and=> #$(maybe-value cache-directory) mkdir-p)
536 (make-forkexec-constructor
537 `(#$(file-append cachefilesd "/sbin/cachefilesd")
538 ;; do not detach
539 "-n"
540 #$@(if debug-output? '("-d") '())
541 #$@(if use-syslog? '() '("-s"))
542 #$@(if scan? '() '("-N"))
543 "-f" #$configuration-file))))
544 (stop #~(make-kill-destructor))))))
545
546(define cachefilesd-service-type
547 (service-type
548 (name 'cachefilesd)
549 (description
550 "Run the file system cache daemon @command{cachefilesd}, which relies on
551the Linux @code{cachefiles} module.")
552 (extensions
553 (list (service-extension kernel-module-loader-service-type
554 (const '("cachefiles")))
555 (service-extension shepherd-root-service-type
556 (compose list cachefilesd-shepherd-service))))
557 (default-value (cachefilesd-configuration))))
558
559
560;;;
561;;; Reliability, Availability, and Serviceability (RAS) daemon
562;;;
563
564(define-record-type* <rasdaemon-configuration>
565 rasdaemon-configuration make-rasdaemon-configuration
566 rasdaemon-configuration?
567 (record? rasdaemon-configuration-record? (default #f)))
568
569(define (rasdaemon-configuration->command-line-args config)
570 "Translate <rasdaemon-configuration> to its command line arguments
571 representation"
572 (let ((record? (rasdaemon-configuration-record? config)))
573 `(,(file-append rasdaemon "/sbin/rasdaemon")
574 "--foreground" ,@(if record? '("--record") '()))))
575
576(define (rasdaemon-activation config)
577 (let ((record? (rasdaemon-configuration-record? config))
578 (rasdaemon-dir "/var/lib/rasdaemon"))
579 (with-imported-modules '((guix build utils))
580 #~(if #$record? (mkdir-p #$rasdaemon-dir)))))
581
582(define (rasdaemon-shepherd-service config)
583 (shepherd-service
584 (documentation "Run rasdaemon")
585 (provision '(rasdaemon))
586 (requirement '(user-processes syslogd))
587 (start #~(make-forkexec-constructor
588 '#$(rasdaemon-configuration->command-line-args config)))
589 (stop #~(make-kill-destructor))))
590
591(define rasdaemon-service-type
592 (service-type
593 (name 'rasdaemon)
594 (default-value (rasdaemon-configuration))
595 (extensions
596 (list (service-extension shepherd-root-service-type
597 (compose list rasdaemon-shepherd-service))
598 (service-extension activation-service-type rasdaemon-activation)))
599 (compose concatenate)
600 (description "Run @command{rasdaemon}, the RAS monitor")))
601
602
603;;;
604;;; TuneD.
605;;;
606
607(define (uglify-snake-case field-name)
608 "Serializes FIELD-NAME, a field name from @code{(gnu services configuration)},
609to a snake case string representation of the field name. Trailing @code{?} in
610the name are dropped and @code{-} get replaced by @code{_}.
611
612For example the procedure would convert @code{'A-Field?} to @code{\"a_field\"}."
613 (define str (symbol->string field-name))
614 (string-downcase
615 (string-replace-substring
616 (if (string-suffix? "?" str)
617 (string-drop-right str 1)
618 str)
619 "-" "_")))
620
621(define* (tuned-serialize-pair pair #:key (separator "="))
622 (define (valid? member)
623 (or (string? member)
624 (gexp? member)
625 (file-like? member)))
626 (match pair
627 (((? valid? key) . (? valid? value))
628 #~(string-append #$key #$separator #$value))
629 (_
630 (raise
631 (formatted-message
632 (G_ "pair members must contain only strings, gexps or file-like objects
633but ~a was found")
634 pair)))))
635
636(define* (tuned-ppd-serialize-mixed-list name value #:key (separator " = "))
637 (if (zero? (length value))
638 ""
639 #~(string-append "\n[" #$(uglify-snake-case name) "]\n"
640 (string-join
641 (list #$@(map tuned-serialize-pair value)) "\n")
642 "\n")))
643
644(define (mixed-list? value)
645 ;; Expected spec format:
646 ;; '(("name" . "value") "name=value")
647 (for-each
648 (lambda (el)
649 (cond ((string? el) el)
650 ((pair? el) (tuned-serialize-pair el))
651 (else
652 (raise
653 (formatted-message
654 (G_ "members must be either strings or pairs but ~a was
655found!")
656 el)))))
657 value)
658 #t)
659
660(define (tuned-ppd-serialize-string name value)
661 (format #f "~a=~a" (uglify-snake-case name) value))
662
663(define (tuned-ppd-serialize-boolean name value)
664 (format #f "~a=~a" (uglify-snake-case name) (if value "true" "false")))
665
666(define %default-tuned-ppd-settings-profiles
667 '(("power-saver" . "powersave")
668 ("balanced" . "balanced")
669 ("performance" . "throughput-performance")))
670
671(define %default-tuned-ppd-settings-battery
672 '(("balanced" . "balanced-battery")))
673
674(define-configuration tuned-ppd-settings
675 (default
676 (string "balanced")
677 "Default PPD profile.")
678 (battery-detection?
679 (boolean #t)
680 "Whether to enable battery detection.")
681 (sysfs-acpi-monitor?
682 (boolean #t)
683 "Whether to react to changes of ACPI platform profile done via function keys
684(e.g., Fn-L). This is marked upstream as an experimental feature.")
685 (profiles
686 (mixed-list %default-tuned-ppd-settings-profiles)
687 "Map of PPD profiles states to TuneD profiles. It's supposed to be a list of
688pairs, pair members are supposed to be string. It defaults to
689@code{%default-tuned-ppd-settings-profiles}:
690
691@lisp
692'((\"power-saver\" . \"powersave\")
693 (\"balanced\" . \"balanced\")
694 (\"performance\" . \"throughput-performance\"))
695@end lisp
696
697Elements can be pairs or strings. Pair members can be either strings, gexps or
698file like objects. Strings are directly passed to the serializer. This can be
699an escape hatch in case the underlying syntax of the output file changes
700slightly and the Scheme API is not adequated in time. This way there is always
701a way to work around Scheme records.")
702 (battery
703 (mixed-list %default-tuned-ppd-settings-battery)
704 "Map of PPD battery states to TuneD profiles. It's supposed to be a list of
705pairs, pair members are supposed to be string. It defaults to
706@code{%default-tuned-ppd-settings-battery}:
707
708@lisp
709'((\"balanced\" . \"balanced-battery\"))
710@end lisp
711
712Elements can be pairs or strings. Pair members can be either strings, gexps or
713file like objects. Strings are directly passed to the serializer. This can be
714an escape hatch in case the underlying syntax of the output file changes
715slightly and the Scheme API is not adequated in time. This way there is always
716a way to work around Scheme records.")
717 (extra-content
718 (text-config
719 (list (plain-file "tuned-ppd-settings-extra-content" "")))
720 "A list of file-like objects that are appended to the configuration file."
721 (serializer serialize-text-config))
722 (prefix tuned-ppd-))
723
724(define (serialize-tuned-ppd-settings config)
725 (define fields
726 (filter-configuration-fields
727 tuned-ppd-settings-fields
728 '(default battery-detection? sysfs-acpi-monitor? profiles battery
729 extra-content)))
730 (define getters
731 (map configuration-field-getter fields))
732 (define names
733 (map configuration-field-name fields))
734 (define serializers
735 (map configuration-field-serializer fields))
736 (define values
737 (map (match-lambda ((serializer name getter)
738 (serializer name (getter config))))
739 (zip serializers names getters)))
740
741 (match values
742 ((default battery-detection? sysfs-acpi-monitor? profiles battery
743 extra-content)
744
745 (mixed-text-file "ppd.conf"
746 "[main]\n"
747 (string-append default "\n")
748 (string-append battery-detection? "\n")
749 (string-append sysfs-acpi-monitor? "\n")
750 "\n"
751 profiles
752 battery
753 extra-content
754 "\n"))))
755
756(define (serialize-list-of-profile-dirs name value)
757 (if (zero? (length value))
758 ""
759 #~(string-append
760 #$(uglify-snake-case name) " = " (string-join (list #$@value) ","))))
761
762(define (list-of-profile-dirs? value)
763 (for-each
764 (lambda (el)
765 (unless (or (string? el) (file-like? el))
766 (raise
767 (formatted-message
768 (G_ "tuned-settings profile-dirs members must be either a string
769or a file-like object but ~a was found!")
770 el))))
771 value)
772 #t)
773
774(define tuned-serialize-boolean tuned-ppd-serialize-boolean)
775(define tuned-serialize-integer tuned-ppd-serialize-string)
776
777(define-configuration tuned-settings
778 (daemon?
779 (boolean #t)
780 "Whether to use daemon. Without daemon TuneD just applies tuning.")
781 (dynamic-tuning?
782 (boolean #f)
783 "Dynamically tune devices, if disabled only static tuning will be used.")
784 (default-instance-priority
785 (integer 0)
786 "Default priority assigned to instances.")
787 (recommend-command?
788 (boolean #t)
789 "Recommend functionality, if disabled @code{recommend} command will be not
790available in CLI, daemon will not parse @file{recommend.conf} but will return
791one hardcoded profile (by default @code{balanced}).")
792 (sleep-interval
793 (integer 1)
794 "How long to sleep before checking for events (in seconds),
795higher number means lower overhead but longer response time.")
796 (update-interval
797 (integer 10)
798 "Update interval for dynamic tunings (in seconds). It must be a multiple of
799the @code{sleep-interval}.")
800 (profile-dirs
801 (list-of-profile-dirs
802 (list (file-append tuned "/lib/tuned/profiles") "/etc/tuned/profiles"))
803 "List of strings or gexps representing directories to search for
804profiles. In case of collisions in profile names, the latter directory takes
805precedence."
806 (serializer serialize-list-of-profile-dirs))
807 (extra-content
808 (text-config
809 (list (plain-file "tuned-settings-extra-content" "")))
810 "A list of file-like objects that are appended to the configuration file."
811 (serializer serialize-text-config))
812 (prefix tuned-))
813
814(define (serialize-tuned-settings config)
815 (define fields
816 (filter-configuration-fields
817 tuned-settings-fields
818 '(daemon? dynamic-tuning? default-instance-priority
819 recommend-command? sleep-interval update-interval profile-dirs
820 extra-content)))
821 (define getters
822 (map configuration-field-getter fields))
823 (define names
824 (map configuration-field-name fields))
825 (define serializers
826 (map configuration-field-serializer fields))
827 (define values
828 (map (match-lambda ((serializer name getter)
829 (serializer name (getter config))))
830 (zip serializers names getters)))
831
832 (match values
833 ((daemon? dynamic-tuning? default-instance-priority
834 recommend-command? sleep-interval update-interval profile-dirs
835 extra-content)
836 (mixed-text-file
837 "tuned-main.conf"
838 (string-append daemon? "\n\n")
839 (string-append dynamic-tuning? "\n\n")
840 (string-append default-instance-priority "\n\n")
841 (string-append recommend-command? "\n\n")
842 (string-append sleep-interval "\n\n")
843 (string-append update-interval "\n\n")
844 profile-dirs
845 extra-content
846 "\n"))))
847
848(define (tuned-plugin? value)
849 (if (and (= 2 (length value))
850 (string? (first value))
851 (file-like? (second value)))
852 #t
853 (raise
854 (formatted-message
855 (G_ "tuned-configuration profiles members must be lists with two
856elements, the first being a string and the second a file-like object, but ~a was
857found!")
858 value))))
859
860(define (list-of-tuned-plugins? value)
861 (list-of tuned-plugin?))
862
863(define %default-tuned-configuration-recommend.conf
864 (file-append tuned "/lib/tuned/recommend.d/50-tuned.conf"))
865
866(define-configuration/no-serialization tuned-configuration
867 (tuned
868 (package tuned)
869 "The TuneD package.")
870 (auto-start?
871 (boolean #t)
872 "Whether this service should be started automatically by the Shepherd. If it
873is @code{#f} the service has to be started manually with @command{herd start}.")
874 (power-profiles-daemon-support?
875 (boolean #f)
876 "Whether the power-profiles-daemon emulation layer should be
877enabled.")
878 (profiles
879 (list-of-tuned-plugins '())
880 "User provided profiles for TuneD. Each element of the list is supposed to be
881a list where the first element is the name of the directory where plugin files
882will be placed under @file{/etc/tuned/profiles} and the second a file like
883object containing the plugin files:
884
885@lisp
886(list
887 (list \"plugin-name\"
888 (plain-file \"plugin.conf\" \"content\"))
889 (list \"other-plugin\"
890 (file-union \"plugin-data\"
891 (list (list \"other-plugin.conf\"
892 (plain-file \"other-plugin.conf\" \"content\"))
893 (list \"other-plugin.scm\"
894 (program-file \"other-plugin.scm\"
895 #~(display \"content\")))))))
896@end lisp")
897 (settings
898 (tuned-settings (tuned-settings))
899 "Configuration for TuneD.")
900 (ppd-settings
901 (tuned-ppd-settings (tuned-ppd-settings))
902 "Configuration for the @code{power-profiles-daemon} compatibility layer of
903TuneD.")
904 (recommend.conf
905 (file-like %default-tuned-configuration-recommend.conf)
906 "File like object containing the recommended profile configuration. Defaults
907to @code{%default-tuned-configuration-recommend.conf}."))
908
909(define (tuned-file-systems config)
910 (list
911 (file-system
912 (device "none")
913 (mount-point "/run/tuned")
914 (type "ramfs")
915 (check? #f))))
916
917(define (tuned-activation config)
918 (match-record config <tuned-configuration>
919 (profiles settings ppd-settings recommend.conf)
920 #~(begin
921 (use-modules (guix build utils))
922 (let ((data-directory "/var/lib/tuned")
923 (config-directory "/etc/tuned"))
924 ;; Setup TuneD directories.
925 (for-each
926 (lambda (dir)
927 (mkdir-p dir)
928 (chmod dir #o755))
929 (list data-directory config-directory
930 ;; the directory where TuneD will look for kernel modules for
931 ;; plugins.
932 "/etc/tuned/modprobe.d"))
933 ;; Create plugins kernel modules configuration.
934 (invoke #$(file-append coreutils-minimal "/bin/touch")
935 "/etc/tuned/modprobe.d/tuned.conf")
936 ;; Generate and activate TuneD configuration files.
937 ;; TuneD needs to write in /etc/tuned, special-files-service-type
938 ;; creates a file union, so /etc/tuned is read-only and TuneD crashes.
939 ;; activate-special-files creates a single symlink to the store for
940 ;; each file so TuneD doesn't notice and runs successfully.
941 (activate-special-files
942 '(("/etc/tuned/recommend.conf" #$recommend.conf)
943 ("/etc/tuned/profiles"
944 #$(file-union "tuned-profiles" profiles))
945 ("/etc/tuned/tuned-main.conf"
946 #$(serialize-tuned-settings settings))
947 ("/etc/tuned/ppd.conf"
948 #$(serialize-tuned-ppd-settings ppd-settings))))))))
949
950(define (tuned-shepherd-services config)
951 (match-record config <tuned-configuration>
952 (tuned auto-start? power-profiles-daemon-support?)
953 (append
954 (list
955 (shepherd-service
956 (documentation "TuneD daemon")
957 (provision '(tuned))
958 (requirement '(dbus-system user-processes udev))
959 (start #~(make-forkexec-constructor
960 '(#$(file-append tuned "/sbin/tuned"))
961 #:log-file "/var/log/tuned/tuned.log"))
962 (stop #~(make-kill-destructor))
963 (auto-start? auto-start?)))
964 (if power-profiles-daemon-support?
965 (list (shepherd-service
966 (documentation "TuneD power-profiles-daemon emulation daemon")
967 (provision '(tuned-ppd power-profiles-daemon))
968 (requirement '(dbus-system user-processes udev tuned))
969 (start
970 #~(make-forkexec-constructor
971 '(#$(file-append tuned "/sbin/tuned-ppd"))
972 #:log-file "/var/log/tuned/tuned-ppd.log"))
973 (stop #~(make-kill-destructor))
974 (auto-start? auto-start?)))
975 '()))))
976
977(define tuned-service-type
978 (let ((config->package
979 (compose list tuned-configuration-tuned)))
980 (service-type
981 (name 'tuned)
982 (extensions (list
983 (service-extension shepherd-root-service-type
984 tuned-shepherd-services)
985 (service-extension dbus-root-service-type
986 config->package)
987 (service-extension polkit-service-type
988 config->package)
989 (service-extension profile-service-type
990 config->package)
991 (service-extension file-system-service-type
992 tuned-file-systems)
993 (service-extension activation-service-type
994 tuned-activation)))
995 (default-value (tuned-configuration))
996 (description "Run the TuneD daemon. It is daemon that tunes system settings
997dynamically. It does so by monitoring the usage of several system components
998periodically."))))
999
1000
1001;;;
1002;;; Zram device
1003;;;
1004(define-record-type* <zram-device-configuration>
1005 zram-device-configuration make-zram-device-configuration
1006 zram-device-configuration?
1007 (size zram-device-configuration-size
1008 (default "1G")) ; string or integer
1009 (compression-algorithm zram-device-configuration-compression-algorithm
1010 (default 'lzo)) ; symbol
1011 (memory-limit zram-device-configuration-memory-limit
1012 (default 0)) ; string or integer
1013 (priority zram-device-configuration-priority
1014 (default #f) ; integer | #f
1015 (delayed) ; to avoid printing the deprecation
1016 ; warning multiple times
1017 (sanitize warn-zram-priority-change)))
1018
1019(define-with-syntax-properties
1020 (warn-zram-priority-change (priority properties))
1021 (if (eqv? priority -1)
1022 (begin
1023 (warning (source-properties->location properties)
1024 (G_ "using -1 for zram priority is deprecated~%"))
1025 (display-hint (G_ "Use #f or leave as default instead (@pxref{Linux \
1026Services})."))
1027 #f)
1028 priority))
1029
1030(define (zram-device-configuration->udev-string config)
1031 "Translate a <zram-device-configuration> into a string which can be
1032placed in a udev rules file."
1033 (match config
1034 (($ <zram-device-configuration> size compression-algorithm memory-limit priority)
1035 (string-append
1036 "KERNEL==\"zram0\", "
1037 "ATTR{comp_algorithm}=\"" (symbol->string compression-algorithm) "\" "
1038 (if (not (or (equal? "0" size)
1039 (equal? 0 size)))
1040 (string-append "ATTR{disksize}=\"" (if (number? size)
1041 (number->string size)
1042 size)
1043 "\" ")
1044 "")
1045 (if (not (or (equal? "0" memory-limit)
1046 (equal? 0 memory-limit)))
1047 (string-append "ATTR{mem_limit}=\"" (if (number? memory-limit)
1048 (number->string memory-limit)
1049 memory-limit)
1050 "\" ")
1051 "")
1052 "RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" "
1053 "RUN+=\"/run/current-system/profile/sbin/swapon "
1054 ;; TODO: Revert to simply use 'priority' after removing the deprecation
1055 ;; warning and the delayed property of the field.
1056 (let ((priority* (force priority)))
1057 (if priority*
1058 (format #f "--priority ~a " priority*)
1059 ""))
1060 "/dev/zram0\"\n"))))
1061
1062(define %zram-device-config
1063 `("modprobe.d/zram.conf"
1064 ,(plain-file "zram.conf"
1065 "options zram num_devices=1")))
1066
1067(define (zram-device-udev-rule config)
1068 (file->udev-rule "99-zram.rules"
1069 (plain-file "99-zram.rules"
1070 (zram-device-configuration->udev-string config))))
1071
1072(define zram-device-service-type
1073 (service-type
1074 (name 'zram)
1075 (default-value (zram-device-configuration))
1076 (extensions
1077 (list (service-extension kernel-module-loader-service-type
1078 (const (list "zram")))
1079 (service-extension etc-service-type
1080 (const (list %zram-device-config)))
1081 (service-extension udev-service-type
1082 (compose list zram-device-udev-rule))))
1083 (description "Creates a zram swap device.")))
1084
1085
1086;;;
1087;;; VFS Mapping.
1088;;;
1089
1090(define-record-type* <vfs-mapping>
1091 vfs-mapping make-vfs-mapping
1092 vfs-mapping?
1093 (source vfs-mapping-source)
1094 (destination vfs-mapping-destination)
1095 (policy vfs-mapping-policy
1096 (default 'translate))
1097 (user vfs-mapping-user
1098 (default #f))
1099 (group vfs-mapping-group
1100 (default "users"))
1101 (name vfs-mapping-name
1102 (default (format #f "~a-on-~a"
1103 (vfs-mapping-policy this-record)
1104 (vfs-mapping-destination this-record)))
1105 (thunked))
1106 (requirement vfs-mapping-requirement
1107 (default '(file-systems user-homes))))
1108
1109(define (vfs-mapping-policy? x)
1110 (and (symbol? x)
1111 (or (memq x '(bind translate overlay)))))
1112
1113(define (path-like? x)
1114 (or (string? x)
1115 (file-like? x)
1116 (gexp? x)))
1117
1118(define (valid-vfs-mapping? x)
1119 ;; User must be set iff we are going to use it
1120 (and (vfs-mapping? x)
1121 (path-like? (vfs-mapping-source x))
1122 (path-like? (vfs-mapping-destination x))
1123 (string? (vfs-mapping-name x))
1124 (vfs-mapping-policy? (vfs-mapping-policy x))
1125 (cond
1126 ((eq? (vfs-mapping-policy x) 'bind)
1127 (not (vfs-mapping-user x)))
1128 (#t
1129 (and (string? (vfs-mapping-user x))
1130 (string? (vfs-mapping-group x)))))))
1131
1132(define list-of-vfs-mapping? (list-of valid-vfs-mapping?))
1133
1134(define-configuration/no-serialization vfs-mapping-configuration
1135 (bindfs (gexp #~(string-append #$bindfs "/bin/bindfs"))
1136 "The bindfs command to use.")
1137 (fusermount (gexp #~(string-append #$fuse-2 "/bin/fusermount"))
1138 "The fusermount command to use.")
1139 (umount (gexp #~(string-append #$util-linux+udev "/bin/umount"))
1140 "The umount command to use.")
1141 (bindings (list-of-vfs-mapping '())
1142 "The list of bindings to mount"))
1143
1144(define vfs-mapping-shepherd-services
1145 (match-record-lambda <vfs-mapping-configuration>
1146 (fusermount bindfs umount bindings)
1147 (map
1148 (match-record-lambda <vfs-mapping>
1149 (source destination policy user group name requirement)
1150 (shepherd-service
1151 ;; Each binding has its own service
1152 (provision (list (string->symbol name)))
1153 ;; Make sure the homes are already present
1154 (requirement requirement)
1155 (modules `((ice-9 match)
1156 ,@%default-modules))
1157 (stop
1158 #~(lambda args
1159 (match (quote #$policy)
1160 ('bind (invoke #$umount #$destination))
1161 ('translate (invoke #$fusermount "-u" #$destination))
1162 ('overlay (begin
1163 ;; First the bindfs
1164 (invoke #$fusermount "-u" #$destination)
1165 ;; then the overlay
1166 (invoke #$umount #$destination))))
1167 #f))
1168 (start
1169 #~(lambda args
1170 (define (mkdir-recursively dir user group)
1171 ;; Like mkdir-p, but chown all created directories to the
1172 ;; specified user.
1173 (unless (eq? dir "/")
1174 (when (not (file-exists? dir))
1175 (mkdir-recursively (dirname dir) user group)
1176 (mkdir dir)
1177 (let* ((pw (getpw user))
1178 (uid (passwd:uid pw))
1179 (gid (passwd:gid pw)))
1180 (chown dir uid gid)))))
1181 (mkdir-recursively #$destination #$user #$group)
1182 (let* ((stat (stat #$source))
1183 (uid (stat:uid stat))
1184 (gid (stat:gid stat))
1185 (source-user (passwd:name (getpwuid uid)))
1186 (source-group (group:name (getgrgid gid))))
1187 (match (quote #$policy)
1188 ('bind
1189 (mount #$source #$destination
1190 #f ;type
1191 MS_BIND)) ;flags (bind mount)
1192 ('translate
1193 (invoke
1194 #$bindfs
1195 (string-append "--create-for-group=" source-group)
1196 (string-append "--create-for-user=" source-user)
1197 (string-append "--force-user=" #$user)
1198 (string-append "--force-group=" #$group)
1199 "-o" "nonempty"
1200 #$source #$destination))
1201 ('overlay
1202 (let ((overlay (string-append #$destination "-overlay"))
1203 (workdir (string-append #$destination "-workdir")))
1204 (mkdir-recursively overlay #$user #$group)
1205 (mkdir-recursively workdir #$user #$group)
1206 (mount "overlay" ;source
1207 #$destination
1208 "overlay" ;type
1209 0 ;flags
1210 (string-append ;options
1211 "lowerdir=" #$source ","
1212 "upperdir=" overlay ","
1213 "workdir=" workdir))
1214 ;; Remount the target over itself to make it appear as if
1215 ;; owned by user-name and user-group.
1216 (invoke
1217 #$bindfs
1218 (string-append "--create-for-group=" source-group)
1219 (string-append "--create-for-user=" source-user)
1220 (string-append "--force-user=" #$user)
1221 (string-append "--force-group=" #$group)
1222 #$destination #$destination)))))
1223 #t))))
1224 bindings)))
1225
1226(define vfs-mapping-service-type
1227 (service-type
1228 (name 'vfs-mapping)
1229 (extensions (list
1230 (service-extension shepherd-root-service-type
1231 vfs-mapping-shepherd-services)))
1232 (compose concatenate)
1233 (extend (lambda (original extensions)
1234 (vfs-mapping-configuration
1235 (inherit original)
1236 (bindings (append (vfs-mapping-configuration-bindings original)
1237 extensions)))))
1238 (default-value (vfs-mapping-configuration))
1239 (description "Share or expose a file name under a different name.")))