Commit 99f5b5b4 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

Move kernel-in-container execution to (guix jupyter kernel).

* guix-jupyter-kernel.scm (session-id): Remove.
(create-environment): Call 'spawn-kernel/container' instead of
'start-container', and remove 'name' argument.
(%network-file-systems, module-to-import?, start-container): Move to...
* guix/jupyter/kernel.scm: ... here.
(start-container): Rename to...
(spawn-kernel/container): ... this.  Remove 'name' parameter.  Call
'make-container-root-directory' to create the root directory of the
container.
(make-container-root-directory): New procedure.
parent d981e1a5
......@@ -27,34 +27,24 @@
(rnrs bytevectors)
(ice-9 match)
(sxml simple)
((gnu packages) #:select (specification->package))
(gnu build linux-container)
(gnu system file-systems)
(guix build syscalls)
(guix build utils)
(guix gexp)
(guix store)
(guix channels)
(guix derivations)
(guix inferior)
(guix monads)
(guix modules)
(guix profiles)
(gcrypt base16)
(jupyter messages)
(jupyter kernels)
(jupyter servers)
(jupyter guile)
(guix jupyter containers)
(guix jupyter logging)
(guix jupyter proxy)
(guix jupyter kernel)
(guix jupyter environment))
(define session-id (random (* 255 255)
(seed->random-state
(time-second (current-time time-utc)))))
;;
;; Container tools.
;;
......@@ -228,8 +218,8 @@ to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
"/share/jupyter")))
((specs)
(let* ((container (run-with-store store
(start-container container-context
name profile)))
(spawn-kernel/container container-context
profile)))
(state (register-proxied name container state)))
(monitor-client container)
(reply-for-environment-kernel kernel message
......@@ -495,107 +485,6 @@ environment ~s (PID ~s)~%"
;; Run.
;;
(define %network-file-systems
;; The list of <file-system> objects corresponding to bind-mounts required
;; for networking.
(filter-map (lambda (mapping)
(let ((fs (file-system-mapping->bind-mount mapping)))
(and (file-exists? (file-system-device fs))
fs)))
%network-file-mappings))
(define (module-to-import? name)
"Return true if NAME (a list of symbols) denotes a module that should be
imported."
(match name
(('guix _ ...) #t)
(('gnu _ ...) #t)
(('jupyter _ ...) #t)
(_ #f)))
(define (start-container context name profile)
"Start a container with the given NAME, and run the kernel found in
PROFILE. Return, as a monadic value, a <kernel> connected to the process in
that container."
(define guile-gcrypt
(specification->package "guile-gcrypt"))
(define guile-json
(specification->package "guile-json"))
(define guile-simple-zmq
(specification->package "guile-simple-zmq"))
(define (spawn profile)
(with-extensions (list guile-gcrypt guile-json guile-simple-zmq)
(with-imported-modules (source-module-closure
'((guix profiles)
(guix search-paths)
(jupyter kernels)
(jupyter guile))
#:select? module-to-import?)
#~(begin
(use-modules (guix profiles)
(guix search-paths)
(jupyter kernels) ;json->connection
(jupyter guile)
(ice-9 match))
;; (set-network-interface-up "lo") ;up lo interface
;; Do like 'guix environment'.
(setenv "GUIX_ENVIRONMENT" #$profile)
;; Make sure kernels can always be found.
(setenv "JUPYTER_PATH"
#$(file-append profile "/share/jupyter"))
;; Set the environment variables that apply to PROFILE.
(for-each (match-lambda
((spec . value)
(setenv (search-path-specification-variable spec)
value)))
(profile-search-paths #$profile))
(let ((str #$(scm->json-string (connection->json connection))))
(match (available-kernel-specs #$profile
(list (getenv "JUPYTER_PATH")))
((specs)
(format (current-error-port)
"starting kernel for '~a'...~%"
(kernel-specs-display-name specs))
(exec-kernel specs (json->connection str)))
(()
#f)))))))
(define-values (connection kernel)
(allocate-connection context "tcp" "127.0.0.1"
(generate-key)))
(define root
(string-append "/tmp/guix-kernel/container/"
name "-" (number->string session-id)))
(define fs
(cons (file-system
(device "/tmp/guix-kernel")
(mount-point "/tmp/guix-kernel")
(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
;; use a "connection file" above), this process must live in the global
;; network namespace. TODO: Arrange to use Unix-domain sockets instead.
(delq 'net %namespaces))
(mlet* %store-monad ((_ ((lift1 mkdir-p %store-monad) root))
(pid (eval/container* (spawn profile) root
#:mounts fs
#:namespaces namespaces
#:guest-uid 1000
#:guest-gid 1000)))
(return (set-kernel-pid kernel pid))))
(define (exit-handler kernel)
(lambda _
......
......@@ -15,9 +15,25 @@
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(define-module (guix jupyter kernel)
#:use-module (guix jupyter containers)
#:use-module (jupyter messages)
#:use-module (jupyter kernels)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix modules)
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module ((gnu packages) #:select (specification->package))
#:use-module (gnu system file-systems)
#:use-module ((gnu build linux-container) #:select (%namespaces))
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (json)
#:export (%language-info
%kernel-info-reply))
%kernel-info-reply
spawn-kernel/container))
;;; Commentary:
;;;
......@@ -45,3 +61,118 @@
(help-links
'(("Inria GitLab" . "https://gitlab.inria.fr/guix-hpc/guix-kernel")
("GNU Guix" . "https://guix.gnu.org")))))
;;;
;;; Running a kernel in a container.
;;;
(define %network-file-systems
;; The list of <file-system> objects corresponding to bind-mounts required
;; for networking.
(filter-map (lambda (mapping)
(let ((fs (file-system-mapping->bind-mount mapping)))
(and (file-exists? (file-system-device fs))
fs)))
%network-file-mappings))
(define (module-to-import? name)
"Return true if NAME (a list of symbols) denotes a module that should be
imported."
(match name
(('guix _ ...) #t)
(('gnu _ ...) #t)
(('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 parent
(string-append (or (getenv "TMPDIR") "/tmp")
"/guix-kernel"))
(mkdir-p parent)
(let ((template (string-append parent "/container.XXXXXX")))
(mkdtemp! template)))
(define (spawn-kernel/container context profile)
"Spawn the kernel found in PROFILE in a new container. Return, as a
monadic value, a <kernel> connected to that process."
(define guile-gcrypt
(specification->package "guile-gcrypt"))
(define guile-json
(specification->package "guile-json"))
(define guile-simple-zmq
(specification->package "guile-simple-zmq"))
(define (spawn profile)
(with-extensions (list guile-gcrypt guile-json guile-simple-zmq)
(with-imported-modules (source-module-closure
'((guix profiles)
(guix search-paths)
(jupyter kernels)
(jupyter guile))
#:select? module-to-import?)
#~(begin
(use-modules (guix profiles)
(guix search-paths)
(jupyter kernels) ;json->connection
(jupyter guile)
(ice-9 match))
;; (set-network-interface-up "lo") ;up lo interface
;; Do like 'guix environment'.
(setenv "GUIX_ENVIRONMENT" #$profile)
;; Make sure kernels can always be found.
(setenv "JUPYTER_PATH"
#$(file-append profile "/share/jupyter"))
;; Set the environment variables that apply to PROFILE.
(for-each (match-lambda
((spec . value)
(setenv (search-path-specification-variable spec)
value)))
(profile-search-paths #$profile))
(let ((str #$(scm->json-string (connection->json connection))))
(match (available-kernel-specs #$profile
(list (getenv "JUPYTER_PATH")))
((specs)
(format (current-error-port)
"starting kernel for '~a'...~%"
(kernel-specs-display-name specs))
(exec-kernel specs (json->connection str)))
(()
#f)))))))
(define-values (connection kernel)
(allocate-connection context "tcp" "127.0.0.1"
(generate-key)))
(define fs
(cons (file-system
(device "/tmp/guix-kernel")
(mount-point "/tmp/guix-kernel")
(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
;; use a "connection file" above), this process must live in the global
;; network namespace. TODO: Arrange to use Unix-domain sockets instead.
(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
#:namespaces namespaces
#:guest-uid 1000
#:guest-gid 1000)))
(return (set-kernel-pid kernel pid))))
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