1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services linux)
#:use-module (guix diagnostics)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix modules)
#:use-module (guix i18n)
#:use-module (guix ui)
#:use-module (gnu services)
#:use-module (gnu services base)
#: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 match)
#:export (earlyoom-configuration
earlyoom-configuration?
earlyoom-configuration-earlyoom
earlyoom-configuration-minimum-available-memory
earlyoom-configuration-minimum-free-swap
earlyoom-configuration-prefer-regexp
earlyoom-configuration-avoid-regexp
earlyoom-configuration-memory-report-interval
earlyoom-configuration-ignore-positive-oom-score-adj?
earlyoom-configuration-show-debug-messages?
earlyoom-configuration-send-notification-command
earlyoom-service-type
kernel-module-loader-service-type
rasdaemon-configuration
rasdaemon-configuration?
rasdaemon-configuration-record?
rasdaemon-service-type
zram-device-configuration
zram-device-configuration?
zram-device-configuration-size
zram-device-configuration-compression-algorithm
zram-device-configuration-memory-limit
zram-device-configuration-priority
zram-device-service-type))
;;;
;;; Early OOM daemon.
;;;
(define-record-type* <earlyoom-configuration>
earlyoom-configuration make-earlyoom-configuration
earlyoom-configuration?
(earlyoom earlyoom-configuration-earlyoom
(default earlyoom))
(minimum-available-memory earlyoom-configuration-minimum-available-memory
(default 10)) ; in percent
(minimum-free-swap earlyoom-configuration-minimum-free-swap
(default 10)) ; in percent
(prefer-regexp earlyoom-configuration-prefer-regexp ; <string>
(default #f))
(avoid-regexp earlyoom-configuration-avoid-regexp ; <string>
(default #f))
(memory-report-interval earlyoom-configuration-memory-report-interval
(default 0)) ; in seconds; 0 means disabled
(ignore-positive-oom-score-adj?
earlyoom-configuration-ignore-positive-oom-score-adj? (default #f))
(run-with-higher-priority? earlyoom-configuration-run-with-higher-priority?
(default #f))
(show-debug-messages? earlyoom-configuration-show-debug-messages?
(default #f))
(send-notification-command
earlyoom-configuration-send-notification-command ; <string>
(default #f)))
(define (earlyoom-configuration->command-line-args config)
"Translate a <earlyoom-configuration> object to its command line arguments
representation."
(match config
(($ <earlyoom-configuration> earlyoom minimum-available-memory
minimum-free-swap prefer-regexp avoid-regexp
memory-report-interval
ignore-positive-oom-score-adj?
run-with-higher-priority? show-debug-messages?
send-notification-command)
`(,(file-append earlyoom "/bin/earlyoom")
,@(if minimum-available-memory
(list "-m" (format #f "~s" minimum-available-memory))
'())
,@(if minimum-free-swap
(list "-s" (format #f "~s" minimum-free-swap))
'())
,@(if prefer-regexp
(list "--prefer" prefer-regexp)
'())
,@(if avoid-regexp
(list "--avoid" avoid-regexp)
'())
"-r" ,(format #f "~s" memory-report-interval)
,@(if ignore-positive-oom-score-adj?
(list "-i")
'())
,@(if run-with-higher-priority?
(list "-p")
'())
,@(if show-debug-messages?
(list "-d")
'())
,@(if send-notification-command
(list "-N" send-notification-command)
'())))))
(define (earlyoom-shepherd-service config)
(shepherd-service
(documentation "Run the Early OOM daemon.")
(provision '(earlyoom))
(start #~(make-forkexec-constructor
'#$(earlyoom-configuration->command-line-args config)
#:log-file "/var/log/earlyoom.log"))
(stop #~(make-kill-destructor))))
(define earlyoom-service-type
(service-type
(name 'earlyoom)
(default-value (earlyoom-configuration))
(extensions
(list (service-extension shepherd-root-service-type
(compose list earlyoom-shepherd-service))))
(description "Run @command{earlyoom}, the Early OOM daemon.")))
;;;
;;; Kernel module loader.
;;;
(define kernel-module-loader-shepherd-service
(match-lambda
((and (? list? kernel-modules) ((? string?) ...))
(shepherd-service
(documentation "Load kernel modules.")
(provision '(kernel-module-loader))
(requirement '())
(one-shot? #t)
(modules `((srfi srfi-1)
(srfi srfi-34)
(srfi srfi-35)
(rnrs io ports)
,@%default-modules))
(start
#~(lambda _
(cond
((null? '#$kernel-modules) #t)
((file-exists? "/proc/sys/kernel/modprobe")
(let ((modprobe (call-with-input-file
"/proc/sys/kernel/modprobe" get-line)))
(guard (c ((message-condition? c)
(format (current-error-port) "~a~%"
(condition-message c))
#f))
(every (lambda (module)
(invoke/quiet modprobe "--" module))
'#$kernel-modules))))
(else
(format (current-error-port) "error: ~a~%"
"Kernel is missing loadable module support.")
#f))))))))
(define kernel-module-loader-service-type
(service-type
(name 'kernel-module-loader)
(description "Load kernel modules.")
(extensions
(list (service-extension shepherd-root-service-type
(compose list kernel-module-loader-shepherd-service))))
(compose concatenate)
(extend append)
(default-value '())))
;;;
;;; Reliability, Availability, and Serviceability (RAS) daemon
;;;
(define-record-type* <rasdaemon-configuration>
rasdaemon-configuration make-rasdaemon-configuration
rasdaemon-configuration?
(record? rasdaemon-configuration-record? (default #f)))
(define (rasdaemon-configuration->command-line-args config)
"Translate <rasdaemon-configuration> to its command line arguments
representation"
(let ((record? (rasdaemon-configuration-record? config)))
`(,(file-append rasdaemon "/sbin/rasdaemon")
"--foreground" ,@(if record? '("--record") '()))))
(define (rasdaemon-activation config)
(let ((record? (rasdaemon-configuration-record? config))
(rasdaemon-dir "/var/lib/rasdaemon"))
(with-imported-modules '((guix build utils))
#~(if #$record? (mkdir-p #$rasdaemon-dir)))))
(define (rasdaemon-shepherd-service config)
(shepherd-service
(documentation "Run rasdaemon")
(provision '(rasdaemon))
(requirement '(syslogd))
(start #~(make-forkexec-constructor
'#$(rasdaemon-configuration->command-line-args config)))
(stop #~(make-kill-destructor))))
(define rasdaemon-service-type
(service-type
(name 'rasdaemon)
(default-value (rasdaemon-configuration))
(extensions
(list (service-extension shepherd-root-service-type
(compose list rasdaemon-shepherd-service))
(service-extension activation-service-type rasdaemon-activation)))
(compose concatenate)
(description "Run @command{rasdaemon}, the RAS monitor")))
;;;
;;; Kernel module loader.
;;;
(define-record-type* <zram-device-configuration>
zram-device-configuration make-zram-device-configuration
zram-device-configuration?
(size zram-device-configuration-size
(default "1G")) ; string or integer
(compression-algorithm zram-device-configuration-compression-algorithm
(default 'lzo)) ; symbol
(memory-limit zram-device-configuration-memory-limit
(default 0)) ; string or integer
(priority zram-device-configuration-priority
(default #f) ; integer | #f
(delayed) ; to avoid printing the deprecation
; warning multiple times
(sanitize warn-zram-priority-change)))
(define-with-syntax-properties
(warn-zram-priority-change (priority properties))
(if (eqv? priority -1)
(begin
(warning (source-properties->location properties)
(G_ "using -1 for zram priority is deprecated~%"))
(display-hint (G_ "Use #f or leave as default instead (@pxref{Linux \
Services})."))
#f)
priority))
(define (zram-device-configuration->udev-string config)
"Translate a <zram-device-configuration> into a string which can be
placed in a udev rules file."
(match config
(($ <zram-device-configuration> size compression-algorithm memory-limit priority)
(string-append
"KERNEL==\"zram0\", "
"ATTR{comp_algorithm}=\"" (symbol->string compression-algorithm) "\" "
(if (not (or (equal? "0" size)
(equal? 0 size)))
(string-append "ATTR{disksize}=\"" (if (number? size)
(number->string size)
size)
"\" ")
"")
(if (not (or (equal? "0" memory-limit)
(equal? 0 memory-limit)))
(string-append "ATTR{mem_limit}=\"" (if (number? memory-limit)
(number->string memory-limit)
memory-limit)
"\" ")
"")
"RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" "
"RUN+=\"/run/current-system/profile/sbin/swapon "
;; TODO: Revert to simply use 'priority' after removing the deprecation
;; warning and the delayed property of the field.
(let ((priority* (force priority)))
(if priority*
(format #f "--priority ~a " priority*)
""))
"/dev/zram0\"\n"))))
(define %zram-device-config
`("modprobe.d/zram.conf"
,(plain-file "zram.conf"
"options zram num_devices=1")))
(define (zram-device-udev-rule config)
(file->udev-rule "99-zram.rules"
(plain-file "99-zram.rules"
(zram-device-configuration->udev-string config))))
(define zram-device-service-type
(service-type
(name 'zram)
(default-value (zram-device-configuration))
(extensions
(list (service-extension kernel-module-loader-service-type
(const (list "zram")))
(service-extension etc-service-type
(const (list %zram-device-config)))
(service-extension udev-service-type
(compose list zram-device-udev-rule))))
(description "Creates a zram swap device.")))
|
