diff options
Diffstat (limited to 'gnu/system.scm')
-rw-r--r-- | gnu/system.scm | 109 |
1 files changed, 70 insertions, 39 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index ad0c9e57dc..e9310e3d5b 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -445,32 +445,40 @@ OS." (file-append (operating-system-kernel os) "/" (system-linux-image-file-name os))) -(define* (operating-system-directory-base-entries os) +(define* (operating-system-directory-base-entries os #:key container?) "Return the basic entries of the 'system' directory of OS for use as the value of the SYSTEM-SERVICE-TYPE service." (let ((locale (operating-system-locale-directory os))) - (mlet %store-monad ((kernel -> (operating-system-kernel os)) - (initrd -> (operating-system-initrd-file os)) - (params (operating-system-boot-parameters-file os))) - (return `(("kernel" ,kernel) - ("parameters" ,params) - ("initrd" ,initrd) - ("locale" ,locale)))))) ;used by libc - -(define* (essential-services os) + (with-monad %store-monad + (if container? + (return `(("locale" ,locale))) + (mlet %store-monad + ((kernel -> (operating-system-kernel os)) + (initrd -> (operating-system-initrd-file os)) + (params (operating-system-boot-parameters-file os))) + (return `(("kernel" ,kernel) + ("parameters" ,params) + ("initrd" ,initrd) + ("locale" ,locale)))))))) ;used by libc + +(define* (essential-services os #:key container? container-shared-network?) "Return the list of essential services for OS. These are special services that implement part of what's declared in OS are responsible for low-level bookkeeping." (define known-fs (map file-system-mount-point (operating-system-file-systems os))) + (if (and container-shared-network? (not container?)) + (error "cannot specify container-shared-network? without container? #t")) + (let* ((mappings (device-mapping-services os)) (root-fs (root-file-system-service)) (other-fs (non-boot-file-system-service os)) (swaps (swap-services os)) (procs (service user-processes-service-type)) (host-name (host-name-service (operating-system-host-name os))) - (entries (operating-system-directory-base-entries os))) + (entries (operating-system-directory-base-entries + os #:container? container?))) (cons* (service system-service-type entries) %boot-service @@ -486,7 +494,8 @@ bookkeeping." (account-service (append (operating-system-accounts os) (operating-system-groups os)) (operating-system-skeletons os)) - (operating-system-etc-service os) + (operating-system-etc-service + os #:container-shared-network? container-shared-network?) (service fstab-service-type '()) (session-environment-service (operating-system-environment-variables os)) @@ -498,16 +507,23 @@ bookkeeping." other-fs (append mappings swaps - ;; Add the firmware service. - (list %linux-bare-metal-service - (service firmware-service-type - (operating-system-firmware os))))))) - -(define* (operating-system-services os) - "Return all the services of OS, including \"essential\" services." + ;; Add the firmware service, unless we are building for a + ;; container. + (if container? + (list %containerized-shepherd-service) + (list %linux-bare-metal-service + (service firmware-service-type + (operating-system-firmware os)))))))) + +(define* (operating-system-services os #:key container? container-shared-network?) + "Return all the services of OS, including \"internal\" services that do not +explicitly appear in OS." (instantiate-missing-services (append (operating-system-user-services os) - (operating-system-essential-services os)))) + (essential-services + os + #:container? container? + #:container-shared-network? container-shared-network?)))) ;;; @@ -576,7 +592,7 @@ This is the GNU system. Welcome.\n") "Return the default /etc/hosts file." (plain-file "hosts" (local-host-aliases host-name))) -(define* (operating-system-etc-service os) +(define* (operating-system-etc-service os #:key container-shared-network?) "Return a <service> that builds containing the static part of the /etc directory." (let ((login.defs @@ -678,24 +694,23 @@ then source /run/current-system/profile/etc/profile.d/bash_completion.sh fi\n"))) (etc-service - `(("services" ,(file-append net-base "/etc/services")) - ("protocols" ,(file-append net-base "/etc/protocols")) + `(("protocols" ,(file-append net-base "/etc/protocols")) ("rpc" ,(file-append net-base "/etc/rpc")) ("login.defs" ,#~#$login.defs) ("issue" ,#~#$issue) ("nsswitch.conf" ,#~#$nsswitch) ("profile" ,#~#$profile) ("bashrc" ,#~#$bashrc) - ("hosts" ,#~#$(or (operating-system-hosts-file os) - (default-/etc/hosts (operating-system-host-name os)))) - ;; Write the operating-system-host-name to /etc/hostname to prevent - ;; NetworkManager from changing the system's hostname when connecting - ;; to certain networks. Some discussion at - ;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html ("hostname" ,(plain-file "hostname" (operating-system-host-name os))) ("localtime" ,(file-append tzdata "/share/zoneinfo/" (operating-system-timezone os))) - ("sudoers" ,(operating-system-sudoers-file os)))))) + ("sudoers" ,(operating-system-sudoers-file os)) + ,@(if container-shared-network? + '() + `(("services" ,(file-append net-base "/etc/services")) + ("hosts" ,#~#$(or (operating-system-hosts-file os) + (default-/etc/hosts + (operating-system-host-name os)))))))))) (define %root-account ;; Default root account. @@ -805,19 +820,28 @@ use 'plain-file' instead~%") root ALL=(ALL) ALL %wheel ALL=(ALL) ALL\n")) -(define* (operating-system-activation-script os) +(define* (operating-system-activation-script os #:key container? + container-shared-network?) "Return the activation script for OS---i.e., the code that \"activates\" the stateful part of OS, including user accounts and groups, special directories, etc." - (let* ((services (operating-system-services os)) + (let* ((services (operating-system-services + os + #:container? container? + #:container-shared-network? container-shared-network?)) (activation (fold-services services #:target-type activation-service-type))) (activation-service->script activation))) -(define* (operating-system-boot-script os) +(define* (operating-system-boot-script os #:key container? + container-shared-network?) "Return the boot script for OS---i.e., the code started by the initrd once -we're running in the final root." - (let* ((services (operating-system-services os)) +we're running in the final root. When CONTAINER? is true, skip all +hardware-related operations as necessary when booting a Linux container." + (let* ((services (operating-system-services + os + #:container? container? + #:container-shared-network? container-shared-network?)) (boot (fold-services services #:target-type boot-service-type))) (service-value boot))) @@ -837,17 +861,24 @@ we're running in the final root." #:target-type shepherd-root-service-type)))) -(define* (operating-system-derivation os) +(define* (operating-system-derivation os #:key container? + container-shared-network?) "Return a derivation that builds OS." - (let* ((services (operating-system-services os)) + (let* ((services (operating-system-services + os + #:container? container? + #:container-shared-network? container-shared-network?)) (system (fold-services services))) ;; SYSTEM contains the derivation as a monadic value. (service-value system))) -(define* (operating-system-profile os) +(define* (operating-system-profile os #:key container? container-shared-network?) "Return a derivation that builds the system profile of OS." (mlet* %store-monad - ((services -> (operating-system-services os)) + ((services -> (operating-system-services + os + #:container? container? + #:container-shared-network? container-shared-network?)) (profile (fold-services services #:target-type profile-service-type))) (match profile |