Commit 45d4e2f7 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

kernel: Provide kernels with a writable /home/jupyter.

* guix/jupyter/kernel.scm (make-container-root-directory): Rename to...
(make-container-directory): ... this. Create "root" and "home" sub-directories.
(spawn-kernel/container)[spawn]: Set "HOME" and chdir to /home/jupyter.
[fs]: Rename to...
[mounts]: ... this, and add bind-mount for "/home/jupyter".
parent 8f8fde60
......@@ -85,16 +85,20 @@ imported."
(('jupyter _ ...) #t)
(_ #f)))
(define (make-container-root-directory)
"Make a temporary directory for use as the root of a container and return
its name."
(define (make-container-directory)
"Make a temporary directory for use in a container and return its name.
The returned directory contains a 'root' and a 'home' sub-directory meant to
be used respectively as the root and home directory of the container."
(define parent
(string-append (or (getenv "TMPDIR") "/tmp")
"/guix-kernel"))
(mkdir-p parent)
(let ((template (string-append parent "/container.XXXXXX")))
(mkdtemp! template)))
(let* ((template (string-append parent "/container.XXXXXX"))
(directory (mkdtemp! template)))
(mkdir (string-append directory "/root"))
(mkdir (string-append directory "/home"))
directory))
(define (spawn-kernel/container context profile)
"Spawn the kernel found in PROFILE in a new container. Return, as a
......@@ -130,6 +134,10 @@ monadic value, a <kernel> connected to that process."
(setenv "JUPYTER_PATH"
#$(file-append profile "/share/jupyter"))
;; Better feel at home.
(setenv "HOME" "/home/jupyter")
(chdir "/home/jupyter")
;; Set the environment variables that apply to PROFILE.
(for-each (match-lambda
((spec . value)
......@@ -152,8 +160,14 @@ monadic value, a <kernel> connected to that process."
(allocate-connection context "tcp" "127.0.0.1"
(generate-key)))
(define fs
(append %container-file-systems %network-file-systems))
(define (mounts root)
(cons (file-system
(device (string-append root "/home"))
(mount-point "/home/jupyter")
(type "none")
(check? #f)
(flags '(bind-mount)))
(append %container-file-systems %network-file-systems)))
(define namespaces
;; XXX: Since we'll talk to KERNEL over TCP/IP (due to the fact that we
......@@ -162,10 +176,10 @@ monadic value, a <kernel> connected to that process."
(delq 'net %namespaces))
;; FIXME: Remove ROOT once the kernel has terminated.
(mlet* %store-monad ((root ((lift0 make-container-root-directory
%store-monad)))
(pid (eval/container* (spawn profile) root
#:mounts fs
(mlet* %store-monad ((root ((lift0 make-container-directory %store-monad)))
(pid (eval/container* (spawn profile)
(string-append root "/root")
#:mounts (mounts root)
#:namespaces namespaces
#:guest-uid 1000
#:guest-gid 1000)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment