1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00

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
4 changed files with 23 additions and 33 deletions

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.
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))
(guix build utils)
(srfi srfi-1))
(call-with-container
(map spec->file-system
(if (and #$shared-network?
(file-exists? #$nscd-run-directory))
'#$nscd-specs
'#$specs))
(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")