summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/system/linux-container.scm21
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