From 5ccec77176b7e0c67ed58c8849e5e76f3dd79a88 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 12 Sep 2019 22:17:43 +0200 Subject: 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/system/file-systems.scm | 2 +- gnu/system/linux-container.scm | 35 ++++++++++++++--------------------- 2 files changed, 15 insertions(+), 22 deletions(-) (limited to 'gnu/system') 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 @@ (define %network-file-mappings ;; 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 @@ (define* (container-script os #:key (mappings '()) shared-network?) "Return a derivation of a script that runs OS as a Linux container. MAPPINGS is a list of 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 @@ (define (os-file-system-specs os) 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 @@ (define script #~(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") -- cgit v1.2.3