diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-05-10 22:07:55 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-05-15 16:36:21 +0200 |
| commit | 3f9bed04f031a4d4f8d3b6dc0a4de42b0c628496 (patch) | |
| tree | 363e7ddff745a5a36c5ae9f20cb1d03af2363fc7 /gnu/system/linux-container.scm | |
| parent | 6edd5c546c7c1bb5ee45436a0441a9daf1e5509c (diff) | |
linux-container: Compute essential services for THIS-OPERATING-SYSTEM.
Previously, the 'essential-services' would correspond to the initial,
non-containerized OS. Thus, all the file systems removed in
'container-essential-services' would actually still be there because the
essential services would be computed on the non-containerized OS.
This is a followup to 69cae3d3356a69b7fe69481338f760545995485e.
* gnu/system/linux-container.scm (container-essential-services): Call
'operating-system-default-essential-services' to get the baseline
services.
(containerized-operating-system): Pass THIS-OPERATING-SYSTEM, not OS, to
'container-essential-services'.
Add a dummy root file system to 'file-systems'.
(container-script)[mountable-file-system?]: New procedure.
Use it.
Diffstat (limited to 'gnu/system/linux-container.scm')
| -rw-r--r-- | gnu/system/linux-container.scm | 21 |
1 files changed, 17 insertions, 4 deletions
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm index 0cfd7efd994..16eee7a3cd0 100644 --- a/gnu/system/linux-container.scm +++ b/gnu/system/linux-container.scm | |||
| @@ -46,7 +46,7 @@ from OS that are needed on the bare metal and not in a container." | |||
| 46 | (list (service-kind %linux-bare-metal-service) | 46 | (list (service-kind %linux-bare-metal-service) |
| 47 | firmware-service-type | 47 | firmware-service-type |
| 48 | system-service-type))) | 48 | system-service-type))) |
| 49 | (operating-system-essential-services os))) | 49 | (operating-system-default-essential-services os))) |
| 50 | 50 | ||
| 51 | (cons (service system-service-type | 51 | (cons (service system-service-type |
| 52 | (let ((locale (operating-system-locale-directory os))) | 52 | (let ((locale (operating-system-locale-directory os))) |
| @@ -103,14 +103,22 @@ containerized OS. EXTRA-FILE-SYSTEMS is a list of file systems to add to OS." | |||
| 103 | (inherit os) | 103 | (inherit os) |
| 104 | (swap-devices '()) ; disable swap | 104 | (swap-devices '()) ; disable swap |
| 105 | (essential-services (container-essential-services | 105 | (essential-services (container-essential-services |
| 106 | os #:shared-network? shared-network?)) | 106 | this-operating-system |
| 107 | #:shared-network? shared-network?)) | ||
| 107 | (services (remove (lambda (service) | 108 | (services (remove (lambda (service) |
| 108 | (memq (service-kind service) | 109 | (memq (service-kind service) |
| 109 | useless-services)) | 110 | useless-services)) |
| 110 | (operating-system-user-services os))) | 111 | (operating-system-user-services os))) |
| 111 | (file-systems (append (map mapping->fs mappings) | 112 | (file-systems (append (map mapping->fs mappings) |
| 112 | extra-file-systems | 113 | extra-file-systems |
| 113 | user-file-systems)))) | 114 | user-file-systems |
| 115 | |||
| 116 | ;; Provide a dummy root file system so we can create | ||
| 117 | ;; a 'boot-parameters' file. | ||
| 118 | (list (file-system | ||
| 119 | (mount-point "/") | ||
| 120 | (device "nothing") | ||
| 121 | (type "dummy"))))))) | ||
| 114 | 122 | ||
| 115 | (define* (container-script os #:key (mappings '()) shared-network?) | 123 | (define* (container-script os #:key (mappings '()) shared-network?) |
| 116 | "Return a derivation of a script that runs OS as a Linux container. | 124 | "Return a derivation of a script that runs OS as a Linux container. |
| @@ -126,6 +134,11 @@ that will be shared with the host system." | |||
| 126 | (target nscd-run-directory))) | 134 | (target nscd-run-directory))) |
| 127 | '())))) | 135 | '())))) |
| 128 | 136 | ||
| 137 | (define (mountable-file-system? file-system) | ||
| 138 | ;; Return #t if FILE-SYSTEM should be mounted in the container. | ||
| 139 | (and (not (string=? "/" (file-system-mount-point file-system))) | ||
| 140 | (file-system-needed-for-boot? file-system))) | ||
| 141 | |||
| 129 | (let* ((os (containerized-operating-system | 142 | (let* ((os (containerized-operating-system |
| 130 | os | 143 | os |
| 131 | (cons %store-mapping | 144 | (cons %store-mapping |
| @@ -134,7 +147,7 @@ that will be shared with the host system." | |||
| 134 | mappings)) | 147 | mappings)) |
| 135 | #:shared-network? shared-network? | 148 | #:shared-network? shared-network? |
| 136 | #:extra-file-systems %container-file-systems)) | 149 | #:extra-file-systems %container-file-systems)) |
| 137 | (file-systems (filter file-system-needed-for-boot? | 150 | (file-systems (filter mountable-file-system? |
| 138 | (operating-system-file-systems os))) | 151 | (operating-system-file-systems os))) |
| 139 | (specs (map file-system->spec file-systems))) | 152 | (specs (map file-system->spec file-systems))) |
| 140 | 153 | ||
