Commit ddf0e075 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

Remove (guix jupyter inner-proxy).

* guix/jupyter/inner-proxy.scm: Remove.
* Makefile.am (SOURCES): Remove it.
parent c7906233
......@@ -23,7 +23,6 @@ godir=@guileobjectdir@
SOURCES = \
guix/jupyter/containers.scm \
guix/jupyter/environment.scm \
guix/jupyter/inner-proxy.scm \
guix/jupyter/kernel.scm \
guix/jupyter/logging.scm \
guix/jupyter/magic.scm \
......
;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 2018 Evgeny Panfilov <epanfilov@gmail.com>
;;; Copyright (C) 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright (C) 2018, 2019 Ludovic Courtès <ludovic.courtes@inria.fr>
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(define-module (guix jupyter inner-proxy)
#:use-module (json)
#:use-module (simple-zmq)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-71)
#:use-module (rnrs bytevectors)
#:use-module (gcrypt base16)
#:use-module (ice-9 match)
#:use-module (jupyter messages)
#:use-module (jupyter kernels)
#:use-module (jupyter servers)
#:use-module (guix jupyter logging)
#:use-module (guix jupyter proxy)
#:use-module (guix jupyter magic)
#:export (run-inner-proxy))
;;; Commentary:
;;;
;;; This module implements the "inner kernel proxy". The inner proxy runs
;;; isolated in a container and its client is the Guix kernel.
;;;
;;; The inner proxy may spawn other Jupyter kernels as a result of a ";;guix
;;; kernel" magic line; it then forwards requests coming from the Guix kernel
;;; to the kernels that it launched.
;;;
;;; Alternately, lacking a ";;guix kernel" magic, the inner proxy evaluates
;;; Guile code directly, thereby acting as a Guile kernel.
;;;
;;; Code:
(define %zmq-context-property
;; Key used to access the ZeroMQ context in <proxy-state>.
(list 'zmq 'context))
;;
;; Execution.
;;
(define (local-eval kernel message count)
(let* ((scontent (json-string->scm (message-content message)))
(sender (header-sender (message-header message)))
(code (string-append "(begin "
(delete-magic (assoc-ref scontent "code"))
")"))
(silent (assoc-ref scontent "silent"))
(store-history (assoc-ref scontent "store_history"))
(user-expressions (assoc-ref scontent "user_expressions"))
(allow-stdin (assoc-ref scontent "allow_stdin"))
(stop-on-error (assoc-ref scontent "stop_on_error"))
(empty-object '())
(counter (+ count 1))) ;Execution counter
(let ((err err-key evalue stacktrace result
(catch #t
;; Evaluate code.
(lambda ()
(let* ((err #f)
(err-key "No error")
(evalue "Success")
(stacktrace '())
(result (with-output-to-string
(lambda ()
(write
(eval (with-input-from-string code read)
(interaction-environment)))))))
(values err err-key evalue
stacktrace result)))
;; Get error message in case of an exception.
(lambda (key . parameters)
(let* ((err #t)
(err-key (with-output-to-string
(lambda () (display key))))
(evalue (with-output-to-string
(lambda () (display parameters))))
(stacktrace (vector err-key evalue))
(result ""))
(values err err-key evalue
stacktrace result))))))
(let ((send- (lambda* (kernel type content
#:optional (socket kernel-shell))
(let* ((reply (reply message type
(scm->json-string content))))
(send-message kernel reply
#:kernel-socket socket
#:recipient sender)))))
(format/log "sending execution result for '~a'~%" code)
(send- kernel
"execute_input" `(("code" . ,code)
("execution_count" . ,counter))
kernel-iopub)
(when err
(send- kernel
"error" `(("ename" . ,err-key)
("evalue" . ,evalue)
("traceback" . ,stacktrace))
kernel-iopub)
(send- kernel
"execute_reply" `(("status" . "error")
("execution_count" . ,counter)
("ename" . ,err-key)
("evalue" . ,evalue)
("traceback" . ,stacktrace)
("payload" . [])
("user_expressions" . ,empty-object))))
(unless err
(send- kernel
"execute_result" `(("data" . (("text/plain" . ,result)))
("metadata" . ,empty-object)
("execution_count" . ,counter))
kernel-iopub)
(send- kernel
"execute_reply" `(("status" . "ok")
("execution_count" . ,counter)
("payload" . [])
("user_expressions" . ,empty-object))))))))
;;
;; Handler.
;;
;; Unknown request type, ignore it.
(define (ignore-request kernel kind message state)
state)
(define (execute-request-sans-magic message)
"Return MESSAGE, an 'execute_request' message, with its \"%guix\" magic
stripped."
(let* ((content (json-string->scm (message-content message)))
(code (assoc-ref content "code")))
(set-message-content message
(scm->json-string
`(("code" . ,(delete-magic code))
,@(alist-delete "code" content))))))
(define (reply-execute-request kernel kind message state)
(format/log "handling execute-request~%")
(let ((count (proxy-state-execution-count state))
(code (assoc-ref (json-string->scm (message-content message))
"code")))
(cond
((magic-env? code)
(format/log "replying HTML for new environment~%")
(reply-html kernel message "<p>Done!</p>" count)
(pub-idle kernel message)
(increment-execution-count state))
((magic-run? code)
(local-eval kernel message count)
(increment-execution-count state))
((magic-kernel? code)
(let* ((name (magic-get-kernel-name code))
(proxied (lookup-proxied name state))
(message (execute-request-sans-magic message)))
(if proxied
(begin
(send-message proxied message)
(increment-execution-count state))
(match (find-kernel-specs name)
((? kernel-specs? specs)
(let* ((context (proxy-state-property state
%zmq-context-property))
(new-kernel (run-kernel context specs
(generate-key)))
(state (register-proxied name new-kernel state)))
(monitor-client new-kernel)
(send-message new-kernel message)
(increment-execution-count state)))
(#f
(reply-html kernel message '(b "No such kernel.")
count)
(increment-execution-count state))))))
((magic-html? code)
(reply-html kernel message (delete-magic code)
count)
(increment-execution-count state))
(else
(local-eval kernel message count)
(increment-execution-count state)))))
(define (shutdown kernel kind message state)
(format/log "shutting down ~a kernels~%"
(proxy-state-proxied-number state))
(leave-server-loop (terminate-proxied-kernels message state)))
;;
;; Dispatch route.
;;
(define dispatch-route
`(("execute_request" . ,reply-execute-request)
("shutdown_request" . ,shutdown)
("comm_info_request" . ,ignore-request)))
;;
;; Run.
;;
(define (run-inner-proxy session-id connection)
"Run an inner for SESSION-ID, with its client at CONNECTION."
(let* ((context (zmq-create-context))
(kernel (connection->kernel connection
#:context context))
(state (proxy-state kernel)))
(format/log "started proxy as PID ~a~%" (getpid))
(serve-kernels (list kernel)
(proxy-request-handler dispatch-route)
(set-proxy-state-property state %zmq-context-property
context))))
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