diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/linux-container.scm | 19 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 11 | ||||
| -rw-r--r-- | gnu/system/linux-container.scm | 3 |
3 files changed, 24 insertions, 9 deletions
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm index 3fccc9addb..b71d6a5f88 100644 --- a/gnu/build/linux-container.scm +++ b/gnu/build/linux-container.scm @@ -24,6 +24,7 @@ #:use-module (guix utils) #:use-module (guix build utils) #:use-module (guix build syscalls) + #:use-module (gnu system file-systems) ;<file-system> #:use-module ((gnu build file-systems) #:select (mount-file-system)) #:export (user-namespace-supported? unprivileged-user-namespace-supported? @@ -72,8 +73,9 @@ exists." ;; specification: ;; https://raw.githubusercontent.com/docker/libcontainer/master/SPEC.md (define* (mount-file-systems root mounts #:key mount-/sys? mount-/proc?) - "Mount the essential file systems and the those in the MOUNTS list relative -to ROOT, then make ROOT the new root directory for the process." + "Mount the essential file systems and the those in MOUNTS, a list of +<file-system> objects, relative to ROOT; then make ROOT the new root directory +for the process." (define (scope dir) (string-append root dir)) @@ -141,8 +143,9 @@ to ROOT, then make ROOT the new root directory for the process." (symlink "/proc/self/fd/2" (scope "/dev/stderr")) ;; Mount user-specified file systems. - (for-each (lambda (spec) - (mount-file-system spec #:root root)) + (for-each (lambda (file-system) + (mount-file-system (file-system->spec file-system) + #:root root)) mounts) ;; Jail the process inside the container's root file system. @@ -197,8 +200,8 @@ corresponds to the symbols in NAMESPACES." (define (run-container root mounts namespaces host-uids thunk) "Run THUNK in a new container process and return its PID. ROOT specifies -the root directory for the container. MOUNTS is a list of file system specs -that specify the mapping of host file systems into the container. NAMESPACES +the root directory for the container. MOUNTS is a list of <file-system> +objects that specify file systems to mount inside the container. NAMESPACES is a list of symbols that correspond to the possible Linux namespaces: mnt, ipc, uts, user, and net. HOST-UIDS specifies the number of host user identifiers to map into the user namespace." @@ -256,8 +259,8 @@ host user identifiers to map into the user namespace." (define* (call-with-container mounts thunk #:key (namespaces %namespaces) (host-uids 1)) "Run THUNK in a new container process and return its exit status. -MOUNTS is a list of file system specs that specify the mapping of host file -systems into the container. NAMESPACES is a list of symbols corresponding to +MOUNTS is a list of <file-system> objects that specify file systems to mount +inside the container. NAMESPACES is a list of symbols corresponding to the identifiers for Linux namespaces: mnt, ipc, uts, pid, user, and net. By default, all namespaces are used. HOST-UIDS is the number of host user identifiers to map into the container's user namespace, if there is one. By diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index b51d57f079..4cc1221eb8 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -40,6 +40,7 @@ file-system-dependencies file-system->spec + spec->file-system specification->file-system-mapping uuid @@ -107,6 +108,16 @@ initrd code." (($ <file-system> device title mount-point type flags options _ _ check?) (list device title mount-point type flags options check?)))) +(define (spec->file-system sexp) + "Deserialize SEXP, a list, to the corresponding <file-system> object." + (match sexp + ((device title mount-point type flags options check?) + (file-system + (device device) (title title) + (mount-point mount-point) (type type) + (flags flags) (options options) + (check? check?))))) + (define (specification->file-system-mapping spec writable?) "Read the SPEC and return the corresponding <file-system-mapping>. SPEC is a string of the form \"SOURCE\" or \"SOURCE=TARGET\". The former specifies diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm index 189f9efa79..24e61c3ead 100644 --- a/gnu/system/linux-container.scm +++ b/gnu/system/linux-container.scm @@ -94,9 +94,10 @@ that will be shared with the host system." (gnu build linux-container))) #~(begin (use-modules (gnu build linux-container) + (gnu system file-systems) ;spec->file-system (guix build utils)) - (call-with-container '#$specs + (call-with-container (map spec->file-system '#$specs) (lambda () (setenv "HOME" "/root") (setenv "TMPDIR" "/tmp") |