diff options
Diffstat (limited to 'gnu/system.scm')
| -rw-r--r-- | gnu/system.scm | 59 |
1 files changed, 41 insertions, 18 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index 99bc09873d..9ac2355b57 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -455,7 +455,7 @@ value of the SYSTEM-SERVICE-TYPE service." ("initrd" ,initrd) ("locale" ,locale)))))))) ;used by libc -(define* (essential-services os #:key container?) +(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. CONTAINER? determines whether to return the list of services for @@ -463,6 +463,9 @@ a container or that of a \"bare metal\" system." (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)) @@ -486,7 +489,8 @@ a container or that of a \"bare metal\" system." (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)) @@ -506,12 +510,13 @@ a container or that of a \"bare metal\" system." (service firmware-service-type (operating-system-firmware os)))))))) -(define* (operating-system-services os #:key container?) +(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) - (essential-services os #:container? container?)))) + (essential-services os #:container? container? + #:container-shared-network? container-shared-network?)))) ;;; @@ -580,7 +585,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 @@ -682,16 +687,13 @@ 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 @@ -699,7 +701,13 @@ fi\n"))) ("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. @@ -808,20 +816,28 @@ use 'plain-file' instead~%") root ALL=(ALL) ALL %wheel ALL=(ALL) ALL\n")) -(define* (operating-system-activation-script os #:key container?) +(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 #:container? container?)) + (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 #:key container?) +(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. When CONTAINER? is true, skip all hardware-related operations as necessary when booting a Linux container." - (let* ((services (operating-system-services os #:container? 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))) @@ -841,17 +857,24 @@ hardware-related operations as necessary when booting a Linux container." #:target-type shepherd-root-service-type)))) -(define* (operating-system-derivation os #:key container?) +(define* (operating-system-derivation os #:key container? + container-shared-network?) "Return a derivation that builds OS." - (let* ((services (operating-system-services os #:container? container?)) + (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 #:key container?) +(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 #:container? container?)) + ((services -> (operating-system-services + os + #:container? container? + #:container-shared-network? container-shared-network?)) (profile (fold-services services #:target-type profile-service-type))) (match profile |