[jackhill/guix/guix.git] / gnu / services / linux.scm

;;; 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>
;;;
;;; 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 gexp)
  #:use-module (guix records)
  #:use-module (guix modules)
  #: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

            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))

\f
;;;
;;; 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.")))

\f
;;;
;;; Kernel module loader.
;;;

(define kernel-module-loader-shepherd-service
  (match-lambda
    ((and (? list? kernel-modules) ((? string?) ...))
     (list
      (shepherd-service
       (documentation "Load kernel modules.")
       (provision '(kernel-module-loader))
       (requirement '(file-systems))
       (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
                             kernel-module-loader-shepherd-service)))
   (compose concatenate)
   (extend append)
   (default-value '())))

\f
;;;
;;; 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 -1)))      ; integer

(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 "
       (if (not (equal? -1 priority))
         (string-append "--priority " (number->string 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.")))
Commit	Line	Data
d3e439e3 MC	1	;;; GNU Guix --- Functional package management for GNU
d3e439e3 MC	2	;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
044d1478	3	;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
587e0d91	4	;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
d3e439e3 MC	5	;;;
	6	;;; This file is part of GNU Guix.
	7	;;;
	8	;;; GNU Guix is free software; you can redistribute it and/or modify it
	9	;;; under the terms of the GNU General Public License as published by
	10	;;; the Free Software Foundation; either version 3 of the License, or (at
	11	;;; your option) any later version.
	12	;;;
	13	;;; GNU Guix is distributed in the hope that it will be useful, but
	14	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;;; GNU General Public License for more details.
	17	;;;
	18	;;; You should have received a copy of the GNU General Public License
	19	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	20
	21	(define-module (gnu services linux)
	22	#:use-module (guix gexp)
	23	#:use-module (guix records)
	24	#:use-module (guix modules)
	25	#:use-module (gnu services)
587e0d91	26	#:use-module (gnu services base)
d3e439e3 MC	27	#:use-module (gnu services shepherd)
	28	#:use-module (gnu packages linux)
	29	#:use-module (srfi srfi-1)
	30	#:use-module (srfi srfi-26)
044d1478 BW	31	#:use-module (srfi srfi-34)
044d1478 BW	32	#:use-module (srfi srfi-35)
d3e439e3 MC	33	#:use-module (ice-9 match)
	34	#:export (earlyoom-configuration
	35	earlyoom-configuration?
	36	earlyoom-configuration-earlyoom
	37	earlyoom-configuration-minimum-available-memory
	38	earlyoom-configuration-minimum-free-swap
	39	earlyoom-configuration-prefer-regexp
	40	earlyoom-configuration-avoid-regexp
	41	earlyoom-configuration-memory-report-interval
	42	earlyoom-configuration-ignore-positive-oom-score-adj?
	43	earlyoom-configuration-show-debug-messages?
	44	earlyoom-configuration-send-notification-command
044d1478 BW	45	earlyoom-service-type
044d1478 BW	46
587e0d91 EF	47	kernel-module-loader-service-type
	48
	49	zram-device-configuration
	50	zram-device-configuration?
	51	zram-device-configuration-size
	52	zram-device-configuration-compression-algorithm
	53	zram-device-configuration-memory-limit
	54	zram-device-configuration-priority
	55	zram-device-service-type))
d3e439e3 MC	56
	57	\f
	58	;;;
	59	;;; Early OOM daemon.
	60	;;;
	61
	62	(define-record-type* <earlyoom-configuration>
	63	earlyoom-configuration make-earlyoom-configuration
	64	earlyoom-configuration?
	65	(earlyoom earlyoom-configuration-earlyoom
	66	(default earlyoom))
	67	(minimum-available-memory earlyoom-configuration-minimum-available-memory
	68	(default 10)) ; in percent
	69	(minimum-free-swap earlyoom-configuration-minimum-free-swap
	70	(default 10)) ; in percent
	71	(prefer-regexp earlyoom-configuration-prefer-regexp ; <string>
	72	(default #f))
	73	(avoid-regexp earlyoom-configuration-avoid-regexp ; <string>
	74	(default #f))
	75	(memory-report-interval earlyoom-configuration-memory-report-interval
	76	(default 0)) ; in seconds; 0 means disabled
	77	(ignore-positive-oom-score-adj?
	78	earlyoom-configuration-ignore-positive-oom-score-adj? (default #f))
	79	(run-with-higher-priority? earlyoom-configuration-run-with-higher-priority?
	80	(default #f))
	81	(show-debug-messages? earlyoom-configuration-show-debug-messages?
	82	(default #f))
	83	(send-notification-command
	84	earlyoom-configuration-send-notification-command ; <string>
	85	(default #f)))
	86
	87	(define (earlyoom-configuration->command-line-args config)
	88	"Translate a <earlyoom-configuration> object to its command line arguments
	89	representation."
	90	(match config
	91	(($ <earlyoom-configuration> earlyoom minimum-available-memory
	92	minimum-free-swap prefer-regexp avoid-regexp
	93	memory-report-interval
	94	ignore-positive-oom-score-adj?
	95	run-with-higher-priority? show-debug-messages?
	96	send-notification-command)
	97	`(,(file-append earlyoom "/bin/earlyoom")
	98	,@(if minimum-available-memory
	99	(list "-m" (format #f "~s" minimum-available-memory))
	100	'())
	101	,@(if minimum-free-swap
	102	(list "-s" (format #f "~s" minimum-free-swap))
	103	'())
	104	,@(if prefer-regexp
	105	(list "--prefer" prefer-regexp)
	106	'())
	107	,@(if avoid-regexp
	108	(list "--avoid" avoid-regexp)
	109	'())
	110	"-r" ,(format #f "~s" memory-report-interval)
	111	,@(if ignore-positive-oom-score-adj?
	112	(list "-i")
	113	'())
	114	,@(if run-with-higher-priority?
	115	(list "-p")
	116	'())
	117	,@(if show-debug-messages?
	118	(list "-d")
	119	'())
120	,@(if send-notification-command
121	(list "-N" send-notification-command)
122	'())))))
123
124	(define (earlyoom-shepherd-service config)
125	(shepherd-service
126	(documentation "Run the Early OOM daemon.")
127	(provision '(earlyoom))
128	(start #~(make-forkexec-constructor
129	'#$(earlyoom-configuration->command-line-args config)
130	#:log-file "/var/log/earlyoom.log"))
131	(stop #~(make-kill-destructor))))
132
133	(define earlyoom-service-type
134	(service-type
135	(name 'earlyoom)
136	(default-value (earlyoom-configuration))
137	(extensions
138	(list (service-extension shepherd-root-service-type
139	(compose list earlyoom-shepherd-service))))
140	(description "Run @command{earlyoom}, the Early OOM daemon.")))
044d1478 BW	141
	142	\f
	143	;;;
	144	;;; Kernel module loader.
	145	;;;
	146
	147	(define kernel-module-loader-shepherd-service
	148	(match-lambda
	149	((and (? list? kernel-modules) ((? string?) ...))
	150	(list
	151	(shepherd-service
	152	(documentation "Load kernel modules.")
	153	(provision '(kernel-module-loader))
	154	(requirement '(file-systems))
044d1478 BW	155	(one-shot? #t)
	156	(modules `((srfi srfi-1)
	157	(srfi srfi-34)
	158	(srfi srfi-35)
	159	(rnrs io ports)
	160	,@%default-modules))
	161	(start
	162	#~(lambda _
	163	(cond
	164	((null? '#$kernel-modules) #t)
	165	((file-exists? "/proc/sys/kernel/modprobe")
	166	(let ((modprobe (call-with-input-file
	167	"/proc/sys/kernel/modprobe" get-line)))
	168	(guard (c ((message-condition? c)
	169	(format (current-error-port) "~a~%"
	170	(condition-message c))
	171	#f))
	172	(every (lambda (module)
	173	(invoke/quiet modprobe "--" module))
	174	'#$kernel-modules))))
	175	(else
	176	(format (current-error-port) "error: ~a~%"
	177	"Kernel is missing loadable module support.")
	178	#f)))))))))
	179
	180	(define kernel-module-loader-service-type
	181	(service-type
	182	(name 'kernel-module-loader)
	183	(description "Load kernel modules.")
	184	(extensions
	185	(list (service-extension shepherd-root-service-type
	186	kernel-module-loader-shepherd-service)))
	187	(compose concatenate)
	188	(extend append)
	189	(default-value '())))
587e0d91 EF	190
	191	\f
	192	;;;
	193	;;; Kernel module loader.
	194	;;;
	195
	196	(define-record-type* <zram-device-configuration>
	197	zram-device-configuration make-zram-device-configuration
	198	zram-device-configuration?
71992a53	199	(size zram-device-configuration-size
587e0d91 EF	200	(default "1G")) ; string or integer
	201	(compression-algorithm zram-device-configuration-compression-algorithm
	202	(default 'lzo)) ; symbol
	203	(memory-limit zram-device-configuration-memory-limit
	204	(default 0)) ; string or integer
	205	(priority zram-device-configuration-priority
	206	(default -1))) ; integer
	207
	208	(define (zram-device-configuration->udev-string config)
	209	"Translate a <zram-device-configuration> into a string which can be
	210	placed in a udev rules file."
	211	(match config
	212	(($ <zram-device-configuration> size compression-algorithm memory-limit priority)
	213	(string-append
	214	"KERNEL==\"zram0\", "
	215	"ATTR{comp_algorithm}=\"" (symbol->string compression-algorithm) "\" "
	216	(if (not (or (equal? "0" size)
	217	(equal? 0 size)))
	218	(string-append "ATTR{disksize}=\"" (if (number? size)
	219	(number->string size)
	220	size)
	221	"\" ")
	222	"")
	223	(if (not (or (equal? "0" memory-limit)
	224	(equal? 0 memory-limit)))
	225	(string-append "ATTR{mem_limit}=\"" (if (number? memory-limit)
	226	(number->string memory-limit)
	227	memory-limit)
	228	"\" ")
	229	"")
	230	"RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" "
	231	"RUN+=\"/run/current-system/profile/sbin/swapon "
	232	(if (not (equal? -1 priority))
	233	(string-append "--priority " (number->string priority) " ")
	234	"")
	235	"/dev/zram0\"\n"))))
	236
	237	(define %zram-device-config
	238	`("modprobe.d/zram.conf"
	239	,(plain-file "zram.conf"
	240	"options zram num_devices=1")))
	241
	242	(define (zram-device-udev-rule config)
	243	(file->udev-rule "99-zram.rules"
	244	(plain-file "99-zram.rules"
	245	(zram-device-configuration->udev-string config))))
	246
	247	(define zram-device-service-type
	248	(service-type
	249	(name 'zram)
	250	(default-value (zram-device-configuration))
	251	(extensions
	252	(list (service-extension kernel-module-loader-service-type
	253	(const (list "zram")))
	254	(service-extension etc-service-type
	255	(const (list %zram-device-config)))
	256	(service-extension udev-service-type
	257	(compose list zram-device-udev-rule))))
	258	(description "Creates a zram swap device.")))