summaryrefslogtreecommitdiff
path: root/gnu/system/linux-container.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/linux-container.scm')
-rw-r--r--gnu/system/linux-container.scm61
1 files changed, 37 insertions, 24 deletions
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 6273cee3d30..c6124cd223b 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -30,6 +30,7 @@
30 #:use-module (gnu build linux-container) 30 #:use-module (gnu build linux-container)
31 #:use-module (gnu services) 31 #:use-module (gnu services)
32 #:use-module (gnu services base) 32 #:use-module (gnu services base)
33 #:use-module (gnu services networking)
33 #:use-module (gnu services shepherd) 34 #:use-module (gnu services shepherd)
34 #:use-module (gnu system) 35 #:use-module (gnu system)
35 #:use-module (gnu system file-systems) 36 #:use-module (gnu system file-systems)
@@ -109,7 +110,11 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
109 ;; Remove nscd service if network is shared with the host. 110 ;; Remove nscd service if network is shared with the host.
110 (if shared-network? 111 (if shared-network?
111 (list nscd-service-type 112 (list nscd-service-type
112 static-networking-service-type) 113 static-networking-service-type
114 dhcp-client-service-type
115 network-manager-service-type
116 connman-service-type
117 wicd-service-type)
113 (list)))) 118 (list))))
114 119
115 (operating-system 120 (operating-system
@@ -147,13 +152,6 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
147 "Return a derivation of a script that runs OS as a Linux container. 152 "Return a derivation of a script that runs OS as a Linux container.
148MAPPINGS is a list of <file-system> objects that specify the files/directories 153MAPPINGS is a list of <file-system> objects that specify the files/directories
149that will be shared with the host system." 154that will be shared with the host system."
150 (define nscd-run-directory "/var/run/nscd")
151
152 (define nscd-mapping
153 (file-system-mapping
154 (source nscd-run-directory)
155 (target nscd-run-directory)))
156
157 (define (mountable-file-system? file-system) 155 (define (mountable-file-system? file-system)
158 ;; Return #t if FILE-SYSTEM should be mounted in the container. 156 ;; Return #t if FILE-SYSTEM should be mounted in the container.
159 (and (not (string=? "/" (file-system-mount-point file-system))) 157 (and (not (string=? "/" (file-system-mount-point file-system)))
@@ -168,28 +166,42 @@ that will be shared with the host system."
168 os (cons %store-mapping mappings) 166 os (cons %store-mapping mappings)
169 #:shared-network? shared-network? 167 #:shared-network? shared-network?
170 #:extra-file-systems %container-file-systems)) 168 #:extra-file-systems %container-file-systems))
171 (nscd-os (containerized-operating-system 169 (specs (os-file-system-specs os)))
172 os (cons* nscd-mapping %store-mapping mappings)
173 #:shared-network? shared-network?
174 #:extra-file-systems %container-file-systems))
175 (specs (os-file-system-specs os))
176 (nscd-specs (os-file-system-specs nscd-os)))
177 170
178 (define script 171 (define script
179 (with-imported-modules (source-module-closure 172 (with-imported-modules (source-module-closure
180 '((guix build utils) 173 '((guix build utils)
181 (gnu build linux-container))) 174 (gnu build linux-container)
175 (guix i18n)
176 (guix diagnostics)))
182 #~(begin 177 #~(begin
183 (use-modules (gnu build linux-container) 178 (use-modules (gnu build linux-container)
184 (gnu system file-systems) ;spec->file-system 179 (gnu system file-systems) ;spec->file-system
185 (guix build utils)) 180 (guix build utils)
186 181 (guix i18n)
187 (call-with-container 182 (guix diagnostics)
188 (map spec->file-system 183 (srfi srfi-1))
189 (if (and #$shared-network? 184
190 (file-exists? #$nscd-run-directory)) 185 (define file-systems
191 '#$nscd-specs 186 (filter-map (lambda (spec)
192 '#$specs)) 187 (let* ((fs (spec->file-system spec))
188 (flags (file-system-flags fs)))
189 (and (or (not (memq 'bind-mount flags))
190 (file-exists? (file-system-device fs)))
191 fs)))
192 '#$specs))
193
194 (define (explain pid)
195 ;; XXX: We can't quite call 'bindtextdomain' so there's actually
196 ;; no i18n.
197 (info (G_ "system container is running as PID ~a~%") pid)
198 ;; XXX: Should we recommend 'guix container exec'? It's more
199 ;; verbose and doesn't bring much.
200 (info (G_ "Run 'sudo nsenter -a -t ~a' to get a shell into it.~%")
201 pid)
202 (newline (guix-warning-port)))
203
204 (call-with-container file-systems
193 (lambda () 205 (lambda ()
194 (setenv "HOME" "/root") 206 (setenv "HOME" "/root")
195 (setenv "TMPDIR" "/tmp") 207 (setenv "TMPDIR" "/tmp")
@@ -203,7 +215,8 @@ that will be shared with the host system."
203 #:host-uids 65536 215 #:host-uids 65536
204 #:namespaces (if #$shared-network? 216 #:namespaces (if #$shared-network?
205 (delq 'net %namespaces) 217 (delq 'net %namespaces)
206 %namespaces))))) 218 %namespaces)
219 #:process-spawned-hook explain))))
207 220
208 (gexp->script "run-container" script))) 221 (gexp->script "run-container" script)))
209 222