Commit 8079acd6 authored by ROUBY Pierre-Antoine's avatar ROUBY Pierre-Antoine
Browse files

guix-kernel: Use one socket for subkernel.

* guix-jupyter-kernel.scm (new-subkernel-connect): Delete sub-socket-iosub.
* guix-jupyter-subkernel.scm: Delete socket-iopub.
* guix-kernel/environ.scm: Minor chance on environment creation.
parent 3a5afb80
......@@ -110,11 +110,11 @@
(define addr-stdin (create-address notebook-info-stdin-port))
;; Sockets.
(define socket-heartbeat (zmq-create-socket context 'ZMQ_REP))
(define socket-shell (zmq-create-socket context 'ZMQ_ROUTER))
(define socket-control (zmq-create-socket context 'ZMQ_ROUTER))
(define socket-iopub (zmq-create-socket context 'ZMQ_PUB))
(define socket-stdin (zmq-create-socket context 'ZMQ_ROUTER))
(define socket-heartbeat (zmq-create-socket context ZMQ_REP))
(define socket-shell (zmq-create-socket context ZMQ_ROUTER))
(define socket-control (zmq-create-socket context ZMQ_ROUTER))
(define socket-iopub (zmq-create-socket context ZMQ_PUB))
(define socket-stdin (zmq-create-socket context ZMQ_ROUTER))
;; Useful lists.
(define adresses (list addr-heartbeat
......@@ -150,27 +150,15 @@
(define (subkernel-pid-by-name vhash name)
(assoc-ref (vhash-assoc name vhash) "pid"))
(define (subkernel-sockets-by-name vhash name)
(assoc-ref (vhash-assoc name vhash) "sockets"))
(define (subkernel-socket vhash name type)
(assoc-ref (subkernel-sockets-by-name vhash name)
type))
(define (subkernel-shell vhash name)
(subkernel-socket vhash name "shell"))
(define (subkernel-iosub vhash name)
(subkernel-socket vhash name "iosub"))
(define (subkernel-socket-by-name vhash name)
(assoc-ref (vhash-assoc name vhash) "socket"))
;;
;; Send.
;;
(define (send-to-subkernel subkernels socket-type name parts)
(zmq-send-msg-parts (subkernel-socket subkernels name socket-type)
(append (list name)
parts)))
(define (send-to-subkernel subkernels socket name parts)
(zmq-send-msg-parts socket (append (list name) parts)))
(define (send socket uuid header parent-header metadata content)
(let ((signature (get-signature notebook-info-key
......@@ -194,21 +182,22 @@
(pub header- "idle" parent-header))
(define (proxy-exec-subkernel subkernels name parts count)
;; Send Jupyter command tu default subkernel.
(send-to-subkernel subkernels "shell" name parts)
;; Get results.
(let ((result-execute-input (zmq-get-msg-parts (subkernel-iosub subkernels
name)))
(result-shell (zmq-get-msg-parts (subkernel-shell subkernels
name)))
(result-iopub (zmq-get-msg-parts (subkernel-iosub subkernels
name))))
;; Resend results to Jupyter.
(zmq-send-msg-parts socket-iopub result-execute-input)
(zmq-send-msg-parts socket-shell result-shell)
(zmq-send-msg-parts socket-iopub result-iopub)
(display ".")
(+ count 1)))
(let ((socket (subkernel-socket-by-name subkernels name)))
;; Send Jupyter command tu default subkernel.
(send-to-subkernel subkernels socket name parts)
;; Get results.
(let ((execute-input (zmq-get-msg-parts socket))
(error-or-result (zmq-get-msg-parts socket))
(execute-reply (zmq-get-msg-parts socket)))
;; Resend results to Jupyter.
(zmq-send-msg-parts socket-iopub execute-input)
(zmq-send-msg-parts socket-shell execute-reply)
(zmq-send-msg-parts socket-iopub error-or-result)
(display ".")
(+ count 1))))
;;
;; Handlers.
......@@ -228,21 +217,20 @@
(wire-header (json-string->scm(list-ref parts 3)))
(wire-parent-header (list-ref parts 4))
(wire-metadata (json-string->scm(list-ref parts 5)))
(wire-content (json-string->scm(list-ref parts 6))))
(let ((msg-type (hash-ref wire-header "msg_type"))
(msg-username (hash-ref wire-header "username"))
(msg-session (hash-ref wire-header "session"))
(msg-version (hash-ref wire-header "version")))
(let ((header- (make-header msg-username msg-session msg-version)))
(pub-busy header- (scm->json-string wire-header))
(let-values (((subkernels count) ((dispatch msg-type) socket wire-uuid
header-
wire-parent-header
(scm->json-string wire-metadata)
wire-content parts
subkernels count)))
(pub-idle header- (scm->json-string wire-header))
(general-handler socket subkernels count))))))
(wire-content (json-string->scm(list-ref parts 6)))
(msg-type (hash-ref wire-header "msg_type"))
(msg-username (hash-ref wire-header "username"))
(msg-session (hash-ref wire-header "session"))
(msg-version (hash-ref wire-header "version"))
(header- (make-header msg-username msg-session msg-version)))
(pub-busy header- (scm->json-string wire-header))
(let-values (((subkernels count) ((dispatch msg-type) socket wire-uuid
header- wire-parent-header
(scm->json-string wire-metadata)
wire-content parts
subkernels count)))
(pub-idle header- (scm->json-string wire-header))
(general-handler socket subkernels count))))
;; Unknown request type, ignore it.
(define (ignore-request socket uuid header- parent-header
......@@ -266,18 +254,20 @@
(magic (get-magic-line code)))
(cond
((magic-env? code) ;Guix environment magic command
(let* ((list (string-split magic #\ ))
(env-name (list-ref list 2))
(guile-version (list-ref list 3)))
(let* ((list (string-split magic #\ ))
(env-name (list-ref list 2))
(env (list-cdr-ref list 3)))
;; Create new environment if not exist
(if (not (subkernel-by-name subkernels env-name))
(let* ((pid (run-new-subkernel env-name guile-version ""))
(subkernel (new-subkernel-connect env-name pid))
(new (register-subkernel subkernels env-name subkernel)))
(values new count))
(if (subkernel-by-name subkernels env-name)
(values subkernels
(proxy-exec-subkernel subkernels env-name
parts count)))))
parts count))
(let* ((pid (run-new-subkernel env-name env))
(subkernel (new-subkernel-connect env-name pid))
(new (register-subkernel subkernels env-name
subkernel)))
(values new (proxy-exec-subkernel new env-name
parts count))))))
((magic-run? code)
(let* ((list (string-split magic #\ ))
(env-name (list-ref list 2)))
......@@ -331,13 +321,15 @@
#t))
(else
(let* ((subkernel (car sub))
(name (car subkernel))
(pid (assoc-ref subkernel "pid")))
(kill pid SIGTERM)
(waitpid pid)
(zmq-close-socket (assoc-ref (assoc-ref subkernel "sockets") "shell"))
(zmq-close-socket (assoc-ref (assoc-ref subkernel "sockets") "shell"))
(loop (cdr sub))))))
(name (car subkernel))
(pid (assoc-ref subkernel "pid")))
(kill pid SIGTERM)
(waitpid pid)
(zmq-close-socket (assoc-ref (assoc-ref subkernel "sockets")
"shell"))
(zmq-close-socket (assoc-ref (assoc-ref subkernel "sockets")
"shell"))
(loop (cdr sub))))))
(loop list)))
(define (atexit)
......@@ -361,34 +353,35 @@
(let* ((ipc-dir (string-append "/tmp/guix-kernel/ipc/" name "-"
(number->string pid) "/"))
(sub-addr (string-append "ipc://" ipc-dir))
(sub-addr-shell (string-append sub-addr "shell"))
(sub-addr-iosub (string-append sub-addr "iopub")))
(sub-addr-sock (string-append sub-addr "shell")))
(mkdir-p ipc-dir)
(let ((sub-socket-shell (zmq-create-socket sub-context 'ZMQ_DEALER))
(sub-socket-iosub (zmq-create-socket sub-context 'ZMQ_SUB)))
(zmq-set-socket-option sub-socket-shell 5 "guix-kernel") ;5 ZMQ_IDENTIFY
(zmq-set-socket-option sub-socket-iosub 6 "") ;6 ZMQ_SUBSCRIBE
(let ((sub-socket (zmq-create-socket sub-context ZMQ_DEALER)))
(zmq-set-socket-option sub-socket ZMQ_IDENTITY "guix-kernel")
(zmq-bind-socket sub-socket-shell sub-addr-shell)
(zmq-connect sub-socket-iosub sub-addr-iosub)
(zmq-bind-socket sub-socket sub-addr-sock)
(display "+")
(let ((new-subkernel `(("pid" . ,pid)
("sockets" .
(("shell" . ,sub-socket-shell)
("iosub" . ,sub-socket-iosub)))
("uptime" . ,(current-time)))))
(let ((new-subkernel `(("pid" . ,pid)
("socket" . ,sub-socket)
("uptime" . ,(current-time)))))
new-subkernel))))
(define (start-sub-kernel name guile env)
(define (start-sub-kernel name env)
(display (string-append "subkernel: pid: " (number->string (getpid))
"(" (number->string (getpgrp)) ")\n"))
(let ((guile-version (if (string-null? guile)
(let ((guile-version (if (null? env)
(guile-current-version->path)
(guile->path guile))))
(if (not (package-in-list->path env "guile"))
(guile-current-version->path)
(guile->bin-path
(package-in-list->path env "guile")))))
(new-env (if (null? env)
(environ)
(make-new-environment (environ) name env))))
(apply execle guile-version
(environ)
new-env
(append (list "guile")
(guile-current-load-path->args-list)
(guile-current-load-compiled-path->args-list)
......@@ -404,10 +397,10 @@
,(new-subkernel-connect "default" pid))))))
(general-handler socket-shell default-subkernel 0)))
(define (run-new-subkernel name guile env)
(define (run-new-subkernel name env)
(let ((pid (primitive-fork)))
(if (zero? pid)
(start-sub-kernel name guile env)
(start-sub-kernel name env)
pid)))
(start-kernel (run-new-subkernel "default" "" ""))
(start-kernel (run-new-subkernel "default" '()))
......@@ -67,24 +67,13 @@
(define addr-shell
(string-append "ipc:///tmp/guix-kernel/ipc/"
full-name "/shell"))
(define addr-iopub
(string-append "ipc:///tmp/guix-kernel/ipc/"
full-name "/iopub"))
;; Sockets.
(define socket-shell (zmq-create-socket context 'ZMQ_DEALER))
(define socket-iopub (zmq-create-socket context 'ZMQ_PUB))
;; Useful lists.
(define adresses (list addr-shell
addr-iopub))
(define sockets (list socket-shell
socket-iopub))
(define socket-shell (zmq-create-socket context ZMQ_DEALER))
(zmq-set-socket-option socket-shell 5 name) ;5 ZMQ_IDENTIFY
(zmq-set-socket-option socket-shell ZMQ_IDENTITY name)
(zmq-connect socket-shell addr-shell)
(zmq-bind-socket socket-iopub addr-iopub)
(zmq-connect socket-shell addr-shell)
;;
;; Send.
......@@ -102,7 +91,7 @@
metadata content))))
(define (pub header- state parent-header)
(send socket-iopub "" (header- "status") parent-header "{}"
(send socket-shell "" (header- "status") parent-header "{}"
(scm->json-string `(("execution_state" . ,state)))))
(define (pub-busy header- parent-header)
......@@ -124,17 +113,17 @@
(wire-header (json-string->scm(list-ref parts 4)))
(wire-parent-header (list-ref parts 5))
(wire-metadata (json-string->scm(list-ref parts 6)))
(wire-content (json-string->scm(list-ref parts 7))))
(let ((msg-type (hash-ref wire-header "msg_type"))
(msg-username (hash-ref wire-header "username"))
(msg-session (hash-ref wire-header "session"))
(msg-version (hash-ref wire-header "version")))
(let* ((header- (make-header msg-username msg-session msg-version))
(count ((dispatch msg-type) socket wire-uuid header-
(scm->json-string wire-header)
(scm->json-string wire-metadata)
wire-content count)))
(general-handler socket count)))))
(wire-content (json-string->scm(list-ref parts 7)))
(msg-type (hash-ref wire-header "msg_type"))
(msg-username (hash-ref wire-header "username"))
(msg-session (hash-ref wire-header "session"))
(msg-version (hash-ref wire-header "version"))
(header- (make-header msg-username msg-session msg-version))
(count ((dispatch msg-type) socket wire-uuid header-
(scm->json-string wire-header)
(scm->json-string wire-metadata)
wire-content count)))
(general-handler socket count)))
;; Unknown request type, ignore it.
(define (ignore-request socket uuid header- parent-header
......@@ -180,16 +169,17 @@
(result ""))
(values err err-key evalue
stacktrace result))))))
(let ((send- (lambda (socket msg-type content)
(send socket uuid
(header- msg-type)
parent-header metadata
(scm->json-string content)))))
(send- socket-iopub
(send- socket
"execute_input" `(("code" . ,code)
("execution_count" . ,counter)))
(when err
(send- socket-iopub
(send- socket
"error" `(("ename" . ,err-key)
("evalue" . ,evalue)
("traceback" . ,stacktrace)))
......@@ -202,20 +192,20 @@
("payload" . [])
("user_expressions" . ,empty-object))))
(unless err
(send- socket
"execute_result" `(("data" . (("text/plain" . ,result)))
("metadata" . ,empty-object)
("execution_count" . ,counter)))
(send- socket
"execute_reply" `(("status" . "ok")
("execution_count" . ,counter)
("payload" . [])
("user_expressions" . ,empty-object)))
(send- socket-iopub
"execute_result" `(("data" . (("text/plain" . ,result)))
("metadata" . ,empty-object)
("execution_count" . ,counter))))
("user_expressions" . ,empty-object))))
counter))))
(define (shutdown socket uuid header- parent-header
metadata content count)
(for-each zmq-close-socket sockets)
(zmq-close-socket socket-shell)
(zmq-destroy-context context)
(quit))
......
......@@ -27,12 +27,19 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (guile->path
#:export (guile->bin-path
guile-current-version->path
guile-current-load-path->args-list
guile-current-load-compiled-path->args-list
package-name->path))
package-name->path
package-in-list->path
make-path
make-new-environment))
;;
;; Guix package.
;;
(define (store) (open-connection))
......@@ -43,15 +50,21 @@
(built-derivations (list drv))
(return (derivation->output-path drv)))))
(define (guile->path guile)
(define (package-name->path name)
"Return store path for package coresponding to NAME."
(run-with-store (store) (m-package-by-name->package-path name)))
;;
;; Guile.
;;
(define (guile->bin-path guile)
"Return path to guile executable file. GUILE is package specification."
(string-append
(run-with-store (store) (m-package-by-name->package-path guile))
"/bin/guile"))
(string-append guile "/bin/guile"))
(define (guile-current-version->path)
"Return path to current guile executable file."
(guile->path (string-append "guile" "@" (version))))
(guile->bin-path (package-name->path (string-append "guile" "@" (version)))))
(define (guile-current-load-path->args-list)
"Return list of load path with '-L' prefix for each path."
......@@ -63,6 +76,40 @@
(append-map (cut list "-C" <>)
%load-compiled-path))
(define (package-name->path name)
"Return store path for package coresponding to NAME."
(run-with-store (store) (m-package-by-name->package-path name)))
;;
;; Create environment.
;;
(define (package-in-list->path packages name)
"Return path for package NAME in PACKAGES list."
(cond
((null? packages) #f)
((equal? (car (string-split (car packages) #\@)) name)
(package-name->path (car packages)))
(else (package-in-list->path (cdr packages) name))))
(define (make-path packages)
"Return PATH environment variable from PACKAGES list."
(string-append
"PATH=" (string-join
(map (cut package-name->path <>) packages)
"/bin:")
"/bin"))
(define (env->str name value)
(string-append (string-upcase name) "="
(if (not value) "" value)))
(define (make-new-environment environ name packages)
(let ((home (env->str "HOME" (getenv "HOME")))
(user (env->str "USER" (getenv "USER")))
(logname (env->str "LOGNAME" (getenv "LOGNAME")))
(term (env->str "TERM" (getenv "TERM")))
(pwd (env->str "PWD" (getenv "PWD")))
(pager (env->str "PAGER" (getenv "PAGER")))
(shell (env->str "SHELL" (getenv "SHELL")))
(ps1 (env->str "PS1" (string-append "'Jupyter Guix Kernel ["
name "] -> '")))
(jenv (env->str "JUPYTER_ENV" name))
(path (make-path packages)))
(list home user logname term pwd pager shell ps1 jenv path)))
Supports Markdown
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