diff options
Diffstat (limited to 'gnu/services.scm')
| -rw-r--r-- | gnu/services.scm | 213 |
1 files changed, 123 insertions, 90 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index 81af4df849..49cf01a4f8 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -331,13 +331,20 @@ containing the given entries." (service-type (name 'system) (extensions '()) (compose identity) - (extend system-derivation))) - -(define (compute-boot-script _ mexps) - (mlet %store-monad ((gexps (sequence %store-monad mexps))) - (gexp->file "boot" - ;; Clean up and activate the system, then spawn shepherd. - #~(begin #$@gexps)))) + (extend system-derivation) + (description + "Build the operating system top-level directory, which in +turn refers to everything the operating system needs: its kernel, initrd, +system profile, boot script, and so on."))) + +(define (compute-boot-script _ gexps) + ;; Reverse GEXPS so that extensions appear in the boot script in the right + ;; order. That is, user extensions would come first, and extensions added + ;; by 'essential-services' (e.g., running shepherd) are guaranteed to come + ;; last. + (gexp->file "boot" + ;; Clean up and activate the system, then spawn shepherd. + #~(begin #$@(reverse gexps)))) (define (boot-script-entry mboot) "Return, as a monadic value, an entry for the boot script in the system @@ -346,64 +353,74 @@ directory." (return `(("boot" ,boot))))) (define boot-service-type - ;; The service of this type is extended by being passed gexps as monadic - ;; values. It aggregates them in a single script, as a monadic value, which - ;; becomes its 'parameters'. It is the only service that extends nothing. + ;; The service of this type is extended by being passed gexps. It + ;; aggregates them in a single script, as a monadic value, which becomes its + ;; value. (service-type (name 'boot) (extensions (list (service-extension system-service-type boot-script-entry))) (compose identity) - (extend compute-boot-script))) + (extend compute-boot-script) + (description + "Produce the operating system's boot script, which is spawned +by the initrd once the root file system is mounted."))) (define %boot-service ;; The service that produces the boot script. (service boot-service-type #t)) (define (cleanup-gexp _) - "Return as a monadic value a gexp to clean up /tmp and similar places upon -boot." - (with-monad %store-monad - (with-imported-modules '((guix build utils)) - (return #~(begin - (use-modules (guix build utils)) - - ;; Clean out /tmp and /var/run. - ;; - ;; XXX This needs to happen before service activations, so it - ;; has to be here, but this also implicitly assumes that /tmp - ;; and /var/run are on the root partition. - (letrec-syntax ((fail-safe (syntax-rules () - ((_ exp rest ...) - (begin - (catch 'system-error - (lambda () exp) - (const #f)) - (fail-safe rest ...))) - ((_) - #t)))) - ;; Ignore I/O errors so the system can boot. - (fail-safe - ;; Remove stale Shadow lock files as they would lead to - ;; failures of 'useradd' & co. - (delete-file "/etc/group.lock") - (delete-file "/etc/passwd.lock") - (delete-file "/etc/.pwd.lock") ;from 'lckpwdf' - - (delete-file-recursively "/tmp") - (delete-file-recursively "/var/run") - (mkdir "/tmp") - (chmod "/tmp" #o1777) - (mkdir "/var/run") - (chmod "/var/run" #o755) - (delete-file-recursively "/run/udev/watch.old")))))))) + "Return a gexp to clean up /tmp and similar places upon boot." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + ;; Clean out /tmp and /var/run. + ;; + ;; XXX This needs to happen before service activations, so it + ;; has to be here, but this also implicitly assumes that /tmp + ;; and /var/run are on the root partition. + (letrec-syntax ((fail-safe (syntax-rules () + ((_ exp rest ...) + (begin + (catch 'system-error + (lambda () exp) + (const #f)) + (fail-safe rest ...))) + ((_) + #t)))) + ;; Ignore I/O errors so the system can boot. + (fail-safe + ;; Remove stale Shadow lock files as they would lead to + ;; failures of 'useradd' & co. + (delete-file "/etc/group.lock") + (delete-file "/etc/passwd.lock") + (delete-file "/etc/.pwd.lock") ;from 'lckpwdf' + + ;; Force file names to be decoded as UTF-8. See + ;; <https://bugs.gnu.org/26353>. + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setlocale LC_CTYPE "en_US.utf8") + (delete-file-recursively "/tmp") + (delete-file-recursively "/var/run") + + (mkdir "/tmp") + (chmod "/tmp" #o1777) + (mkdir "/var/run") + (chmod "/var/run" #o755) + (delete-file-recursively "/run/udev/watch.old")))))) (define cleanup-service-type ;; Service that cleans things up in /tmp and similar. (service-type (name 'cleanup) (extensions (list (service-extension boot-service-type - cleanup-gexp))))) + cleanup-gexp))) + (description + "Delete files from @file{/tmp}, @file{/var/run}, and other +temporary locations at boot time."))) (define* (activation-service->script service) "Return as a monadic value the activation script for SERVICE, a service of @@ -412,44 +429,39 @@ ACTIVATION-SCRIPT-TYPE." (define (activation-script gexps) "Return the system's activation script, which evaluates GEXPS." - (define (service-activations) - ;; Return the activation scripts for SERVICES. - (mapm %store-monad - (cut gexp->file "activate-service" <>) - gexps)) - - (mlet* %store-monad ((actions (service-activations))) - (gexp->file "activate" - (with-imported-modules (source-module-closure - '((gnu build activation) - (guix build utils))) - #~(begin - (use-modules (gnu build activation) - (guix build utils)) - - ;; Make sure the user accounting database exists. If it - ;; does not exist, 'setutxent' does not create it and - ;; thus there is no accounting at all. - (close-port (open-file "/var/run/utmpx" "a0")) - - ;; Same for 'wtmp', which is populated by mingetty et - ;; al. - (mkdir-p "/var/log") - (close-port (open-file "/var/log/wtmp" "a0")) - - ;; Set up /run/current-system. Among other things this - ;; sets up locales, which the activation snippets - ;; executed below may expect. - (activate-current-system) - - ;; Run the services' activation snippets. - ;; TODO: Use 'load-compiled'. - (for-each primitive-load '#$actions)))))) + (define actions + (map (cut scheme-file "activate-service" <>) gexps)) + + (scheme-file "activate" + (with-imported-modules (source-module-closure + '((gnu build activation) + (guix build utils))) + #~(begin + (use-modules (gnu build activation) + (guix build utils)) + + ;; Make sure the user accounting database exists. If it + ;; does not exist, 'setutxent' does not create it and + ;; thus there is no accounting at all. + (close-port (open-file "/var/run/utmpx" "a0")) + + ;; Same for 'wtmp', which is populated by mingetty et + ;; al. + (mkdir-p "/var/log") + (close-port (open-file "/var/log/wtmp" "a0")) + + ;; Set up /run/current-system. Among other things this + ;; sets up locales, which the activation snippets + ;; executed below may expect. + (activate-current-system) + + ;; Run the services' activation snippets. + ;; TODO: Use 'load-compiled'. + (for-each primitive-load '#$actions))))) (define (gexps->activation-gexp gexps) "Return a gexp that runs the activation script containing GEXPS." - (mlet %store-monad ((script (activation-script gexps))) - (return #~(primitive-load #$script)))) + #~(primitive-load #$(activation-script gexps))) (define (second-argument a b) b) @@ -459,7 +471,10 @@ ACTIVATION-SCRIPT-TYPE." (list (service-extension boot-service-type gexps->activation-gexp))) (compose identity) - (extend second-argument))) + (extend second-argument) + (description + "Run @dfn{activation} code at boot time and upon +@command{guix system reconfigure} completion."))) (define %activation-service ;; The activation service produces the activation script from the gexps it @@ -507,7 +522,10 @@ ACTIVATION-SCRIPT-TYPE." (lambda (files) #~(activate-special-files '#$files))))) (compose concatenate) - (extend append))) + (extend append) + (description + "Add special files to the root file system---e.g., +@file{/usr/bin/env}."))) (define (extra-special-file file target) "Use TARGET as the \"special file\" FILE. For example, TARGET might be @@ -541,7 +559,8 @@ directory." #~(activate-etc #$etc)))) (service-extension system-service-type etc-entry))) (compose concatenate) - (extend append))) + (extend append) + (description "Populate the @file{/etc} directory."))) (define (etc-service files) "Return a new service of ETC-SERVICE-TYPE that populates /etc with FILES. @@ -556,7 +575,10 @@ FILES must be a list of name/file-like object pairs." #~(activate-setuid-programs (list #$@programs)))))) (compose concatenate) - (extend append))) + (extend append) + (description + "Populate @file{/run/setuid-programs} with the specified +executables, making them setuid-root."))) (define (packages->profile-entry packages) "Return a system entry for the profile containing PACKAGES." @@ -573,7 +595,11 @@ FILES must be a list of name/file-like object pairs." (list (service-extension system-service-type packages->profile-entry))) (compose concatenate) - (extend append))) + (extend append) + (description + "This is the @dfn{system profile}, available as +@file{/run/current-system/profile}. It contains packages that the sysadmin +wants to be globally available to all the system users."))) (define (firmware->activation-gexp firmware) "Return a gexp to make the packages listed in FIRMWARE loadable by the @@ -589,7 +615,11 @@ kernel." (list (service-extension activation-service-type firmware->activation-gexp))) (compose concatenate) - (extend append))) + (extend append) + (description + "Make ``firmware'' files loadable by the operating system +kernel. Firmware may then be uploaded to some of the machine's devices, such +as Wifi cards."))) (define (gc-roots->system-entry roots) "Return an entry in the system's output containing symlinks to ROOTS." @@ -616,7 +646,10 @@ kernel." (list (service-extension system-service-type gc-roots->system-entry))) (compose concatenate) - (extend append))) + (extend append) + (description + "Register garbage-collector roots---i.e., store items that +will not be reclaimed by the garbage collector."))) ;;; |