diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-11-19 17:54:26 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-12-08 13:21:53 +0100 |
| commit | 156a8810019dd5b8d19f2026be80f199f8e40015 (patch) | |
| tree | 670073cf034d608698055d3356766615bd3cc4bb /gnu | |
| parent | 93d37985da59fbd5a42c0d868dc3616b0f8d05cc (diff) | |
services: base: Use 'match-record' instead of 'match'.
* gnu/services/base.scm (agetty-shepherd-service)
(mingetty-shepherd-service)
(nscd.conf-file)
(udev-shepherd-service)
(udev-etc)
(gpm-shepherd-service)
(network-set-up/linux)
(network-tear-down/linux)
(static-networking-shepherd-service)
(greetd-agreety-tty-session-command)
(greetd-agreety-tty-xdg-session-command): Use 'match-record' instead of
'match'.
(guix-accounts): Use <guix-configuration> accessors.
(udev-service-type): Use <udev-configuration> accessors.
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/base.scm | 922 |
1 files changed, 460 insertions, 462 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d99548573d1..370696a55e1 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm | |||
| @@ -977,148 +977,148 @@ to use as the tty. This is primarily useful for headless systems." | |||
| 977 | ((device-name _ ...) | 977 | ((device-name _ ...) |
| 978 | device-name)))))))) | 978 | device-name)))))))) |
| 979 | 979 | ||
| 980 | (define agetty-shepherd-service | 980 | (define (agetty-shepherd-service config) |
| 981 | (match-lambda | 981 | (match-record config <agetty-configuration> |
| 982 | (($ <agetty-configuration> agetty tty term baud-rate auto-login | 982 | (agetty tty term baud-rate auto-login |
| 983 | login-program login-pause? eight-bits? no-reset? remote? flow-control? | 983 | login-program login-pause? eight-bits? no-reset? remote? flow-control? |
| 984 | host no-issue? init-string no-clear? local-line extract-baud? | 984 | host no-issue? init-string no-clear? local-line extract-baud? |
| 985 | skip-login? no-newline? login-options chroot hangup? keep-baud? timeout | 985 | skip-login? no-newline? login-options chroot hangup? keep-baud? timeout |
| 986 | detect-case? wait-cr? no-hints? no-hostname? long-hostname? | 986 | detect-case? wait-cr? no-hints? no-hostname? long-hostname? |
| 987 | erase-characters kill-characters chdir delay nice extra-options | 987 | erase-characters kill-characters chdir delay nice extra-options |
| 988 | shepherd-requirement) | 988 | shepherd-requirement) |
| 989 | (list | 989 | (list |
| 990 | (shepherd-service | 990 | (shepherd-service |
| 991 | (documentation "Run agetty on a tty.") | 991 | (documentation "Run agetty on a tty.") |
| 992 | (provision (list (symbol-append 'term- (string->symbol (or tty "console"))))) | 992 | (provision (list (symbol-append 'term- (string->symbol (or tty "console"))))) |
| 993 | 993 | ||
| 994 | ;; Since the login prompt shows the host name, wait for the 'host-name' | 994 | ;; Since the login prompt shows the host name, wait for the 'host-name' |
| 995 | ;; service to be done. Also wait for udev essentially so that the tty | 995 | ;; service to be done. Also wait for udev essentially so that the tty |
| 996 | ;; text is not lost in the middle of kernel messages (see also | 996 | ;; text is not lost in the middle of kernel messages (see also |
| 997 | ;; mingetty-shepherd-service). | 997 | ;; mingetty-shepherd-service). |
| 998 | (requirement (cons* 'user-processes 'host-name 'udev | 998 | (requirement (cons* 'user-processes 'host-name 'udev |
| 999 | shepherd-requirement)) | 999 | shepherd-requirement)) |
| 1000 | 1000 | ||
| 1001 | (modules '((ice-9 match) (gnu build linux-boot))) | 1001 | (modules '((ice-9 match) (gnu build linux-boot))) |
| 1002 | (start | 1002 | (start |
| 1003 | (with-imported-modules (source-module-closure | 1003 | (with-imported-modules (source-module-closure |
| 1004 | '((gnu build linux-boot))) | 1004 | '((gnu build linux-boot))) |
| 1005 | #~(lambda args | 1005 | #~(lambda args |
| 1006 | (let ((defaulted-tty #$(or tty (default-serial-port)))) | 1006 | (let ((defaulted-tty #$(or tty (default-serial-port)))) |
| 1007 | (apply | 1007 | (apply |
| 1008 | (if defaulted-tty | 1008 | (if defaulted-tty |
| 1009 | (make-forkexec-constructor | 1009 | (make-forkexec-constructor |
| 1010 | (list #$(file-append util-linux "/sbin/agetty") | 1010 | (list #$(file-append util-linux "/sbin/agetty") |
| 1011 | #$@extra-options | 1011 | #$@extra-options |
| 1012 | #$@(if eight-bits? | 1012 | #$@(if eight-bits? |
| 1013 | #~("--8bits") | 1013 | #~("--8bits") |
| 1014 | #~()) | 1014 | #~()) |
| 1015 | #$@(if no-reset? | 1015 | #$@(if no-reset? |
| 1016 | #~("--noreset") | 1016 | #~("--noreset") |
| 1017 | #~()) | 1017 | #~()) |
| 1018 | #$@(if remote? | 1018 | #$@(if remote? |
| 1019 | #~("--remote") | 1019 | #~("--remote") |
| 1020 | #~()) | 1020 | #~()) |
| 1021 | #$@(if flow-control? | 1021 | #$@(if flow-control? |
| 1022 | #~("--flow-control") | 1022 | #~("--flow-control") |
| 1023 | #~()) | 1023 | #~()) |
| 1024 | #$@(if host | 1024 | #$@(if host |
| 1025 | #~("--host" #$host) | 1025 | #~("--host" #$host) |
| 1026 | #~()) | 1026 | #~()) |
| 1027 | #$@(if no-issue? | 1027 | #$@(if no-issue? |
| 1028 | #~("--noissue") | 1028 | #~("--noissue") |
| 1029 | #~()) | 1029 | #~()) |
| 1030 | #$@(if init-string | 1030 | #$@(if init-string |
| 1031 | #~("--init-string" #$init-string) | 1031 | #~("--init-string" #$init-string) |
| 1032 | #~()) | 1032 | #~()) |
| 1033 | #$@(if no-clear? | 1033 | #$@(if no-clear? |
| 1034 | #~("--noclear") | 1034 | #~("--noclear") |
| 1035 | #~()) | 1035 | #~()) |
| 1036 | ;;; FIXME This doesn't work as expected. According to agetty(8), if this option | 1036 | ;;; FIXME This doesn't work as expected. According to agetty(8), if this option |
| 1037 | ;;; is not passed, then the default is 'auto'. However, in my tests, when that | 1037 | ;;; is not passed, then the default is 'auto'. However, in my tests, when that |
| 1038 | ;;; option is selected, agetty never presents the login prompt, and the | 1038 | ;;; option is selected, agetty never presents the login prompt, and the |
| 1039 | ;;; term-ttyS0 service respawns every few seconds. | 1039 | ;;; term-ttyS0 service respawns every few seconds. |
| 1040 | #$@(if local-line | 1040 | #$@(if local-line |
| 1041 | #~(#$(match local-line | 1041 | #~(#$(match local-line |
| 1042 | ('auto "--local-line=auto") | 1042 | ('auto "--local-line=auto") |
| 1043 | ('always "--local-line=always") | 1043 | ('always "--local-line=always") |
| 1044 | ('never "-local-line=never"))) | 1044 | ('never "-local-line=never"))) |
| 1045 | #~()) | 1045 | #~()) |
| 1046 | #$@(if tty | 1046 | #$@(if tty |
| 1047 | #~() | 1047 | #~() |
| 1048 | #~("--keep-baud")) | 1048 | #~("--keep-baud")) |
| 1049 | #$@(if extract-baud? | 1049 | #$@(if extract-baud? |
| 1050 | #~("--extract-baud") | 1050 | #~("--extract-baud") |
| 1051 | #~()) | 1051 | #~()) |
| 1052 | #$@(if skip-login? | 1052 | #$@(if skip-login? |
| 1053 | #~("--skip-login") | 1053 | #~("--skip-login") |
| 1054 | #~()) | 1054 | #~()) |
| 1055 | #$@(if no-newline? | 1055 | #$@(if no-newline? |
| 1056 | #~("--nonewline") | 1056 | #~("--nonewline") |
| 1057 | #~()) | 1057 | #~()) |
| 1058 | #$@(if login-options | 1058 | #$@(if login-options |
| 1059 | #~("--login-options" #$login-options) | 1059 | #~("--login-options" #$login-options) |
| 1060 | #~()) | 1060 | #~()) |
| 1061 | #$@(if chroot | 1061 | #$@(if chroot |
| 1062 | #~("--chroot" #$chroot) | 1062 | #~("--chroot" #$chroot) |
| 1063 | #~()) | 1063 | #~()) |
| 1064 | #$@(if hangup? | 1064 | #$@(if hangup? |
| 1065 | #~("--hangup") | 1065 | #~("--hangup") |
| 1066 | #~()) | 1066 | #~()) |
| 1067 | #$@(if keep-baud? | 1067 | #$@(if keep-baud? |
| 1068 | #~("--keep-baud") | 1068 | #~("--keep-baud") |
| 1069 | #~()) | 1069 | #~()) |
| 1070 | #$@(if timeout | 1070 | #$@(if timeout |
| 1071 | #~("--timeout" #$(number->string timeout)) | 1071 | #~("--timeout" #$(number->string timeout)) |
| 1072 | #~()) | 1072 | #~()) |
| 1073 | #$@(if detect-case? | 1073 | #$@(if detect-case? |
| 1074 | #~("--detect-case") | 1074 | #~("--detect-case") |
| 1075 | #~()) | 1075 | #~()) |
| 1076 | #$@(if wait-cr? | 1076 | #$@(if wait-cr? |
| 1077 | #~("--wait-cr") | 1077 | #~("--wait-cr") |
| 1078 | #~()) | 1078 | #~()) |
| 1079 | #$@(if no-hints? | 1079 | #$@(if no-hints? |
| 1080 | #~("--nohints?") | 1080 | #~("--nohints?") |
| 1081 | #~()) | 1081 | #~()) |
| 1082 | #$@(if no-hostname? | 1082 | #$@(if no-hostname? |
| 1083 | #~("--nohostname") | 1083 | #~("--nohostname") |
| 1084 | #~()) | 1084 | #~()) |
| 1085 | #$@(if long-hostname? | 1085 | #$@(if long-hostname? |
| 1086 | #~("--long-hostname") | 1086 | #~("--long-hostname") |
| 1087 | #~()) | 1087 | #~()) |
| 1088 | #$@(if erase-characters | 1088 | #$@(if erase-characters |
| 1089 | #~("--erase-chars" #$erase-characters) | 1089 | #~("--erase-chars" #$erase-characters) |
| 1090 | #~()) | 1090 | #~()) |
| 1091 | #$@(if kill-characters | 1091 | #$@(if kill-characters |
| 1092 | #~("--kill-chars" #$kill-characters) | 1092 | #~("--kill-chars" #$kill-characters) |
| 1093 | #~()) | 1093 | #~()) |
| 1094 | #$@(if chdir | 1094 | #$@(if chdir |
| 1095 | #~("--chdir" #$chdir) | 1095 | #~("--chdir" #$chdir) |
| 1096 | #~()) | 1096 | #~()) |
| 1097 | #$@(if delay | 1097 | #$@(if delay |
| 1098 | #~("--delay" #$(number->string delay)) | 1098 | #~("--delay" #$(number->string delay)) |
| 1099 | #~()) | 1099 | #~()) |
| 1100 | #$@(if nice | 1100 | #$@(if nice |
| 1101 | #~("--nice" #$(number->string nice)) | 1101 | #~("--nice" #$(number->string nice)) |
| 1102 | #~()) | 1102 | #~()) |
| 1103 | #$@(if auto-login | 1103 | #$@(if auto-login |
| 1104 | (list "--autologin" auto-login) | 1104 | (list "--autologin" auto-login) |
| 1105 | '()) | 1105 | '()) |
| 1106 | #$@(if login-program | 1106 | #$@(if login-program |
| 1107 | #~("--login-program" #$login-program) | 1107 | #~("--login-program" #$login-program) |
| 1108 | #~()) | 1108 | #~()) |
| 1109 | #$@(if login-pause? | 1109 | #$@(if login-pause? |
| 1110 | #~("--login-pause") | 1110 | #~("--login-pause") |
| 1111 | #~()) | 1111 | #~()) |
| 1112 | defaulted-tty | 1112 | defaulted-tty |
| 1113 | #$@(if baud-rate | 1113 | #$@(if baud-rate |
| 1114 | #~(#$baud-rate) | 1114 | #~(#$baud-rate) |
| 1115 | #~()) | 1115 | #~()) |
| 1116 | #$@(if term | 1116 | #$@(if term |
| 1117 | #~(#$term) | 1117 | #~(#$term) |
| 1118 | #~()))) | 1118 | #~()))) |
| 1119 | (const #f)) ; never start. | 1119 | (const #f)) ; never start. |
| 1120 | args))))) | 1120 | args))))) |
| 1121 | (stop #~(make-kill-destructor))))))) | 1121 | (stop #~(make-kill-destructor)))))) |
| 1122 | 1122 | ||
| 1123 | (define agetty-service-type | 1123 | (define agetty-service-type |
| 1124 | (service-type (name 'agetty) | 1124 | (service-type (name 'agetty) |
| @@ -1148,42 +1148,42 @@ the tty to run, among other things." | |||
| 1148 | (clear-on-logout? mingetty-clear-on-logout? ;Boolean | 1148 | (clear-on-logout? mingetty-clear-on-logout? ;Boolean |
| 1149 | (default #t))) | 1149 | (default #t))) |
| 1150 | 1150 | ||
| 1151 | (define mingetty-shepherd-service | 1151 | (define (mingetty-shepherd-service config) |
| 1152 | (match-lambda | 1152 | (match-record config <mingetty-configuration> |
| 1153 | (($ <mingetty-configuration> mingetty tty auto-login login-program | 1153 | (mingetty tty auto-login login-program |
| 1154 | login-pause? clear-on-logout?) | 1154 | login-pause? clear-on-logout?) |
| 1155 | (list | 1155 | (list |
| 1156 | (shepherd-service | 1156 | (shepherd-service |
| 1157 | (documentation "Run mingetty on an tty.") | 1157 | (documentation "Run mingetty on an tty.") |
| 1158 | (provision (list (symbol-append 'term- (string->symbol tty)))) | 1158 | (provision (list (symbol-append 'term- (string->symbol tty)))) |
| 1159 | 1159 | ||
| 1160 | ;; Since the login prompt shows the host name, wait for the 'host-name' | 1160 | ;; Since the login prompt shows the host name, wait for the 'host-name' |
| 1161 | ;; service to be done. Also wait for udev essentially so that the tty | 1161 | ;; service to be done. Also wait for udev essentially so that the tty |
| 1162 | ;; text is not lost in the middle of kernel messages (XXX). | 1162 | ;; text is not lost in the middle of kernel messages (XXX). |
| 1163 | (requirement '(user-processes host-name udev virtual-terminal)) | 1163 | (requirement '(user-processes host-name udev virtual-terminal)) |
| 1164 | 1164 | ||
| 1165 | (start #~(make-forkexec-constructor | 1165 | (start #~(make-forkexec-constructor |
| 1166 | (list #$(file-append mingetty "/sbin/mingetty") | 1166 | (list #$(file-append mingetty "/sbin/mingetty") |
| 1167 | 1167 | ||
| 1168 | ;; Avoiding 'vhangup' allows us to avoid 'setfont' | 1168 | ;; Avoiding 'vhangup' allows us to avoid 'setfont' |
| 1169 | ;; errors down the path where various ioctls get | 1169 | ;; errors down the path where various ioctls get |
| 1170 | ;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c | 1170 | ;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c |
| 1171 | ;; in Linux. | 1171 | ;; in Linux. |
| 1172 | "--nohangup" #$tty | 1172 | "--nohangup" #$tty |
| 1173 | 1173 | ||
| 1174 | #$@(if clear-on-logout? | 1174 | #$@(if clear-on-logout? |
| 1175 | #~() | 1175 | #~() |
| 1176 | #~("--noclear")) | 1176 | #~("--noclear")) |
| 1177 | #$@(if auto-login | 1177 | #$@(if auto-login |
| 1178 | #~("--autologin" #$auto-login) | 1178 | #~("--autologin" #$auto-login) |
| 1179 | #~()) | 1179 | #~()) |
| 1180 | #$@(if login-program | 1180 | #$@(if login-program |
| 1181 | #~("--loginprog" #$login-program) | 1181 | #~("--loginprog" #$login-program) |
| 1182 | #~()) | 1182 | #~()) |
| 1183 | #$@(if login-pause? | 1183 | #$@(if login-pause? |
| 1184 | #~("--loginpause") | 1184 | #~("--loginpause") |
| 1185 | #~())))) | 1185 | #~())))) |
| 1186 | (stop #~(make-kill-destructor))))))) | 1186 | (stop #~(make-kill-destructor)))))) |
| 1187 | 1187 | ||
| 1188 | (define mingetty-service-type | 1188 | (define mingetty-service-type |
| 1189 | (service-type (name 'mingetty) | 1189 | (service-type (name 'mingetty) |
| @@ -1260,46 +1260,47 @@ the tty to run, among other things." | |||
| 1260 | (define (nscd.conf-file config) | 1260 | (define (nscd.conf-file config) |
| 1261 | "Return the @file{nscd.conf} configuration file for @var{config}, an | 1261 | "Return the @file{nscd.conf} configuration file for @var{config}, an |
| 1262 | @code{<nscd-configuration>} object." | 1262 | @code{<nscd-configuration>} object." |
| 1263 | (define cache->config | 1263 | (define (cache->config cache) |
| 1264 | (match-lambda | 1264 | (match-record cache <nscd-cache> |
| 1265 | (($ <nscd-cache> (= symbol->string database) | 1265 | (database positive-time-to-live negative-time-to-live |
| 1266 | positive-ttl negative-ttl size check-files? | 1266 | suggested-size check-files? |
| 1267 | persistent? shared? max-size propagate?) | 1267 | persistent? shared? max-database-size auto-propagate?) |
| 1268 | (string-append "\nenable-cache\t" database "\tyes\n" | 1268 | (let ((database (symbol->string database))) |
| 1269 | 1269 | (string-append "\nenable-cache\t" database "\tyes\n" | |
| 1270 | "positive-time-to-live\t" database "\t" | 1270 | |
| 1271 | (number->string positive-ttl) "\n" | 1271 | "positive-time-to-live\t" database "\t" |
| 1272 | "negative-time-to-live\t" database "\t" | 1272 | (number->string positive-time-to-live) "\n" |
| 1273 | (number->string negative-ttl) "\n" | 1273 | "negative-time-to-live\t" database "\t" |
| 1274 | "suggested-size\t" database "\t" | 1274 | (number->string negative-time-to-live) "\n" |
| 1275 | (number->string size) "\n" | 1275 | "suggested-size\t" database "\t" |
| 1276 | "check-files\t" database "\t" | 1276 | (number->string suggested-size) "\n" |
| 1277 | (if check-files? "yes\n" "no\n") | 1277 | "check-files\t" database "\t" |
| 1278 | "persistent\t" database "\t" | 1278 | (if check-files? "yes\n" "no\n") |
| 1279 | (if persistent? "yes\n" "no\n") | 1279 | "persistent\t" database "\t" |
| 1280 | "shared\t" database "\t" | 1280 | (if persistent? "yes\n" "no\n") |
| 1281 | (if shared? "yes\n" "no\n") | 1281 | "shared\t" database "\t" |
| 1282 | "max-db-size\t" database "\t" | 1282 | (if shared? "yes\n" "no\n") |
| 1283 | (number->string max-size) "\n" | 1283 | "max-db-size\t" database "\t" |
| 1284 | "auto-propagate\t" database "\t" | 1284 | (number->string max-database-size) "\n" |
| 1285 | (if propagate? "yes\n" "no\n"))))) | 1285 | "auto-propagate\t" database "\t" |
| 1286 | 1286 | (if auto-propagate? "yes\n" "no\n"))))) | |
| 1287 | (match config | 1287 | |
| 1288 | (($ <nscd-configuration> log-file debug-level caches) | 1288 | (match-record config <nscd-configuration> |
| 1289 | (plain-file "nscd.conf" | 1289 | (log-file debug-level caches) |
| 1290 | (string-append "\ | 1290 | (plain-file "nscd.conf" |
| 1291 | (string-append "\ | ||
| 1291 | # Configuration of libc's name service cache daemon (nscd).\n\n" | 1292 | # Configuration of libc's name service cache daemon (nscd).\n\n" |
| 1292 | (if log-file | 1293 | (if log-file |
| 1293 | (string-append "logfile\t" log-file) | 1294 | (string-append "logfile\t" log-file) |
| 1294 | "") | 1295 | "") |
| 1295 | "\n" | 1296 | "\n" |
| 1296 | (if debug-level | 1297 | (if debug-level |
| 1297 | (string-append "debug-level\t" | 1298 | (string-append "debug-level\t" |
| 1298 | (number->string debug-level)) | 1299 | (number->string debug-level)) |
| 1299 | "") | 1300 | "") |
| 1300 | "\n" | 1301 | "\n" |
| 1301 | (string-concatenate | 1302 | (string-concatenate |
| 1302 | (map cache->config caches))))))) | 1303 | (map cache->config caches)))))) |
| 1303 | 1304 | ||
| 1304 | (define (nscd-action-procedure nscd config option) | 1305 | (define (nscd-action-procedure nscd config option) |
| 1305 | ;; XXX: This is duplicated from mcron; factorize. | 1306 | ;; XXX: This is duplicated from mcron; factorize. |
| @@ -1797,17 +1798,15 @@ proxy of 'guix-daemon'...~%") | |||
| 1797 | 1798 | ||
| 1798 | (define (guix-accounts config) | 1799 | (define (guix-accounts config) |
| 1799 | "Return the user accounts and user groups for CONFIG." | 1800 | "Return the user accounts and user groups for CONFIG." |
| 1800 | (match config | 1801 | (cons (user-group |
| 1801 | (($ <guix-configuration> _ build-group build-accounts) | 1802 | (name (guix-configuration-build-group config)) |
| 1802 | (cons (user-group | 1803 | (system? #t) |
| 1803 | (name build-group) | 1804 | |
| 1804 | (system? #t) | 1805 | ;; Use a fixed GID so that we can create the store with the right |
| 1805 | 1806 | ;; owner. | |
| 1806 | ;; Use a fixed GID so that we can create the store with the right | 1807 | (id 30000)) |
| 1807 | ;; owner. | 1808 | (guix-build-accounts (guix-configuration-build-accounts config) |
| 1808 | (id 30000)) | 1809 | #:group (guix-configuration-build-group config)))) |
| 1809 | (guix-build-accounts build-accounts | ||
| 1810 | #:group build-group))))) | ||
| 1811 | 1810 | ||
| 1812 | (define (guix-activation config) | 1811 | (define (guix-activation config) |
| 1813 | "Return the activation gexp for CONFIG." | 1812 | "Return the activation gexp for CONFIG." |
| @@ -2130,95 +2129,94 @@ item of @var{packages}." | |||
| 2130 | (udev-rule "90-kvm.rules" | 2129 | (udev-rule "90-kvm.rules" |
| 2131 | "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n")) | 2130 | "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n")) |
| 2132 | 2131 | ||
| 2133 | (define udev-shepherd-service | 2132 | (define (udev-shepherd-service config) |
| 2134 | ;; Return a <shepherd-service> for UDEV with RULES. | 2133 | ;; Return a <shepherd-service> for UDEV with RULES. |
| 2135 | (match-lambda | 2134 | (let ((udev (udev-configuration-udev config))) |
| 2136 | (($ <udev-configuration> udev) | 2135 | (list |
| 2137 | (list | 2136 | (shepherd-service |
| 2138 | (shepherd-service | 2137 | (provision '(udev)) |
| 2139 | (provision '(udev)) | 2138 | |
| 2140 | 2139 | ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can | |
| 2141 | ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can | 2140 | ;; be added: see |
| 2142 | ;; be added: see | 2141 | ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>. |
| 2143 | ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>. | 2142 | (requirement '(root-file-system)) |
| 2144 | (requirement '(root-file-system)) | 2143 | |
| 2145 | 2144 | (documentation "Populate the /dev directory, dynamically.") | |
| 2146 | (documentation "Populate the /dev directory, dynamically.") | 2145 | (start |
| 2147 | (start | 2146 | (with-imported-modules (source-module-closure |
| 2148 | (with-imported-modules (source-module-closure | 2147 | '((gnu build linux-boot))) |
| 2149 | '((gnu build linux-boot))) | 2148 | #~(lambda () |
| 2150 | #~(lambda () | 2149 | (define udevd |
| 2151 | (define udevd | 2150 | ;; 'udevd' from eudev. |
| 2152 | ;; 'udevd' from eudev. | 2151 | #$(file-append udev "/sbin/udevd")) |
| 2153 | #$(file-append udev "/sbin/udevd")) | 2152 | |
| 2154 | 2153 | (define (wait-for-udevd) | |
| 2155 | (define (wait-for-udevd) | 2154 | ;; Wait until someone's listening on udevd's control |
| 2156 | ;; Wait until someone's listening on udevd's control | 2155 | ;; socket. |
| 2157 | ;; socket. | 2156 | (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) |
| 2158 | (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) | 2157 | (let try () |
| 2159 | (let try () | 2158 | (catch 'system-error |
| 2160 | (catch 'system-error | 2159 | (lambda () |
| 2161 | (lambda () | 2160 | (connect sock PF_UNIX "/run/udev/control") |
| 2162 | (connect sock PF_UNIX "/run/udev/control") | 2161 | (close-port sock)) |
| 2163 | (close-port sock)) | 2162 | (lambda args |
| 2164 | (lambda args | 2163 | (format #t "waiting for udevd...~%") |
| 2165 | (format #t "waiting for udevd...~%") | 2164 | (usleep 500000) |
| 2166 | (usleep 500000) | 2165 | (try)))))) |
| 2167 | (try)))))) | 2166 | |
| 2168 | 2167 | ;; Allow udev to find the modules. | |
| 2169 | ;; Allow udev to find the modules. | 2168 | (setenv "LINUX_MODULE_DIRECTORY" |
| 2170 | (setenv "LINUX_MODULE_DIRECTORY" | 2169 | "/run/booted-system/kernel/lib/modules") |
| 2171 | "/run/booted-system/kernel/lib/modules") | 2170 | |
| 2172 | 2171 | (let* ((kernel-release | |
| 2173 | (let* ((kernel-release | 2172 | (utsname:release (uname))) |
| 2174 | (utsname:release (uname))) | 2173 | (linux-module-directory |
| 2175 | (linux-module-directory | 2174 | (getenv "LINUX_MODULE_DIRECTORY")) |
| 2176 | (getenv "LINUX_MODULE_DIRECTORY")) | 2175 | (directory |
| 2177 | (directory | 2176 | (string-append linux-module-directory "/" |
| 2178 | (string-append linux-module-directory "/" | 2177 | kernel-release)) |
| 2179 | kernel-release)) | 2178 | (old-umask (umask #o022))) |
| 2180 | (old-umask (umask #o022))) | 2179 | ;; If we're in a container, DIRECTORY might not exist, |
| 2181 | ;; If we're in a container, DIRECTORY might not exist, | 2180 | ;; for instance because the host runs a different |
| 2182 | ;; for instance because the host runs a different | 2181 | ;; kernel. In that case, skip it; we'll just miss a few |
| 2183 | ;; kernel. In that case, skip it; we'll just miss a few | 2182 | ;; nodes like /dev/fuse. |
| 2184 | ;; nodes like /dev/fuse. | 2183 | (when (file-exists? directory) |
| 2185 | (when (file-exists? directory) | 2184 | (make-static-device-nodes directory)) |
| 2186 | (make-static-device-nodes directory)) | 2185 | (umask old-umask)) |
| 2187 | (umask old-umask)) | 2186 | |
| 2188 | 2187 | (let ((pid (fork+exec-command | |
| 2189 | (let ((pid (fork+exec-command | 2188 | (list udevd) |
| 2190 | (list udevd) | 2189 | #:environment-variables |
| 2191 | #:environment-variables | 2190 | (cons* |
| 2192 | (cons* | 2191 | ;; The first one is for udev, the second one for |
| 2193 | ;; The first one is for udev, the second one for | 2192 | ;; eudev. |
| 2194 | ;; eudev. | 2193 | "UDEV_CONFIG_FILE=/etc/udev/udev.conf" |
| 2195 | "UDEV_CONFIG_FILE=/etc/udev/udev.conf" | 2194 | "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d" |
| 2196 | "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d" | 2195 | (string-append "LINUX_MODULE_DIRECTORY=" |
| 2197 | (string-append "LINUX_MODULE_DIRECTORY=" | 2196 | (getenv "LINUX_MODULE_DIRECTORY")) |
| 2198 | (getenv "LINUX_MODULE_DIRECTORY")) | 2197 | (default-environment-variables))))) |
| 2199 | (default-environment-variables))))) | 2198 | ;; Wait until udevd is up and running. This appears to |
| 2200 | ;; Wait until udevd is up and running. This appears to | 2199 | ;; be needed so that the events triggered below are |
| 2201 | ;; be needed so that the events triggered below are | 2200 | ;; actually handled. |
| 2202 | ;; actually handled. | 2201 | (wait-for-udevd) |
| 2203 | (wait-for-udevd) | 2202 | |
| 2204 | 2203 | ;; Trigger device node creation. | |
| 2205 | ;; Trigger device node creation. | 2204 | (system* #$(file-append udev "/bin/udevadm") |
| 2206 | (system* #$(file-append udev "/bin/udevadm") | 2205 | "trigger" "--action=add") |
| 2207 | "trigger" "--action=add") | 2206 | |
| 2208 | 2207 | ;; Wait for things to settle down. | |
| 2209 | ;; Wait for things to settle down. | 2208 | (system* #$(file-append udev "/bin/udevadm") |
| 2210 | (system* #$(file-append udev "/bin/udevadm") | 2209 | "settle") |
| 2211 | "settle") | 2210 | pid)))) |
| 2212 | pid)))) | 2211 | (stop #~(make-kill-destructor)) |
| 2213 | (stop #~(make-kill-destructor)) | 2212 | |
| 2214 | 2213 | ;; When halting the system, 'udev' is actually killed by | |
| 2215 | ;; When halting the system, 'udev' is actually killed by | 2214 | ;; 'user-processes', i.e., before its own 'stop' method was called. |
| 2216 | ;; 'user-processes', i.e., before its own 'stop' method was called. | 2215 | ;; Thus, make sure it is not respawned. |
| 2217 | ;; Thus, make sure it is not respawned. | 2216 | (respawn? #f) |
| 2218 | (respawn? #f) | 2217 | ;; We need additional modules. |
| 2219 | ;; We need additional modules. | 2218 | (modules `((gnu build linux-boot) ;'make-static-device-nodes' |
| 2220 | (modules `((gnu build linux-boot) ;'make-static-device-nodes' | 2219 | ,@%default-modules)))))) |
| 2221 | ,@%default-modules))))))) | ||
| 2222 | 2220 | ||
| 2223 | (define udev.conf | 2221 | (define udev.conf |
| 2224 | (computed-file "udev.conf" | 2222 | (computed-file "udev.conf" |
| @@ -2226,14 +2224,15 @@ item of @var{packages}." | |||
| 2226 | (lambda (port) | 2224 | (lambda (port) |
| 2227 | (format port "udev_rules=\"/etc/udev/rules.d\"~%"))))) | 2225 | (format port "udev_rules=\"/etc/udev/rules.d\"~%"))))) |
| 2228 | 2226 | ||
| 2229 | (define udev-etc | 2227 | (define (udev-etc config) |
| 2230 | (match-lambda | 2228 | (match-record config <udev-configuration> |
| 2231 | (($ <udev-configuration> udev rules) | 2229 | (udev rules) |
| 2232 | `(("udev" | 2230 | `(("udev" |
| 2233 | ,(file-union | 2231 | ,(file-union "udev" |
| 2234 | "udev" `(("udev.conf" ,udev.conf) | 2232 | `(("udev.conf" ,udev.conf) |
| 2235 | ("rules.d" ,(udev-rules-union (cons* udev kvm-udev-rule | 2233 | ("rules.d" |
| 2236 | rules)))))))))) | 2234 | ,(udev-rules-union (cons* udev kvm-udev-rule |
| 2235 | rules))))))))) | ||
| 2237 | 2236 | ||
| 2238 | (define udev-service-type | 2237 | (define udev-service-type |
| 2239 | (service-type (name 'udev) | 2238 | (service-type (name 'udev) |
| @@ -2243,11 +2242,11 @@ item of @var{packages}." | |||
| 2243 | (service-extension etc-service-type udev-etc))) | 2242 | (service-extension etc-service-type udev-etc))) |
| 2244 | (compose concatenate) ;concatenate the list of rules | 2243 | (compose concatenate) ;concatenate the list of rules |
| 2245 | (extend (lambda (config rules) | 2244 | (extend (lambda (config rules) |
| 2246 | (match config | 2245 | (let ((initial-rules |
| 2247 | (($ <udev-configuration> udev initial-rules) | 2246 | (udev-configuration-rules config))) |
| 2248 | (udev-configuration | 2247 | (udev-configuration |
| 2249 | (udev udev) | 2248 | (inherit config) |
| 2250 | (rules (append initial-rules rules))))))) | 2249 | (rules (append initial-rules rules)))))) |
| 2251 | (default-value (udev-configuration)) | 2250 | (default-value (udev-configuration)) |
| 2252 | (description | 2251 | (description |
| 2253 | "Run @command{udev}, which populates the @file{/dev} | 2252 | "Run @command{udev}, which populates the @file{/dev} |
| @@ -2385,23 +2384,23 @@ instance." | |||
| 2385 | (options gpm-configuration-options ;list of strings | 2384 | (options gpm-configuration-options ;list of strings |
| 2386 | (default %default-gpm-options))) | 2385 | (default %default-gpm-options))) |
| 2387 | 2386 | ||
| 2388 | (define gpm-shepherd-service | 2387 | (define (gpm-shepherd-service config) |
| 2389 | (match-lambda | 2388 | (match-record config <gpm-configuration> |
| 2390 | (($ <gpm-configuration> gpm options) | 2389 | (gpm options) |
| 2391 | (list (shepherd-service | 2390 | (list (shepherd-service |
| 2392 | (requirement '(udev)) | 2391 | (requirement '(udev)) |
| 2393 | (provision '(gpm)) | 2392 | (provision '(gpm)) |
| 2394 | ;; 'gpm' runs in the background and sets a PID file. | 2393 | ;; 'gpm' runs in the background and sets a PID file. |
| 2395 | ;; Note that it requires running as "root". | 2394 | ;; Note that it requires running as "root". |
| 2396 | (start #~(make-forkexec-constructor | 2395 | (start #~(make-forkexec-constructor |
| 2397 | (list #$(file-append gpm "/sbin/gpm") | 2396 | (list #$(file-append gpm "/sbin/gpm") |
| 2398 | #$@options) | 2397 | #$@options) |
| 2399 | #:pid-file "/var/run/gpm.pid" | 2398 | #:pid-file "/var/run/gpm.pid" |
| 2400 | #:pid-file-timeout 3)) | 2399 | #:pid-file-timeout 3)) |
| 2401 | (stop #~(lambda (_) | 2400 | (stop #~(lambda (_) |
| 2402 | ;; Return #f if successfully stopped. | 2401 | ;; Return #f if successfully stopped. |
| 2403 | (not (zero? (system* #$(file-append gpm "/sbin/gpm") | 2402 | (not (zero? (system* #$(file-append gpm "/sbin/gpm") |
| 2404 | "-k")))))))))) | 2403 | "-k"))))))))) |
| 2405 | 2404 | ||
| 2406 | (define gpm-service-type | 2405 | (define gpm-service-type |
| 2407 | (service-type (name 'gpm) | 2406 | (service-type (name 'gpm) |
| @@ -2654,32 +2653,64 @@ to CONFIG." | |||
| 2654 | "/servers/socket/2") | 2653 | "/servers/socket/2") |
| 2655 | #f)))) | 2654 | #f)))) |
| 2656 | 2655 | ||
| 2657 | (define network-set-up/linux | 2656 | (define (network-set-up/linux config) |
| 2658 | (match-lambda | 2657 | (match-record config <static-networking> |
| 2659 | (($ <static-networking> addresses links routes) | 2658 | (addresses links routes) |
| 2660 | (scheme-file "set-up-network" | 2659 | (scheme-file "set-up-network" |
| 2661 | (with-extensions (list guile-netlink) | 2660 | (with-extensions (list guile-netlink) |
| 2662 | #~(begin | 2661 | #~(begin |
| 2663 | (use-modules (ip addr) (ip link) (ip route)) | 2662 | (use-modules (ip addr) (ip link) (ip route)) |
| 2664 | 2663 | ||
| 2665 | #$@(map (lambda (address) | 2664 | #$@(map (lambda (address) |
| 2666 | #~(begin | 2665 | #~(begin |
| 2667 | (addr-add #$(network-address-device address) | 2666 | (addr-add #$(network-address-device address) |
| 2668 | #$(network-address-value address) | 2667 | #$(network-address-value address) |
| 2669 | #:ipv6? | 2668 | #:ipv6? |
| 2670 | #$(network-address-ipv6? address)) | 2669 | #$(network-address-ipv6? address)) |
| 2671 | ;; FIXME: loopback? | 2670 | ;; FIXME: loopback? |
| 2672 | (link-set #$(network-address-device address) | 2671 | (link-set #$(network-address-device address) |
| 2673 | #:multicast-on #t | 2672 | #:multicast-on #t |
| 2674 | #:up #t))) | 2673 | #:up #t))) |
| 2675 | addresses) | 2674 | addresses) |
| 2676 | #$@(map (match-lambda | 2675 | #$@(map (match-lambda |
| 2677 | (($ <network-link> name type arguments) | 2676 | (($ <network-link> name type arguments) |
| 2678 | #~(link-add #$name #$type | 2677 | #~(link-add #$name #$type |
| 2679 | #:type-args '#$arguments))) | 2678 | #:type-args '#$arguments))) |
| 2680 | links) | 2679 | links) |
| 2681 | #$@(map (lambda (route) | 2680 | #$@(map (lambda (route) |
| 2682 | #~(route-add #$(network-route-destination route) | 2681 | #~(route-add #$(network-route-destination route) |
| 2682 | #:device | ||
| 2683 | #$(network-route-device route) | ||
| 2684 | #:ipv6? | ||
| 2685 | #$(network-route-ipv6? route) | ||
| 2686 | #:via | ||
| 2687 | #$(network-route-gateway route) | ||
| 2688 | #:src | ||
| 2689 | #$(network-route-source route))) | ||
| 2690 | routes) | ||
| 2691 | #t))))) | ||
| 2692 | |||
| 2693 | (define (network-tear-down/linux config) | ||
| 2694 | (match-record config <static-networking> | ||
| 2695 | (addresses links routes) | ||
| 2696 | (scheme-file "tear-down-network" | ||
| 2697 | (with-extensions (list guile-netlink) | ||
| 2698 | #~(begin | ||
| 2699 | (use-modules (ip addr) (ip link) (ip route) | ||
| 2700 | (netlink error) | ||
| 2701 | (srfi srfi-34)) | ||
| 2702 | |||
| 2703 | (define-syntax-rule (false-if-netlink-error exp) | ||
| 2704 | (guard (c ((netlink-error? c) #f)) | ||
| 2705 | exp)) | ||
| 2706 | |||
| 2707 | ;; Wrap calls in 'false-if-netlink-error' so this | ||
| 2708 | ;; script goes as far as possible undoing the effects | ||
| 2709 | ;; of "set-up-network". | ||
| 2710 | |||
| 2711 | #$@(map (lambda (route) | ||
| 2712 | #~(false-if-netlink-error | ||
| 2713 | (route-del #$(network-route-destination route) | ||
| 2683 | #:device | 2714 | #:device |
| 2684 | #$(network-route-device route) | 2715 | #$(network-route-device route) |
| 2685 | #:ipv6? | 2716 | #:ipv6? |
| @@ -2687,80 +2718,47 @@ to CONFIG." | |||
| 2687 | #:via | 2718 | #:via |
| 2688 | #$(network-route-gateway route) | 2719 | #$(network-route-gateway route) |
| 2689 | #:src | 2720 | #:src |
| 2690 | #$(network-route-source route))) | 2721 | #$(network-route-source route)))) |
| 2691 | routes) | 2722 | routes) |
| 2692 | #t)))))) | 2723 | #$@(map (match-lambda |
| 2693 | 2724 | (($ <network-link> name type arguments) | |
| 2694 | (define network-tear-down/linux | ||
| 2695 | (match-lambda | ||
| 2696 | (($ <static-networking> addresses links routes) | ||
| 2697 | (scheme-file "tear-down-network" | ||
| 2698 | (with-extensions (list guile-netlink) | ||
| 2699 | #~(begin | ||
| 2700 | (use-modules (ip addr) (ip link) (ip route) | ||
| 2701 | (netlink error) | ||
| 2702 | (srfi srfi-34)) | ||
| 2703 | |||
| 2704 | (define-syntax-rule (false-if-netlink-error exp) | ||
| 2705 | (guard (c ((netlink-error? c) #f)) | ||
| 2706 | exp)) | ||
| 2707 | |||
| 2708 | ;; Wrap calls in 'false-if-netlink-error' so this | ||
| 2709 | ;; script goes as far as possible undoing the effects | ||
| 2710 | ;; of "set-up-network". | ||
| 2711 | |||
| 2712 | #$@(map (lambda (route) | ||
| 2713 | #~(false-if-netlink-error | ||
| 2714 | (route-del #$(network-route-destination route) | ||
| 2715 | #:device | ||
| 2716 | #$(network-route-device route) | ||
| 2717 | #:ipv6? | ||
| 2718 | #$(network-route-ipv6? route) | ||
| 2719 | #:via | ||
| 2720 | #$(network-route-gateway route) | ||
| 2721 | #:src | ||
| 2722 | #$(network-route-source route)))) | ||
| 2723 | routes) | ||
| 2724 | #$@(map (match-lambda | ||
| 2725 | (($ <network-link> name type arguments) | ||
| 2726 | #~(false-if-netlink-error | ||
| 2727 | (link-del #$name)))) | ||
| 2728 | links) | ||
| 2729 | #$@(map (lambda (address) | ||
| 2730 | #~(false-if-netlink-error | 2725 | #~(false-if-netlink-error |
| 2731 | (addr-del #$(network-address-device | 2726 | (link-del #$name)))) |
| 2732 | address) | 2727 | links) |
| 2733 | #$(network-address-value address) | 2728 | #$@(map (lambda (address) |
| 2734 | #:ipv6? | 2729 | #~(false-if-netlink-error |
| 2735 | #$(network-address-ipv6? address)))) | 2730 | (addr-del #$(network-address-device |
| 2736 | addresses) | 2731 | address) |
| 2737 | #f)))))) | 2732 | #$(network-address-value address) |
| 2733 | #:ipv6? | ||
| 2734 | #$(network-address-ipv6? address)))) | ||
| 2735 | addresses) | ||
| 2736 | #f))))) | ||
| 2738 | 2737 | ||
| 2739 | (define (static-networking-shepherd-service config) | 2738 | (define (static-networking-shepherd-service config) |
| 2740 | (match config | 2739 | (match-record config <static-networking> |
| 2741 | (($ <static-networking> addresses links routes | 2740 | (addresses links routes provision requirement name-servers) |
| 2742 | provision requirement name-servers) | 2741 | (let ((loopback? (and provision (memq 'loopback provision)))) |
| 2743 | (let ((loopback? (and provision (memq 'loopback provision)))) | 2742 | (shepherd-service |
| 2744 | (shepherd-service | ||
| 2745 | 2743 | ||
| 2746 | (documentation | 2744 | (documentation |
| 2747 | "Bring up the networking interface using a static IP address.") | 2745 | "Bring up the networking interface using a static IP address.") |
| 2748 | (requirement requirement) | 2746 | (requirement requirement) |
| 2749 | (provision provision) | 2747 | (provision provision) |
| 2750 | 2748 | ||
| 2751 | (start #~(lambda _ | 2749 | (start #~(lambda _ |
| 2752 | ;; Return #t if successfully started. | 2750 | ;; Return #t if successfully started. |
| 2753 | (load #$(let-system (system target) | ||
| 2754 | (if (string-contains (or target system) "-linux") | ||
| 2755 | (network-set-up/linux config) | ||
| 2756 | (network-set-up/hurd config)))))) | ||
| 2757 | (stop #~(lambda _ | ||
| 2758 | ;; Return #f is successfully stopped. | ||
| 2759 | (load #$(let-system (system target) | 2751 | (load #$(let-system (system target) |
| 2760 | (if (string-contains (or target system) "-linux") | 2752 | (if (string-contains (or target system) "-linux") |
| 2761 | (network-tear-down/linux config) | 2753 | (network-set-up/linux config) |
| 2762 | (network-tear-down/hurd config)))))) | 2754 | (network-set-up/hurd config)))))) |
| 2763 | (respawn? #f)))))) | 2755 | (stop #~(lambda _ |
| 2756 | ;; Return #f is successfully stopped. | ||
| 2757 | (load #$(let-system (system target) | ||
| 2758 | (if (string-contains (or target system) "-linux") | ||
| 2759 | (network-tear-down/linux config) | ||
| 2760 | (network-tear-down/hurd config)))))) | ||
| 2761 | (respawn? #f))))) | ||
| 2764 | 2762 | ||
| 2765 | (define (static-networking-shepherd-services networks) | 2763 | (define (static-networking-shepherd-services networks) |
| 2766 | (map static-networking-shepherd-service networks)) | 2764 | (map static-networking-shepherd-service networks)) |
| @@ -2873,33 +2871,33 @@ to handle." | |||
| 2873 | (extra-env greetd-agreety-extra-env (default '())) | 2871 | (extra-env greetd-agreety-extra-env (default '())) |
| 2874 | (xdg-env? greetd-agreety-xdg-env? (default #t))) | 2872 | (xdg-env? greetd-agreety-xdg-env? (default #t))) |
| 2875 | 2873 | ||
| 2876 | (define greetd-agreety-tty-session-command | 2874 | (define (greetd-agreety-tty-session-command config) |
| 2877 | (match-lambda | 2875 | (match-record config <greetd-agreety-session> |
| 2878 | (($ <greetd-agreety-session> _ command args extra-env) | 2876 | (command command-args extra-env) |
| 2879 | (program-file | 2877 | (program-file |
| 2880 | "agreety-tty-session-command" | 2878 | "agreety-tty-session-command" |
| 2881 | #~(begin | 2879 | #~(begin |
| 2882 | (use-modules (ice-9 match)) | 2880 | (use-modules (ice-9 match)) |
| 2883 | (for-each (match-lambda ((var . val) (setenv var val))) | 2881 | (for-each (match-lambda ((var . val) (setenv var val))) |
| 2884 | (quote (#$@extra-env))) | 2882 | (quote (#$@extra-env))) |
| 2885 | (apply execl #$command #$command (list #$@args))))))) | 2883 | (apply execl #$command #$command (list #$@command-args)))))) |
| 2886 | 2884 | ||
| 2887 | (define greetd-agreety-tty-xdg-session-command | 2885 | (define (greetd-agreety-tty-xdg-session-command config) |
| 2888 | (match-lambda | 2886 | (match-record config <greetd-agreety-session> |
| 2889 | (($ <greetd-agreety-session> _ command args extra-env) | 2887 | (command command-args extra-env) |
| 2890 | (program-file | 2888 | (program-file |
| 2891 | "agreety-tty-xdg-session-command" | 2889 | "agreety-tty-xdg-session-command" |
| 2892 | #~(begin | 2890 | #~(begin |
| 2893 | (use-modules (ice-9 match)) | 2891 | (use-modules (ice-9 match)) |
| 2894 | (let* | 2892 | (let* |
| 2895 | ((username (getenv "USER")) | 2893 | ((username (getenv "USER")) |
| 2896 | (useruid (passwd:uid (getpwuid username))) | 2894 | (useruid (passwd:uid (getpwuid username))) |
| 2897 | (useruid (number->string useruid))) | 2895 | (useruid (number->string useruid))) |
| 2898 | (setenv "XDG_SESSION_TYPE" "tty") | 2896 | (setenv "XDG_SESSION_TYPE" "tty") |
| 2899 | (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))) | 2897 | (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid))) |
| 2900 | (for-each (match-lambda ((var . val) (setenv var val))) | 2898 | (for-each (match-lambda ((var . val) (setenv var val))) |
| 2901 | (quote (#$@extra-env))) | 2899 | (quote (#$@extra-env))) |
| 2902 | (apply execl #$command #$command (list #$@args))))))) | 2900 | (apply execl #$command #$command (list #$@command-args)))))) |
| 2903 | 2901 | ||
| 2904 | (define-gexp-compiler (greetd-agreety-session-compiler | 2902 | (define-gexp-compiler (greetd-agreety-session-compiler |
| 2905 | (session <greetd-agreety-session>) | 2903 | (session <greetd-agreety-session>) |
