diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-25 12:39:11 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-25 12:39:11 +0200 |
| commit | dac7dd1b0b40c9f8c81b5147c68f6387c2b16bfd (patch) | |
| tree | 7ee1acfecb728fec3a2b0c2373970449c82622a7 /gnu | |
| parent | 5fe12be0dd03d1a316343549f8c131d931f21a9a (diff) | |
Remove "guile-zlib" extension when unused.
This is a follow-up of 755f365b02b42a5d1e8ef3000dadef069553a478.
As (zlib) is autoloaded in (gnu build linux-modules), "guile-zlib" is needed
as an extension only when it is effectively used.
* gnu/installer.scm (installer-program): Remove "guile-zlib" from the extensions.
* gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto.
* gnu/services.scm (activation-script): Ditto.
* gnu/services/base.scm (default-serial-port): Ditto,
(agetty-shepherd-service): ditto,
(udev-service-type): ditto.
* gnu/system/image.scm (gcrypt-sqlite3&co): Ditto.
* gnu/system/shadow.scm (account-shepherd-service): Ditto.
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/installer.scm | 3 | ||||
| -rw-r--r-- | gnu/machine/ssh.scm | 35 | ||||
| -rw-r--r-- | gnu/services.scm | 46 | ||||
| -rw-r--r-- | gnu/services/base.scm | 428 | ||||
| -rw-r--r-- | gnu/system/image.scm | 2 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 12 |
6 files changed, 255 insertions, 271 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm index 576ac90a4b6..5c3192d7a69 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm | |||
| @@ -342,8 +342,7 @@ selected keymap." | |||
| 342 | ;; packages …), etc. modules. | 342 | ;; packages …), etc. modules. |
| 343 | (with-extensions (list guile-gcrypt guile-newt | 343 | (with-extensions (list guile-gcrypt guile-newt |
| 344 | guile-parted guile-bytestructures | 344 | guile-parted guile-bytestructures |
| 345 | guile-json-3 guile-git guile-zlib | 345 | guile-json-3 guile-git guix) |
| 346 | guix) | ||
| 347 | (with-imported-modules `(,@(source-module-closure | 346 | (with-imported-modules `(,@(source-module-closure |
| 348 | `(,@modules | 347 | `(,@modules |
| 349 | (gnu services herd) | 348 | (gnu services herd) |
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index ee5032e2810..4e31baa4b96 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm | |||
| @@ -21,7 +21,6 @@ | |||
| 21 | #:use-module (gnu bootloader) | 21 | #:use-module (gnu bootloader) |
| 22 | #:use-module (gnu machine) | 22 | #:use-module (gnu machine) |
| 23 | #:autoload (gnu packages gnupg) (guile-gcrypt) | 23 | #:autoload (gnu packages gnupg) (guile-gcrypt) |
| 24 | #:autoload (gnu packages guile) (guile-zlib) | ||
| 25 | #:use-module (gnu system) | 24 | #:use-module (gnu system) |
| 26 | #:use-module (gnu system file-systems) | 25 | #:use-module (gnu system file-systems) |
| 27 | #:use-module (gnu system uuid) | 26 | #:use-module (gnu system uuid) |
| @@ -249,24 +248,22 @@ not available in the initrd." | |||
| 249 | '((gnu build file-systems) | 248 | '((gnu build file-systems) |
| 250 | (gnu build linux-modules) | 249 | (gnu build linux-modules) |
| 251 | (gnu system uuid))) | 250 | (gnu system uuid))) |
| 252 | (with-extensions (list guile-zlib) | 251 | #~(begin |
| 253 | #~(begin | 252 | (use-modules (gnu build file-systems) |
| 254 | (use-modules (gnu build file-systems) | 253 | (gnu build linux-modules) |
| 255 | (gnu build linux-modules) | 254 | (gnu system uuid)) |
| 256 | (gnu system uuid)) | 255 | |
| 257 | 256 | (define dev | |
| 258 | (define dev | 257 | #$(cond ((string? device) device) |
| 259 | #$(cond ((string? device) device) | 258 | ((uuid? device) #~(find-partition-by-uuid |
| 260 | ((uuid? device) #~(find-partition-by-uuid | 259 | (string->uuid |
| 261 | (string->uuid | 260 | #$(uuid->string device)))) |
| 262 | #$(uuid->string device)))) | 261 | ((file-system-label? device) |
| 263 | ((file-system-label? device) | 262 | #~(find-partition-by-label |
| 264 | #~(find-partition-by-label | 263 | #$(file-system-label->string device))))) |
| 265 | #$(file-system-label->string device))))) | 264 | |
| 266 | 265 | (missing-modules dev '#$(operating-system-initrd-modules | |
| 267 | (missing-modules dev | 266 | (machine-operating-system machine))))))) |
| 268 | '#$(operating-system-initrd-modules | ||
| 269 | (machine-operating-system machine)))))))) | ||
| 270 | 267 | ||
| 271 | (remote-let ((missing remote-exp)) | 268 | (remote-let ((missing remote-exp)) |
| 272 | (unless (null? missing) | 269 | (unless (null? missing) |
diff --git a/gnu/services.scm b/gnu/services.scm index 3e59c6401f6..11ba21e8245 100644 --- a/gnu/services.scm +++ b/gnu/services.scm | |||
| @@ -35,7 +35,6 @@ | |||
| 35 | #:use-module (guix modules) | 35 | #:use-module (guix modules) |
| 36 | #:use-module (gnu packages base) | 36 | #:use-module (gnu packages base) |
| 37 | #:use-module (gnu packages bash) | 37 | #:use-module (gnu packages bash) |
| 38 | #:use-module (gnu packages guile) | ||
| 39 | #:use-module (gnu packages hurd) | 38 | #:use-module (gnu packages hurd) |
| 40 | #:use-module (srfi srfi-1) | 39 | #:use-module (srfi srfi-1) |
| 41 | #:use-module (srfi srfi-9) | 40 | #:use-module (srfi srfi-9) |
| @@ -586,29 +585,28 @@ ACTIVATION-SCRIPT-TYPE." | |||
| 586 | (with-imported-modules (source-module-closure | 585 | (with-imported-modules (source-module-closure |
| 587 | '((gnu build activation) | 586 | '((gnu build activation) |
| 588 | (guix build utils))) | 587 | (guix build utils))) |
| 589 | (with-extensions (list guile-zlib) | 588 | #~(begin |
| 590 | #~(begin | 589 | (use-modules (gnu build activation) |
| 591 | (use-modules (gnu build activation) | 590 | (guix build utils)) |
| 592 | (guix build utils)) | 591 | |
| 593 | 592 | ;; Make sure the user accounting database exists. If it | |
| 594 | ;; Make sure the user accounting database exists. If | 593 | ;; does not exist, 'setutxent' does not create it and |
| 595 | ;; it does not exist, 'setutxent' does not create it | 594 | ;; thus there is no accounting at all. |
| 596 | ;; and thus there is no accounting at all. | 595 | (close-port (open-file "/var/run/utmpx" "a0")) |
| 597 | (close-port (open-file "/var/run/utmpx" "a0")) | 596 | |
| 598 | 597 | ;; Same for 'wtmp', which is populated by mingetty et | |
| 599 | ;; Same for 'wtmp', which is populated by mingetty et | 598 | ;; al. |
| 600 | ;; al. | 599 | (mkdir-p "/var/log") |
| 601 | (mkdir-p "/var/log") | 600 | (close-port (open-file "/var/log/wtmp" "a0")) |
| 602 | (close-port (open-file "/var/log/wtmp" "a0")) | 601 | |
| 603 | 602 | ;; Set up /run/current-system. Among other things this | |
| 604 | ;; Set up /run/current-system. Among other things | 603 | ;; sets up locales, which the activation snippets |
| 605 | ;; this sets up locales, which the activation snippets | 604 | ;; executed below may expect. |
| 606 | ;; executed below may expect. | 605 | (activate-current-system) |
| 607 | (activate-current-system) | 606 | |
| 608 | 607 | ;; Run the services' activation snippets. | |
| 609 | ;; Run the services' activation snippets. | 608 | ;; TODO: Use 'load-compiled'. |
| 610 | ;; TODO: Use 'load-compiled'. | 609 | (for-each primitive-load '#$actions))))) |
| 611 | (for-each primitive-load '#$actions)))))) | ||
| 612 | 610 | ||
| 613 | (define (gexps->activation-gexp gexps) | 611 | (define (gexps->activation-gexp gexps) |
| 614 | "Return a gexp that runs the activation script containing GEXPS." | 612 | "Return a gexp that runs the activation script containing GEXPS." |
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 966e7fe024a..491f35702a0 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm | |||
| @@ -50,7 +50,6 @@ | |||
| 50 | #:select (coreutils glibc glibc-utf8-locales)) | 50 | #:select (coreutils glibc glibc-utf8-locales)) |
| 51 | #:use-module (gnu packages package-management) | 51 | #:use-module (gnu packages package-management) |
| 52 | #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) | 52 | #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) |
| 53 | #:use-module ((gnu packages guile) #:select (guile-zlib)) | ||
| 54 | #:use-module (gnu packages linux) | 53 | #:use-module (gnu packages linux) |
| 55 | #:use-module (gnu packages terminals) | 54 | #:use-module (gnu packages terminals) |
| 56 | #:use-module ((gnu build file-systems) | 55 | #:use-module ((gnu build file-systems) |
| @@ -837,38 +836,36 @@ the message of the day, among other things." | |||
| 837 | to use as the tty. This is primarily useful for headless systems." | 836 | to use as the tty. This is primarily useful for headless systems." |
| 838 | (with-imported-modules (source-module-closure | 837 | (with-imported-modules (source-module-closure |
| 839 | '((gnu build linux-boot))) ;for 'find-long-options' | 838 | '((gnu build linux-boot))) ;for 'find-long-options' |
| 840 | (with-extensions (list guile-zlib) | 839 | #~(begin |
| 841 | #~(begin | 840 | ;; console=device,options |
| 842 | ;; console=device,options | 841 | ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). |
| 843 | ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). | 842 | ;; options: BBBBPNF. P n|o|e, N number of bits, |
| 844 | ;; options: BBBBPNF. P n|o|e, N number of bits, | 843 | ;; F flow control (r RTS) |
| 845 | ;; F flow control (r RTS) | 844 | (let* ((not-comma (char-set-complement (char-set #\,))) |
| 846 | (let* ((not-comma (char-set-complement (char-set #\,))) | 845 | (command (linux-command-line)) |
| 847 | (command (linux-command-line)) | 846 | (agetty-specs (find-long-options "agetty.tty" command)) |
| 848 | (agetty-specs (find-long-options "agetty.tty" command)) | 847 | (console-specs (filter (lambda (spec) |
| 849 | (console-specs | 848 | (and (string-prefix? "tty" spec) |
| 850 | (filter (lambda (spec) | 849 | (not (or |
| 851 | (and (string-prefix? "tty" spec) | 850 | (string-prefix? "tty0" spec) |
| 852 | (not (or | 851 | (string-prefix? "tty1" spec) |
| 853 | (string-prefix? "tty0" spec) | 852 | (string-prefix? "tty2" spec) |
| 854 | (string-prefix? "tty1" spec) | 853 | (string-prefix? "tty3" spec) |
| 855 | (string-prefix? "tty2" spec) | 854 | (string-prefix? "tty4" spec) |
| 856 | (string-prefix? "tty3" spec) | 855 | (string-prefix? "tty5" spec) |
| 857 | (string-prefix? "tty4" spec) | 856 | (string-prefix? "tty6" spec) |
| 858 | (string-prefix? "tty5" spec) | 857 | (string-prefix? "tty7" spec) |
| 859 | (string-prefix? "tty6" spec) | 858 | (string-prefix? "tty8" spec) |
| 860 | (string-prefix? "tty7" spec) | 859 | (string-prefix? "tty9" spec))))) |
| 861 | (string-prefix? "tty8" spec) | 860 | (find-long-options "console" command))) |
| 862 | (string-prefix? "tty9" spec))))) | 861 | (specs (append agetty-specs console-specs))) |
| 863 | (find-long-options "console" command))) | 862 | (match specs |
| 864 | (specs (append agetty-specs console-specs))) | 863 | (() #f) |
| 865 | (match specs | 864 | ((spec _ ...) |
| 866 | (() #f) | 865 | ;; Extract device name from first spec. |
| 867 | ((spec _ ...) | 866 | (match (string-tokenize spec not-comma) |
| 868 | ;; Extract device name from first spec. | 867 | ((device-name _ ...) |
| 869 | (match (string-tokenize spec not-comma) | 868 | device-name)))))))) |
| 870 | ((device-name _ ...) | ||
| 871 | device-name))))))))) | ||
| 872 | 869 | ||
| 873 | (define agetty-shepherd-service | 870 | (define agetty-shepherd-service |
| 874 | (match-lambda | 871 | (match-lambda |
| @@ -893,124 +890,122 @@ to use as the tty. This is primarily useful for headless systems." | |||
| 893 | (start | 890 | (start |
| 894 | (with-imported-modules (source-module-closure | 891 | (with-imported-modules (source-module-closure |
| 895 | '((gnu build linux-boot))) | 892 | '((gnu build linux-boot))) |
| 896 | (with-extensions (list guile-zlib) | 893 | #~(lambda args |
| 897 | #~(lambda args | 894 | (let ((defaulted-tty #$(or tty (default-serial-port)))) |
| 898 | (let ((defaulted-tty #$(or tty (default-serial-port)))) | 895 | (apply |
| 899 | (apply | 896 | (if defaulted-tty |
| 900 | (if defaulted-tty | 897 | (make-forkexec-constructor |
| 901 | (make-forkexec-constructor | 898 | (list #$(file-append util-linux "/sbin/agetty") |
| 902 | (list #$(file-append util-linux "/sbin/agetty") | 899 | #$@extra-options |
| 903 | #$@extra-options | 900 | #$@(if eight-bits? |
| 904 | #$@(if eight-bits? | 901 | #~("--8bits") |
| 905 | #~("--8bits") | 902 | #~()) |
| 906 | #~()) | 903 | #$@(if no-reset? |
| 907 | #$@(if no-reset? | 904 | #~("--noreset") |
| 908 | #~("--noreset") | 905 | #~()) |
| 909 | #~()) | 906 | #$@(if remote? |
| 910 | #$@(if remote? | 907 | #~("--remote") |
| 911 | #~("--remote") | 908 | #~()) |
| 912 | #~()) | 909 | #$@(if flow-control? |
| 913 | #$@(if flow-control? | 910 | #~("--flow-control") |
| 914 | #~("--flow-control") | 911 | #~()) |
| 915 | #~()) | 912 | #$@(if host |
| 916 | #$@(if host | 913 | #~("--host" #$host) |
| 917 | #~("--host" #$host) | 914 | #~()) |
| 918 | #~()) | 915 | #$@(if no-issue? |
| 919 | #$@(if no-issue? | 916 | #~("--noissue") |
| 920 | #~("--noissue") | 917 | #~()) |
| 921 | #~()) | 918 | #$@(if init-string |
| 922 | #$@(if init-string | 919 | #~("--init-string" #$init-string) |
| 923 | #~("--init-string" #$init-string) | 920 | #~()) |
| 924 | #~()) | 921 | #$@(if no-clear? |
| 925 | #$@(if no-clear? | 922 | #~("--noclear") |
| 926 | #~("--noclear") | 923 | #~()) |
| 927 | #~()) | 924 | ;;; FIXME This doesn't work as expected. According to agetty(8), if this option |
| 928 | ;;; FIXME This doesn't work as expected. According to agetty(8), if this | 925 | ;;; is not passed, then the default is 'auto'. However, in my tests, when that |
| 929 | ;;; option is not passed, then the default is 'auto'. However, in my tests, | 926 | ;;; option is selected, agetty never presents the login prompt, and the |
| 930 | ;;; when that option is selected, agetty never presents the login prompt, and | 927 | ;;; term-ttyS0 service respawns every few seconds. |
| 931 | ;;; the term-ttyS0 service respawns every few seconds. | 928 | #$@(if local-line |
| 932 | #$@(if local-line | 929 | #~(#$(match local-line |
| 933 | #~(#$(match local-line | 930 | ('auto "--local-line=auto") |
| 934 | ('auto "--local-line=auto") | 931 | ('always "--local-line=always") |
| 935 | ('always "--local-line=always") | 932 | ('never "-local-line=never"))) |
| 936 | ('never "-local-line=never"))) | 933 | #~()) |
| 937 | #~()) | 934 | #$@(if tty |
| 938 | #$@(if tty | 935 | #~() |
| 939 | #~() | 936 | #~("--keep-baud")) |
| 940 | #~("--keep-baud")) | 937 | #$@(if extract-baud? |
| 941 | #$@(if extract-baud? | 938 | #~("--extract-baud") |
| 942 | #~("--extract-baud") | 939 | #~()) |
| 943 | #~()) | 940 | #$@(if skip-login? |
| 944 | #$@(if skip-login? | 941 | #~("--skip-login") |
| 945 | #~("--skip-login") | 942 | #~()) |
| 946 | #~()) | 943 | #$@(if no-newline? |
| 947 | #$@(if no-newline? | 944 | #~("--nonewline") |
| 948 | #~("--nonewline") | 945 | #~()) |
| 949 | #~()) | 946 | #$@(if login-options |
| 950 | #$@(if login-options | 947 | #~("--login-options" #$login-options) |
| 951 | #~("--login-options" #$login-options) | 948 | #~()) |
| 952 | #~()) | 949 | #$@(if chroot |
| 953 | #$@(if chroot | 950 | #~("--chroot" #$chroot) |
| 954 | #~("--chroot" #$chroot) | 951 | #~()) |
| 955 | #~()) | 952 | #$@(if hangup? |
| 956 | #$@(if hangup? | 953 | #~("--hangup") |
| 957 | #~("--hangup") | 954 | #~()) |
| 958 | #~()) | 955 | #$@(if keep-baud? |
| 959 | #$@(if keep-baud? | 956 | #~("--keep-baud") |
| 960 | #~("--keep-baud") | 957 | #~()) |
| 961 | #~()) | 958 | #$@(if timeout |
| 962 | #$@(if timeout | 959 | #~("--timeout" #$(number->string timeout)) |
| 963 | #~("--timeout" | 960 | #~()) |
| 964 | #$(number->string timeout)) | 961 | #$@(if detect-case? |
| 965 | #~()) | 962 | #~("--detect-case") |
| 966 | #$@(if detect-case? | 963 | #~()) |
| 967 | #~("--detect-case") | 964 | #$@(if wait-cr? |
| 968 | #~()) | 965 | #~("--wait-cr") |
| 969 | #$@(if wait-cr? | 966 | #~()) |
| 970 | #~("--wait-cr") | 967 | #$@(if no-hints? |
| 971 | #~()) | 968 | #~("--nohints?") |
| 972 | #$@(if no-hints? | 969 | #~()) |
| 973 | #~("--nohints?") | 970 | #$@(if no-hostname? |
| 974 | #~()) | 971 | #~("--nohostname") |
| 975 | #$@(if no-hostname? | 972 | #~()) |
| 976 | #~("--nohostname") | 973 | #$@(if long-hostname? |
| 977 | #~()) | 974 | #~("--long-hostname") |
| 978 | #$@(if long-hostname? | 975 | #~()) |
| 979 | #~("--long-hostname") | 976 | #$@(if erase-characters |
| 980 | #~()) | 977 | #~("--erase-chars" #$erase-characters) |
| 981 | #$@(if erase-characters | 978 | #~()) |
| 982 | #~("--erase-chars" #$erase-characters) | 979 | #$@(if kill-characters |
| 983 | #~()) | 980 | #~("--kill-chars" #$kill-characters) |
| 984 | #$@(if kill-characters | 981 | #~()) |
| 985 | #~("--kill-chars" #$kill-characters) | 982 | #$@(if chdir |
| 986 | #~()) | 983 | #~("--chdir" #$chdir) |
| 987 | #$@(if chdir | 984 | #~()) |
| 988 | #~("--chdir" #$chdir) | 985 | #$@(if delay |
| 989 | #~()) | 986 | #~("--delay" #$(number->string delay)) |
| 990 | #$@(if delay | 987 | #~()) |
| 991 | #~("--delay" #$(number->string delay)) | 988 | #$@(if nice |
| 992 | #~()) | 989 | #~("--nice" #$(number->string nice)) |
| 993 | #$@(if nice | 990 | #~()) |
| 994 | #~("--nice" #$(number->string nice)) | 991 | #$@(if auto-login |
| 995 | #~()) | 992 | (list "--autologin" auto-login) |
| 996 | #$@(if auto-login | 993 | '()) |
| 997 | (list "--autologin" auto-login) | 994 | #$@(if login-program |
| 998 | '()) | 995 | #~("--login-program" #$login-program) |
| 999 | #$@(if login-program | 996 | #~()) |
| 1000 | #~("--login-program" #$login-program) | 997 | #$@(if login-pause? |
| 1001 | #~()) | 998 | #~("--login-pause") |
| 1002 | #$@(if login-pause? | 999 | #~()) |
| 1003 | #~("--login-pause") | 1000 | defaulted-tty |
| 1004 | #~()) | 1001 | #$@(if baud-rate |
| 1005 | defaulted-tty | 1002 | #~(#$baud-rate) |
| 1006 | #$@(if baud-rate | 1003 | #~()) |
| 1007 | #~(#$baud-rate) | 1004 | #$@(if term |
| 1008 | #~()) | 1005 | #~(#$term) |
| 1009 | #$@(if term | 1006 | #~()))) |
| 1010 | #~(#$term) | 1007 | (const #f)) ; never start. |
| 1011 | #~()))) | 1008 | args))))) |
| 1012 | (const #f)) ; never start. | ||
| 1013 | args)))))) | ||
| 1014 | (stop #~(make-kill-destructor))))))) | 1009 | (stop #~(make-kill-destructor))))))) |
| 1015 | 1010 | ||
| 1016 | (define agetty-service-type | 1011 | (define agetty-service-type |
| @@ -1944,73 +1939,70 @@ item of @var{packages}." | |||
| 1944 | (start | 1939 | (start |
| 1945 | (with-imported-modules (source-module-closure | 1940 | (with-imported-modules (source-module-closure |
| 1946 | '((gnu build linux-boot))) | 1941 | '((gnu build linux-boot))) |
| 1947 | (with-extensions (list guile-zlib) | 1942 | #~(lambda () |
| 1948 | #~(lambda () | 1943 | (define udevd |
| 1949 | (define udevd | 1944 | ;; 'udevd' from eudev. |
| 1950 | ;; 'udevd' from eudev. | 1945 | #$(file-append udev "/sbin/udevd")) |
| 1951 | #$(file-append udev "/sbin/udevd")) | 1946 | |
| 1952 | 1947 | (define (wait-for-udevd) | |
| 1953 | (define (wait-for-udevd) | 1948 | ;; Wait until someone's listening on udevd's control |
| 1954 | ;; Wait until someone's listening on udevd's control | 1949 | ;; socket. |
| 1955 | ;; socket. | 1950 | (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) |
| 1956 | (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) | 1951 | (let try () |
| 1957 | (let try () | 1952 | (catch 'system-error |
| 1958 | (catch 'system-error | 1953 | (lambda () |
| 1959 | (lambda () | 1954 | (connect sock PF_UNIX "/run/udev/control") |
| 1960 | (connect sock PF_UNIX "/run/udev/control") | 1955 | (close-port sock)) |
| 1961 | (close-port sock)) | 1956 | (lambda args |
| 1962 | (lambda args | 1957 | (format #t "waiting for udevd...~%") |
| 1963 | (format #t "waiting for udevd...~%") | 1958 | (usleep 500000) |
| 1964 | (usleep 500000) | 1959 | (try)))))) |
| 1965 | (try)))))) | 1960 | |
| 1966 | 1961 | ;; Allow udev to find the modules. | |
| 1967 | ;; Allow udev to find the modules. | 1962 | (setenv "LINUX_MODULE_DIRECTORY" |
| 1968 | (setenv "LINUX_MODULE_DIRECTORY" | 1963 | "/run/booted-system/kernel/lib/modules") |
| 1969 | "/run/booted-system/kernel/lib/modules") | 1964 | |
| 1970 | 1965 | (let* ((kernel-release | |
| 1971 | (let* ((kernel-release | 1966 | (utsname:release (uname))) |
| 1972 | (utsname:release (uname))) | 1967 | (linux-module-directory |
| 1973 | (linux-module-directory | 1968 | (getenv "LINUX_MODULE_DIRECTORY")) |
| 1974 | (getenv "LINUX_MODULE_DIRECTORY")) | 1969 | (directory |
| 1975 | (directory | 1970 | (string-append linux-module-directory "/" |
| 1976 | (string-append linux-module-directory "/" | 1971 | kernel-release)) |
| 1977 | kernel-release)) | 1972 | (old-umask (umask #o022))) |
| 1978 | (old-umask (umask #o022))) | 1973 | ;; If we're in a container, DIRECTORY might not exist, |
| 1979 | ;; If we're in a container, DIRECTORY might not exist, | 1974 | ;; for instance because the host runs a different |
| 1980 | ;; for instance because the host runs a different | 1975 | ;; kernel. In that case, skip it; we'll just miss a few |
| 1981 | ;; kernel. In that case, skip it; we'll just miss a few | 1976 | ;; nodes like /dev/fuse. |
| 1982 | ;; nodes like /dev/fuse. | 1977 | (when (file-exists? directory) |
| 1983 | (when (file-exists? directory) | 1978 | (make-static-device-nodes directory)) |
| 1984 | (make-static-device-nodes directory)) | 1979 | (umask old-umask)) |
| 1985 | (umask old-umask)) | 1980 | |
| 1986 | 1981 | (let ((pid (fork+exec-command (list udevd) | |
| 1987 | (let ((pid | 1982 | #:environment-variables |
| 1988 | (fork+exec-command | 1983 | (cons* |
| 1989 | (list udevd) | 1984 | ;; The first one is for udev, the second one for |
| 1990 | #:environment-variables | 1985 | ;; eudev. |
| 1991 | (cons* | 1986 | (string-append "UDEV_CONFIG_FILE=" #$udev.conf) |
| 1992 | ;; The first one is for udev, the second one for | 1987 | (string-append "EUDEV_RULES_DIRECTORY=" |
| 1993 | ;; eudev. | 1988 | #$(file-append |
| 1994 | (string-append "UDEV_CONFIG_FILE=" #$udev.conf) | 1989 | rules "/lib/udev/rules.d")) |
| 1995 | (string-append "EUDEV_RULES_DIRECTORY=" | 1990 | (string-append "LINUX_MODULE_DIRECTORY=" |
| 1996 | #$(file-append | 1991 | (getenv "LINUX_MODULE_DIRECTORY")) |
| 1997 | rules "/lib/udev/rules.d")) | 1992 | (default-environment-variables))))) |
| 1998 | (string-append "LINUX_MODULE_DIRECTORY=" | 1993 | ;; Wait until udevd is up and running. This appears to |
| 1999 | (getenv "LINUX_MODULE_DIRECTORY")) | 1994 | ;; be needed so that the events triggered below are |
| 2000 | (default-environment-variables))))) | 1995 | ;; actually handled. |
| 2001 | ;; Wait until udevd is up and running. This appears to | 1996 | (wait-for-udevd) |
| 2002 | ;; be needed so that the events triggered below are | 1997 | |
| 2003 | ;; actually handled. | 1998 | ;; Trigger device node creation. |
| 2004 | (wait-for-udevd) | 1999 | (system* #$(file-append udev "/bin/udevadm") |
| 2005 | 2000 | "trigger" "--action=add") | |
| 2006 | ;; Trigger device node creation. | 2001 | |
| 2007 | (system* #$(file-append udev "/bin/udevadm") | 2002 | ;; Wait for things to settle down. |
| 2008 | "trigger" "--action=add") | 2003 | (system* #$(file-append udev "/bin/udevadm") |
| 2009 | 2004 | "settle") | |
| 2010 | ;; Wait for things to settle down. | 2005 | pid)))) |
| 2011 | (system* #$(file-append udev "/bin/udevadm") | ||
| 2012 | "settle") | ||
| 2013 | pid))))) | ||
| 2014 | (stop #~(make-kill-destructor)) | 2006 | (stop #~(make-kill-destructor)) |
| 2015 | 2007 | ||
| 2016 | ;; When halting the system, 'udev' is actually killed by | 2008 | ;; When halting the system, 'udev' is actually killed by |
diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 19c99a3dfa1..36f56e237d5 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm | |||
| @@ -141,7 +141,7 @@ | |||
| 141 | (match (package-transitive-propagated-inputs package) | 141 | (match (package-transitive-propagated-inputs package) |
| 142 | (((labels packages) ...) | 142 | (((labels packages) ...) |
| 143 | packages)))) | 143 | packages)))) |
| 144 | (list guile-gcrypt guile-sqlite3 guile-zlib))) | 144 | (list guile-gcrypt guile-sqlite3))) |
| 145 | 145 | ||
| 146 | (define-syntax-rule (with-imported-modules* gexp* ...) | 146 | (define-syntax-rule (with-imported-modules* gexp* ...) |
| 147 | (with-extensions gcrypt-sqlite3&co | 147 | (with-extensions gcrypt-sqlite3&co |
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index f642d250b0b..a69339bc074 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm | |||
| @@ -34,7 +34,6 @@ | |||
| 34 | #:use-module ((gnu packages admin) | 34 | #:use-module ((gnu packages admin) |
| 35 | #:select (shadow)) | 35 | #:select (shadow)) |
| 36 | #:use-module (gnu packages bash) | 36 | #:use-module (gnu packages bash) |
| 37 | #:use-module (gnu packages guile) | ||
| 38 | #:use-module (srfi srfi-1) | 37 | #:use-module (srfi srfi-1) |
| 39 | #:use-module (srfi srfi-26) | 38 | #:use-module (srfi srfi-26) |
| 40 | #:use-module (srfi srfi-34) | 39 | #:use-module (srfi srfi-34) |
| @@ -325,12 +324,11 @@ accounts among ACCOUNTS+GROUPS." | |||
| 325 | (start (with-imported-modules (source-module-closure | 324 | (start (with-imported-modules (source-module-closure |
| 326 | '((gnu build activation) | 325 | '((gnu build activation) |
| 327 | (gnu system accounts))) | 326 | (gnu system accounts))) |
| 328 | (with-extensions (list guile-zlib) | 327 | #~(lambda () |
| 329 | #~(lambda () | 328 | (activate-user-home |
| 330 | (activate-user-home | 329 | (map sexp->user-account |
| 331 | (map sexp->user-account | 330 | (list #$@(map user-account->gexp accounts)))) |
| 332 | (list #$@(map user-account->gexp accounts)))) | 331 | #t))) ;success |
| 333 | #t)))) ;success | ||
| 334 | (documentation "Create user home directories.")))) | 332 | (documentation "Create user home directories.")))) |
| 335 | 333 | ||
| 336 | (define (shells-file shells) | 334 | (define (shells-file shells) |
