diff options
| -rw-r--r-- | gnu/build/shepherd.scm | 8 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 2 | ||||
| -rw-r--r-- | gnu/system/linux-container.scm | 35 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 13 |
4 files changed, 24 insertions, 34 deletions
diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm index cf68f2108b..b32765ed5e 100644 --- a/gnu/build/shepherd.scm +++ b/gnu/build/shepherd.scm @@ -67,16 +67,10 @@ (file-system-mapping (source "/etc/group") (target source)))) - (define nscd-socket - (file-system-mapping - (source "/var/run/nscd") (target source) - (writable? #t))) - (append (cons (tmpfs "/tmp") %container-file-systems) (let ((mappings `(,@(if (memq 'net namespaces) '() - (cons nscd-socket - %network-file-mappings)) + %network-file-mappings) ,@(if (and (memq 'mnt namespaces) (not (memq 'user namespaces))) accounts diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index d11b36f25d..6cf6ccc53e 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -508,7 +508,7 @@ a bind mount." ;; symlink to a file in a tmpfs which, for an unknown reason, ;; cannot be bind mounted read-only within the container. (writable? (string=? file "/etc/resolv.conf")))) - %network-configuration-files)) + (cons "/var/run/nscd" %network-configuration-files))) (define (file-system-type-predicate type) "Return a predicate that, when passed a file system, returns #t if that file diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm index 6273cee3d3..451a72762c 100644 --- a/gnu/system/linux-container.scm +++ b/gnu/system/linux-container.scm @@ -147,13 +147,6 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS." "Return a derivation of a script that runs OS as a Linux container. MAPPINGS is a list of <file-system> objects that specify the files/directories that will be shared with the host system." - (define nscd-run-directory "/var/run/nscd") - - (define nscd-mapping - (file-system-mapping - (source nscd-run-directory) - (target nscd-run-directory))) - (define (mountable-file-system? file-system) ;; Return #t if FILE-SYSTEM should be mounted in the container. (and (not (string=? "/" (file-system-mount-point file-system))) @@ -168,12 +161,7 @@ that will be shared with the host system." os (cons %store-mapping mappings) #:shared-network? shared-network? #:extra-file-systems %container-file-systems)) - (nscd-os (containerized-operating-system - os (cons* nscd-mapping %store-mapping mappings) - #:shared-network? shared-network? - #:extra-file-systems %container-file-systems)) - (specs (os-file-system-specs os)) - (nscd-specs (os-file-system-specs nscd-os))) + (specs (os-file-system-specs os))) (define script (with-imported-modules (source-module-closure @@ -182,14 +170,19 @@ that will be shared with the host system." #~(begin (use-modules (gnu build linux-container) (gnu system file-systems) ;spec->file-system - (guix build utils)) - - (call-with-container - (map spec->file-system - (if (and #$shared-network? - (file-exists? #$nscd-run-directory)) - '#$nscd-specs - '#$specs)) + (guix build utils) + (srfi srfi-1)) + + (define file-systems + (filter-map (lambda (spec) + (let* ((fs (spec->file-system spec)) + (flags (file-system-flags fs))) + (and (or (not (memq 'bind-mount flags)) + (file-exists? (file-system-device fs))) + fs))) + '#$specs)) + + (call-with-container file-systems (lambda () (setenv "HOME" "/root") (setenv "TMPDIR" "/tmp") diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index cf58768300..535f181bfd 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -462,6 +462,10 @@ host file systems to mount inside the container. If USER is not #f, each target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the environment profile." + (define (optional-mapping->fs mapping) + (and (file-exists? (file-system-mapping-source mapping)) + (file-system-mapping->bind-mount mapping))) + (mlet %store-monad ((reqs (inputs->requisites (list (direct-store-path bash) profile)))) (return @@ -498,11 +502,6 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from (target cwd) (writable? #t))) '()))) - ;; When in Rome, do as Nix build.cc does: Automagically - ;; map common network configuration files. - (if network? - %network-file-mappings - '()) ;; Mappings for the union closure of all inputs. (map (lambda (dir) (file-system-mapping @@ -511,6 +510,10 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from (writable? #f))) reqs))) (file-systems (append %container-file-systems + (if network? + (filter-map optional-mapping->fs + %network-file-mappings) + '()) (map file-system-mapping->bind-mount mappings)))) (exit/status |