diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 185 | ||||
| -rw-r--r-- | gnu/services/shepherd.scm | 77 | ||||
| -rw-r--r-- | gnu/services/web.scm | 2 |
3 files changed, 143 insertions, 121 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index f7e90e26b7..e75c56828e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -947,36 +947,38 @@ the message of the day, among other things." (define (default-serial-port) "Return a gexp that determines a reasonable default serial port to use as the tty. This is primarily useful for headless systems." - #~(begin - ;; console=device,options - ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). - ;; options: BBBBPNF. P n|o|e, N number of bits, - ;; F flow control (r RTS) - (let* ((not-comma (char-set-complement (char-set #\,))) - (command (linux-command-line)) - (agetty-specs (find-long-options "agetty.tty" command)) - (console-specs (filter (lambda (spec) - (and (string-prefix? "tty" spec) - (not (or - (string-prefix? "tty0" spec) - (string-prefix? "tty1" spec) - (string-prefix? "tty2" spec) - (string-prefix? "tty3" spec) - (string-prefix? "tty4" spec) - (string-prefix? "tty5" spec) - (string-prefix? "tty6" spec) - (string-prefix? "tty7" spec) - (string-prefix? "tty8" spec) - (string-prefix? "tty9" spec))))) - (find-long-options "console" command))) - (specs (append agetty-specs console-specs))) - (match specs - (() #f) - ((spec _ ...) - ;; Extract device name from first spec. - (match (string-tokenize spec not-comma) - ((device-name _ ...) - device-name))))))) + (with-imported-modules (source-module-closure + '((gnu build linux-boot))) ;for 'find-long-options' + #~(begin + ;; console=device,options + ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). + ;; options: BBBBPNF. P n|o|e, N number of bits, + ;; F flow control (r RTS) + (let* ((not-comma (char-set-complement (char-set #\,))) + (command (linux-command-line)) + (agetty-specs (find-long-options "agetty.tty" command)) + (console-specs (filter (lambda (spec) + (and (string-prefix? "tty" spec) + (not (or + (string-prefix? "tty0" spec) + (string-prefix? "tty1" spec) + (string-prefix? "tty2" spec) + (string-prefix? "tty3" spec) + (string-prefix? "tty4" spec) + (string-prefix? "tty5" spec) + (string-prefix? "tty6" spec) + (string-prefix? "tty7" spec) + (string-prefix? "tty8" spec) + (string-prefix? "tty9" spec))))) + (find-long-options "console" command))) + (specs (append agetty-specs console-specs))) + (match specs + (() #f) + ((spec _ ...) + ;; Extract device name from first spec. + (match (string-tokenize spec not-comma) + ((device-name _ ...) + device-name)))))))) (define agetty-shepherd-service (match-lambda @@ -1486,7 +1488,7 @@ information on the configuration file syntax." (module "pam_limits.so") (arguments '("conf=/etc/security/limits.conf"))))) (if (member (pam-service-name pam) - '("login" "su" "slim")) + '("login" "su" "slim" "gdm-password")) (pam-service (inherit pam) (session (cons pam-limits @@ -2002,64 +2004,67 @@ item of @var{packages}." (requirement '(root-file-system)) (documentation "Populate the /dev directory, dynamically.") - (start #~(lambda () - (define udevd - ;; 'udevd' from eudev. - #$(file-append udev "/sbin/udevd")) - - (define (wait-for-udevd) - ;; Wait until someone's listening on udevd's control - ;; socket. - (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) - (let try () - (catch 'system-error - (lambda () - (connect sock PF_UNIX "/run/udev/control") - (close-port sock)) - (lambda args - (format #t "waiting for udevd...~%") - (usleep 500000) - (try)))))) - - ;; Allow udev to find the modules. - (setenv "LINUX_MODULE_DIRECTORY" - "/run/booted-system/kernel/lib/modules") - - ;; The first one is for udev, the second one for eudev. - (setenv "UDEV_CONFIG_FILE" #$udev.conf) - (setenv "EUDEV_RULES_DIRECTORY" - #$(file-append rules "/lib/udev/rules.d")) - - (let* ((kernel-release - (utsname:release (uname))) - (linux-module-directory - (getenv "LINUX_MODULE_DIRECTORY")) - (directory - (string-append linux-module-directory "/" - kernel-release)) - (old-umask (umask #o022))) - ;; If we're in a container, DIRECTORY might not exist, - ;; for instance because the host runs a different - ;; kernel. In that case, skip it; we'll just miss a few - ;; nodes like /dev/fuse. - (when (file-exists? directory) - (make-static-device-nodes directory)) - (umask old-umask)) - - (let ((pid (fork+exec-command (list udevd)))) - ;; Wait until udevd is up and running. This appears to - ;; be needed so that the events triggered below are - ;; actually handled. - (wait-for-udevd) - - ;; Trigger device node creation. - (system* #$(file-append udev "/bin/udevadm") - "trigger" "--action=add") - - ;; Wait for things to settle down. - (system* #$(file-append udev "/bin/udevadm") - "settle") - pid))) + (start + (with-imported-modules (source-module-closure + '((gnu build linux-boot))) + #~(lambda () + (define udevd + ;; 'udevd' from eudev. + #$(file-append udev "/sbin/udevd")) + + (define (wait-for-udevd) + ;; Wait until someone's listening on udevd's control + ;; socket. + (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) + (let try () + (catch 'system-error + (lambda () + (connect sock PF_UNIX "/run/udev/control") + (close-port sock)) + (lambda args + (format #t "waiting for udevd...~%") + (usleep 500000) + (try)))))) + + ;; Allow udev to find the modules. + (setenv "LINUX_MODULE_DIRECTORY" + "/run/booted-system/kernel/lib/modules") + + ;; The first one is for udev, the second one for eudev. + (setenv "UDEV_CONFIG_FILE" #$udev.conf) + (setenv "EUDEV_RULES_DIRECTORY" + #$(file-append rules "/lib/udev/rules.d")) + + (let* ((kernel-release + (utsname:release (uname))) + (linux-module-directory + (getenv "LINUX_MODULE_DIRECTORY")) + (directory + (string-append linux-module-directory "/" + kernel-release)) + (old-umask (umask #o022))) + ;; If we're in a container, DIRECTORY might not exist, + ;; for instance because the host runs a different + ;; kernel. In that case, skip it; we'll just miss a few + ;; nodes like /dev/fuse. + (when (file-exists? directory) + (make-static-device-nodes directory)) + (umask old-umask)) + + (let ((pid (fork+exec-command (list udevd)))) + ;; Wait until udevd is up and running. This appears to + ;; be needed so that the events triggered below are + ;; actually handled. + (wait-for-udevd) + + ;; Trigger device node creation. + (system* #$(file-append udev "/bin/udevadm") + "trigger" "--action=add") + + ;; Wait for things to settle down. + (system* #$(file-append udev "/bin/udevadm") + "settle") + pid)))) (stop #~(make-kill-destructor)) ;; When halting the system, 'udev' is actually killed by @@ -2067,7 +2072,7 @@ item of @var{packages}." ;; Thus, make sure it is not respawned. (respawn? #f) ;; We need additional modules. - (modules `((gnu build linux-boot) + (modules `((gnu build linux-boot) ;'make-static-device-nodes' ,@%default-modules)) (actions (list (shepherd-action diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 45c67e04eb..08bb33039c 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -255,6 +255,22 @@ stored." #~(#$name #$doc #$proc))) (shepherd-service-actions service)))))))) +(define (scm->go file) + "Compile FILE, which contains code to be loaded by shepherd's config file, +and return the resulting '.go' file." + (with-extensions (list shepherd) + (computed-file (string-append (basename (scheme-file-name file) ".scm") + ".go") + #~(begin + (use-modules (system base compile)) + + ;; Do the same as the Shepherd's 'load-in-user-module'. + (let ((env (make-fresh-user-module))) + (module-use! env (resolve-interface '(oop goops))) + (module-use! env (resolve-interface '(shepherd service))) + (compile-file #$file #:output-file #$output + #:env env)))))) + (define (shepherd-configuration-file services) "Return the shepherd configuration file for SERVICES." (assert-valid-graph services) @@ -269,36 +285,37 @@ stored." ;; than a kernel panic. (call-with-error-handling (lambda () - (apply register-services (map primitive-load '#$files)) - - ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around - ;; it. - (setenv "PATH" "/run/current-system/profile/bin") - - (format #t "starting services...~%") - (for-each (lambda (service) - ;; In the Shepherd 0.3 the 'start' method can raise - ;; '&action-runtime-error' if it fails, so protect - ;; against it. (XXX: 'action-runtime-error?' is not - ;; exported is 0.3, hence 'service-error?'.) - (guard (c ((service-error? c) - (format (current-error-port) - "failed to start service '~a'~%" - service))) - (start service))) - '#$(append-map shepherd-service-provision - (filter shepherd-service-auto-start? - services))) - - ;; Hang up stdin. At this point, we assume that 'start' methods - ;; that required user interaction on the console (e.g., - ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have - ;; completed. User interaction becomes impossible after this - ;; call; this avoids situations where services wrongfully lead - ;; PID 1 to read from stdin (the console), which users may not - ;; have access to (see <https://bugs.gnu.org/23697>). - (redirect-port (open-input-file "/dev/null") - (current-input-port)))))) + (apply register-services + (map load-compiled '#$(map scm->go files))))) + + ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around + ;; it. + (setenv "PATH" "/run/current-system/profile/bin") + + (format #t "starting services...~%") + (for-each (lambda (service) + ;; In the Shepherd 0.3 the 'start' method can raise + ;; '&action-runtime-error' if it fails, so protect + ;; against it. (XXX: 'action-runtime-error?' is not + ;; exported is 0.3, hence 'service-error?'.) + (guard (c ((service-error? c) + (format (current-error-port) + "failed to start service '~a'~%" + service))) + (start service))) + '#$(append-map shepherd-service-provision + (filter shepherd-service-auto-start? + services))) + + ;; Hang up stdin. At this point, we assume that 'start' methods + ;; that required user interaction on the console (e.g., + ;; 'cryptsetup open' invocations, post-fsck emergency REPL) have + ;; completed. User interaction becomes impossible after this + ;; call; this avoids situations where services wrongfully lead + ;; PID 1 to read from stdin (the console), which users may not + ;; have access to (see <https://bugs.gnu.org/23697>). + (redirect-port (open-input-file "/dev/null") + (current-input-port)))) (scheme-file "shepherd.conf" config))) diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 56971238ab..899be1c168 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -438,7 +438,7 @@ addresses-and-ports contents) `(,(string-append - "<VirtualHost " addresses-and-ports ">\n") + "\n<VirtualHost " addresses-and-ports ">\n") ,@contents "\n</VirtualHost>\n")) ((? string? x) |