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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 5ccec77176b7e0c67ed58c8849e5e76f3dd79a88
Author: Ludovic Courtès <address@hidden>
Date:   Thu Sep 12 22:17:43 2019 +0200

    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'.
---
 gnu/build/shepherd.scm         |  8 +-------
 gnu/system/file-systems.scm    |  2 +-
 gnu/system/linux-container.scm | 35 ++++++++++++++---------------------
 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 cf68f21..b32765e 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 d11b36f..6cf6ccc 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 6273cee..451a727 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 cf58768..535f181 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