file-systems: Add /var/run/nscd to '%network-file-mappings'.

This allows containers created by "guix environment -CN" or by
"guix system container -N" to talk to the host nscd.

* gnu/system/file-systems.scm (%network-file-mappings): Add
"/var/run/nscd".
* gnu/build/shepherd.scm (default-mounts)[nscd-socket]: Remove.
* gnu/system/linux-container.scm (container-script)[nscd-run-directory]
[nscd-mapping, nscd-os, nscd-specs]: Remove.
[script]: Filter out from SPECS bind-mounts where the device does not
exist.
* guix/scripts/environment.scm (launch-environment/container)
[optional-mapping->fs]: New procedure.
[mappings]: Remove %NETWORK-FILE-MAPPINGS.
[file-systems]: Add %NETWORK-FILE-MAPPINGS here, filtered through
'optional-mapping->fs'.
This commit is contained in:
Ludovic Courtès 2019-09-12 22:17:43 +02:00
parent f58b2f38e4
commit 5ccec77176
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 23 additions and 33 deletions

View File

@ -67,16 +67,10 @@
(file-system-mapping (file-system-mapping
(source "/etc/group") (target source)))) (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) (append (cons (tmpfs "/tmp") %container-file-systems)
(let ((mappings `(,@(if (memq 'net namespaces) (let ((mappings `(,@(if (memq 'net namespaces)
'() '()
(cons nscd-socket %network-file-mappings)
%network-file-mappings))
,@(if (and (memq 'mnt namespaces) ,@(if (and (memq 'mnt namespaces)
(not (memq 'user namespaces))) (not (memq 'user namespaces)))
accounts accounts

View File

@ -508,7 +508,7 @@ a bind mount."
;; symlink to a file in a tmpfs which, for an unknown reason, ;; symlink to a file in a tmpfs which, for an unknown reason,
;; cannot be bind mounted read-only within the container. ;; cannot be bind mounted read-only within the container.
(writable? (string=? file "/etc/resolv.conf")))) (writable? (string=? file "/etc/resolv.conf"))))
%network-configuration-files)) (cons "/var/run/nscd" %network-configuration-files)))
(define (file-system-type-predicate type) (define (file-system-type-predicate type)
"Return a predicate that, when passed a file system, returns #t if that file "Return a predicate that, when passed a file system, returns #t if that file

View File

@ -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. "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 MAPPINGS is a list of <file-system> objects that specify the files/directories
that will be shared with the host system." 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) (define (mountable-file-system? file-system)
;; Return #t if FILE-SYSTEM should be mounted in the container. ;; Return #t if FILE-SYSTEM should be mounted in the container.
(and (not (string=? "/" (file-system-mount-point file-system))) (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) os (cons %store-mapping mappings)
#:shared-network? shared-network? #:shared-network? shared-network?
#:extra-file-systems %container-file-systems)) #:extra-file-systems %container-file-systems))
(nscd-os (containerized-operating-system (specs (os-file-system-specs os)))
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)))
(define script (define script
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
@ -182,14 +170,19 @@ that will be shared with the host system."
#~(begin #~(begin
(use-modules (gnu build linux-container) (use-modules (gnu build linux-container)
(gnu system file-systems) ;spec->file-system (gnu system file-systems) ;spec->file-system
(guix build utils)) (guix build utils)
(srfi srfi-1))
(call-with-container (define file-systems
(map spec->file-system (filter-map (lambda (spec)
(if (and #$shared-network? (let* ((fs (spec->file-system spec))
(file-exists? #$nscd-run-directory)) (flags (file-system-flags fs)))
'#$nscd-specs (and (or (not (memq 'bind-mount flags))
(file-exists? (file-system-device fs)))
fs)))
'#$specs)) '#$specs))
(call-with-container file-systems
(lambda () (lambda ()
(setenv "HOME" "/root") (setenv "HOME" "/root")
(setenv "TMPDIR" "/tmp") (setenv "TMPDIR" "/tmp")

View File

@ -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 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 will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from
~/.guix-profile to the environment profile." ~/.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 (mlet %store-monad ((reqs (inputs->requisites
(list (direct-store-path bash) profile)))) (list (direct-store-path bash) profile))))
(return (return
@ -498,11 +502,6 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from
(target cwd) (target cwd)
(writable? #t))) (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. ;; Mappings for the union closure of all inputs.
(map (lambda (dir) (map (lambda (dir)
(file-system-mapping (file-system-mapping
@ -511,6 +510,10 @@ will be used for the passwd entry. LINK-PROFILE? creates a symbolic link from
(writable? #f))) (writable? #f)))
reqs))) reqs)))
(file-systems (append %container-file-systems (file-systems (append %container-file-systems
(if network?
(filter-map optional-mapping->fs
%network-file-mappings)
'())
(map file-system-mapping->bind-mount (map file-system-mapping->bind-mount
mappings)))) mappings))))
(exit/status (exit/status