diff options
Diffstat (limited to 'gnu/system/linux-container.scm')
| -rw-r--r-- | gnu/system/linux-container.scm | 61 |
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. |
| 148 | MAPPINGS is a list of <file-system> objects that specify the files/directories | 153 | MAPPINGS is a list of <file-system> objects that specify the files/directories |
| 149 | that will be shared with the host system." | 154 | that 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 | ||
