MAJ terminée. Nous sommes passés en version 14.6.2 . Pour consulter les "releases notes" associées c'est ici :

https://about.gitlab.com/releases/2022/01/11/security-release-gitlab-14-6-2-released/
https://about.gitlab.com/releases/2022/01/04/gitlab-14-6-1-released/

Commit 1e334a55 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

Factorize proxy state handling in (guix jupyter proxy).

* guix/jupyter/proxy.scm: New file.
* Makefile.am (SOURCES): Add it.
* guix-jupyter-container.scm (%main-kernel, %main-kernel-id)
(register-kernel, kernel-by-name): Remove.
(local-eval): No longer return COUNTER.
(general-handler): Rewrite to expect a <proxy-state> and to pass a
<proxy-state> to all the message type handlers.
(ignore-request, reply-execute-request, shutdown): Adjust accordingly.
<top level>: Create a <proxy-state> and pass it to 'server-kernels'.
* guix-jupyter-kernel.scm (%main-kernel, %main-kernel-id)
(register-proxy, proxy-by-name): Remove.
(general-handler): Rewrite to expect a <proxy-state> and to pass a
<proxy-state> to all the message type handlers.
(ignore-request, reply-execute-request, shutdown): Adjust accordingly.
(kill-containers): Remove.
<top level>: Create a <proxy-state> and pass it to 'server-kernels'.
parent aa902cec
......@@ -22,6 +22,7 @@ godir=@guileobjectdir@
SOURCES = \
guix/jupyter/logging.scm \
guix/jupyter/proxy.scm \
jupyter/json.scm \
jupyter/messages.scm \
jupyter/kernels.scm \
......
......@@ -23,41 +23,18 @@
(srfi srfi-71)
(rnrs bytevectors)
(gcrypt base16)
(ice-9 vlist)
(ice-9 match)
(sxml simple)
(jupyter messages)
(jupyter kernels)
(jupyter servers)
(guix jupyter logging)
(guix jupyter proxy)
(guix-kernel magic))
;; ZeroMQ context.
(define %context (zmq-create-context))
(define %main-kernel
;; Our "main" client--i.e., the one that started us.
#f)
(define %main-kernel-id
;; "Identity" of our client to be used as the routing prefix on shell
;; sockets.
#f)
;;
;; Kernel list.
;;
(define (register-kernel vhash name kernel)
(format/log "registering kernel '~a' (aka. '~a', PID ~a)~%"
name (kernel-name kernel) (kernel-pid kernel))
(vhash-cons name kernel vhash))
(define (kernel-by-name vhash name)
(match (vhash-assoc name vhash)
((_ . kernel) kernel)
(#f #f)))
;;
;; Execution.
;;
......@@ -138,10 +115,7 @@
"execute_reply" `(("status" . "ok")
("execution_count" . ,counter)
("payload" . [])
("user_expressions" . ,empty-object))))
counter))))
("user_expressions" . ,empty-object))))))))
(define (kernel-info->shtml code)
(match (and=> (get-magic-line code) string-tokenize)
......@@ -171,33 +145,34 @@
(define (general-handler kernel kind message state)
"Handle MESSAGE, which was sent by KERNEL, a client of ours, on KIND (one
of 'kernel-shell', 'kernel-stdin', etc.)"
(match state
((containers count)
(if (eq? kernel %main-kernel)
(let ((handler (dispatch (message-type message))))
;; Record the socket identity of our client so we can forward
;; shell messages to it.
(set! %main-kernel-id (message-sender message))
of 'kernel-shell', 'kernel-stdin', etc.) STATE is a <proxy-state> record;
return a <proxy-state> record that reflects the new state."
(if (eq? kernel (proxy-state-client state))
(let ((containers count (handler kernel kind message
containers count)))
(list containers count)))
;; Record the socket identity of our client so we can forward shell
;; messages to it. As explained at
;; <http://zguide.zeromq.org/php:chapter3#header-68>, we get to
;; discover the identity of our peer the first time we get a message
;; from it, which is why we record it here.
(let* ((client-id (message-sender message))
(state (set-proxy-state-client-id state client-id))
(handler (dispatch (message-type message))))
(handler kernel kind message state))
;; This message is coming from one of our proxied kernels, so
;; forward it to our client.
(let ((id %main-kernel-id))
(format/log "forwarding ~s from ~s, socket ~s to ~s~%"
(message-type message) (kernel-pid kernel)
kind (bytevector->base16-string id))
(send-message %main-kernel message
#:kernel-socket kind
#:recipient id)
(list containers count))))))
;; This message is coming from one of our proxied kernels, so
;; forward it to our client.
(let ((id (proxy-state-client-id state)))
(format/log "forwarding ~s from ~s, socket ~s to ~s~%"
(message-type message) (kernel-pid kernel)
kind (bytevector->base16-string id))
(send-message (proxy-state-client state) message
#:kernel-socket kind
#:recipient id)
state)))
;; Unknown request type, ignore it.
(define (ignore-request kernel kind message kernels count)
(values kernels count))
(define (ignore-request kernel kind message state)
state)
(define (execute-request-sans-magic message)
"Return MESSAGE, an 'execute_request' message, with its \"%guix\" magic
......@@ -209,51 +184,52 @@ stripped."
`(("code" . ,(delete-magic code))
,@(alist-delete "code" content))))))
(define (reply-execute-request kernel kind message kernels count)
(define (reply-execute-request kernel kind message state)
(format/log "handling execute-request~%")
(let ((code (assoc-ref (json-string->scm (message-content message))
"code")))
(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~%")
(let ((count (reply-html kernel message (kernel-info->html code)
count)))
(values kernels count)))
(reply-html kernel message (kernel-info->html code) count)
(increment-execution-count state))
((magic-run? code)
(values kernels
(local-eval kernel message count)))
(local-eval kernel message count)
(increment-execution-count state))
((magic-kernel? code)
(let* ((name (magic-get-kernel-name code))
(proxied (kernel-by-name kernels name))
(proxied (lookup-proxied name state))
(message (execute-request-sans-magic message)))
(if proxied
(begin
(send-message proxied message)
(values kernels (+ count 1)))
(increment-execution-count state))
(match (find-kernel-specs name)
((? kernel-specs? specs)
(let* ((new-kernel (run-kernel %context specs
(let* ((new-kernel (run-kernel %context specs
(generate-key)))
(new-kernels (register-kernel kernels name
new-kernel)))
(state (register-proxied name new-kernel
state)))
(monitor-client new-kernel)
(send-message new-kernel message)
(values new-kernels (+ count 1))))
(increment-execution-count state)))
(#f
(reply-html kernel message '(b "No such kernel.")
count))))))
count)
(increment-execution-count state))))))
((magic-html? code)
(values kernels
(reply-html kernel message (delete-magic code)
count)))
(reply-html kernel message (delete-magic code)
count)
(increment-execution-count state))
(else
(values kernels
(local-eval kernel message count))))))
(local-eval kernel message count)
(increment-execution-count state)))))
(define (shutdown kernel kind message kernels count)
;; TODO: (for-each close-kernel KERNELS)
(format/log "shutting down~%")
(leave-server-loop (list kernels count)))
(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.
......@@ -280,8 +256,7 @@ stripped."
((_ name session-id connection)
(let* ((connection (json->connection (json-string->scm connection)))
(kernel (connection->kernel connection
#:context %context)))
(set! %main-kernel kernel)
#:context %context))
(state (proxy-state kernel)))
(format/log "started proxy as PID ~a~%" (getpid))
(serve-kernels (list kernel) general-handler
(list vlist-null 0)))))
(serve-kernels (list kernel) general-handler state))))
......@@ -23,8 +23,6 @@
(srfi srfi-19)
(srfi srfi-71)
(rnrs bytevectors)
(ice-9 vlist)
(ice-9 futures)
(ice-9 match)
(sxml simple)
(gnu build linux-container)
......@@ -36,13 +34,10 @@
(jupyter kernels)
(jupyter servers)
(guix jupyter logging)
(guix jupyter proxy)
(guix-kernel magic)
(guix-kernel environ))
(define %main-kernel
;; This is the "main kernel"--i.e., our client.
#f)
(define session-id (random (* 255 255)
(seed->random-state
(time-second (current-time time-utc)))))
......@@ -57,16 +52,6 @@
(string-replace (car (command-line)) "guix-jupyter-container.scm"
(+ (string-rindex (car (command-line)) #\/) 1)))
(define (register-proxy vhash name proxy)
"Register PROXY, a kernel object for a process running in a container that
acts as a proxy to an actual kernel."
(vhash-cons name proxy vhash))
(define (proxy-by-name vhash name)
(match (vhash-assoc name vhash)
((_ . proxy) proxy)
(#f #f)))
;;
;; Html.
......@@ -90,40 +75,36 @@ acts as a proxy to an actual kernel."
;; Handlers.
;;
(define %main-kernel-id
;; "Identity" of our client to be used as the routing prefix on shell
;; sockets.
#f)
(define (general-handler kernel kind message state)
"Handle MESSAGE, which was sent by KERNEL, a client of ours, on KIND (one
of 'kernel-shell', 'kernel-stdin', etc.)"
(match state
((containers count)
(if (eq? kernel %main-kernel)
(let ((handler (dispatch (message-type message))))
;; Record the socket identity of our client so we can forward
;; shell messages to it.
(set! %main-kernel-id (message-sender message))
(let ((containers count (handler kernel kind message
containers count)))
(list containers count)))
;; This message is coming from one of our proxied kernels, so
;; forward it to our client.
(let ((id %main-kernel-id))
(format/log "forwarding ~s from ~s, socket ~s to ~s~%"
(message-type message) (kernel-pid kernel)
kind (bytevector->base16-string id))
(send-message %main-kernel message
#:kernel-socket kind
#:recipient id)
(list containers count))))))
of 'kernel-shell', 'kernel-stdin', etc.) STATE is a <proxy-state> record;
return a <proxy-state> record that reflects the new state."
(if (eq? kernel (proxy-state-client state))
;; Record the socket identity of our client so we can forward shell
;; messages to it. As explained at
;; <http://zguide.zeromq.org/php:chapter3#header-68>, we get to
;; discover the identity of our peer the first time we get a message
;; from it, which is why we record it here.
(let* ((client-id (message-sender message))
(state (set-proxy-state-client-id state client-id))
(handler (dispatch (message-type message))))
(handler kernel kind message state))
;; This message is coming from one of our proxied kernels, so
;; forward it to our client.
(let ((id (proxy-state-client-id state)))
(format/log "forwarding ~s from ~s, socket ~s to ~s~%"
(message-type message) (kernel-pid kernel)
kind (bytevector->base16-string id))
(send-message (proxy-state-client state) message
#:kernel-socket kind
#:recipient id)
state)))
;; Unknown request type, ignore it.
(define (ignore-request kernel kind message containers count)
(values containers count))
(define (ignore-request kernel kind message state)
state)
(define KERNEL-INFO
`(("protocol_version" . "5.3.0")
......@@ -142,15 +123,16 @@ of 'kernel-shell', 'kernel-stdin', etc.)"
"https://gitlab.inria.fr/guix-hpc/guix-kernel")))))
;; Send kernel-info.
(define (reply-kernel-info-request kernel kind message containers count)
(define (reply-kernel-info-request kernel kind message state)
(send-message kernel (reply message "kernel_info_reply"
(scm->json-string KERNEL-INFO)))
(values containers count))
state)
(define (reply-execute-request kernel kind message containers count)
(define (reply-execute-request kernel kind message state)
(let* ((content (message-content message))
(code (assoc-ref (json-string->scm content) "code"))
(magic (get-magic-line code)))
(magic (get-magic-line code))
(count (proxy-state-execution-count state)))
(catch 'guix-kernel
(λ ()
(cond
......@@ -159,51 +141,47 @@ of 'kernel-shell', 'kernel-stdin', etc.)"
(let* ((list (string-split magic #\ ))
(env-name (list-ref list 2))
(env (list-cdr-ref list 4)))
(match (proxy-by-name containers env-name)
(match (lookup-proxied env-name state)
(#f
(format/log "spawning container ~s~%" env-name)
(let* ((container (start-container container-context
env-name env))
(new (register-proxy containers env-name
container)))
(state (register-proxied env-name container
state)))
(monitor-client container)
(pub-idle kernel message)
(send-message container message)
(values new (+ count 1))))
(increment-execution-count state)))
((? kernel? proxy)
(send-message kernel message)
(values containers (+ count 1))))))
(increment-execution-count state)))))
((or (magic-run? code)
(magic-kernel? code))
(let* ((list (string-split magic #\ ))
(env-name (list-ref list 2))
(proxy (proxy-by-name containers env-name)))
(proxy (lookup-proxied env-name state)))
(format/log "evaluating code in container ~s (PID ~s)~%"
env-name (kernel-pid proxy))
(send-message proxy message)
(values containers (+ count 1))))
(increment-execution-count state)))
((magic-html? code)
(values containers
(reply-html kernel message
(delete-magic code)
count)))
(reply-html kernel message (delete-magic code) count)
(increment-execution-count state))
(else
(let ((proxied (proxy-by-name containers "default")))
(let ((proxied (lookup-proxied "default" state)))
(format/log "evaluating code in default container (PID ~s)~%"
(kernel-pid proxied))
(send-message proxied message
#:kernel-socket kind))
(values containers (+ count 1)))))
#:kernel-socket kind)
(increment-execution-count state)))))
(λ error
(values containers
(reply-html kernel message
(error->html error) count))))))
(reply-html kernel message (error->html error) count)
(increment-execution-count state)))))
(define (shutdown kernel kind message containers count)
(define (shutdown kernel kind message state)
(format/log "shutting down ~a containers~%"
(vlist-length containers))
(kill-containers containers kernel message)
(leave-server-loop #t))
(proxy-state-proxied-number state))
(leave-server-loop (terminate-proxied-kernels message state)))
;;
;; Dispatch route.
......@@ -227,20 +205,6 @@ of 'kernel-shell', 'kernel-stdin', etc.)"
;; Process exit and signals handler.
;;
(define (kill-containers containers kernel message)
"Terminate all the proxies listed in the CONTAINERS vhash, sending them
MESSAGE."
(vlist-for-each (match-lambda
((name . proxy)
(format/log "terminating proxy ~s (PID ~s)...~%"
name (kernel-pid proxy))
;; Shutdown messages are sent on the control socket.
(send-message proxy message
#:kernel-socket kernel-control)
(close-kernel proxy)
(false-if-exception (kill (kernel-pid proxy) SIGTERM))))
containers))
;;
;; Run.
;;
......@@ -316,9 +280,9 @@ container."
(sigaction SIGTERM (exit-handler kernel))
(sigaction SIGINT (exit-handler kernel))
(set! %main-kernel kernel)
(let* ((sub-kernel (start-container container-context "default" '()))
(containers (vhash-cons "default" sub-kernel vlist-null)))
(state (register-proxied "default" sub-kernel
(proxy-state kernel))))
(serve-kernels (list kernel sub-kernel)
general-handler
(list containers 0))))
state)))
;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 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 proxy)
#:use-module (guix jupyter logging)
#:use-module (jupyter messages)
#:use-module (jupyter kernels)
#:use-module (srfi srfi-9 gnu)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:export (proxy-state
proxy-state?
proxy-state-client
proxy-state-client-id
proxy-state-proxied
proxy-state-execution-count
set-proxy-state-client-id
register-proxied
lookup-proxied
proxy-state-proxied-number
increment-execution-count
set-proxy-state-execution-count
terminate-proxied-kernels))
;;; Commentary:
;;;
;;; This module provides supporting code to implement a kernel server that
;;; proxies a bunch of kernels, the "proxied".
;;;
;;; Code:
(define-immutable-record-type <proxy-state>
(%proxy-state client client-id proxied count)
proxy-state?
(client proxy-state-client set-proxy-state-client) ;<kernel>
(client-id proxy-state-client-id set-proxy-state-client-id) ;bytevector
(proxied proxy-state-proxied set-proxy-state-proxied) ;vhash
(count proxy-state-execution-count ;integer
set-proxy-state-execution-count))
(define* (proxy-state client #:key client-id)
"Return a new proxy state with CLIENT, a <kernel>, as its client."
(%proxy-state client client-id vlist-null 0))
(define (register-proxied name kernel state)
"Register KERNEL as a proxied kernel with the given NAME in STATE, a
<proxy-state> record."
(let ((table (vhash-cons name kernel
(proxy-state-proxied state))))
(set-proxy-state-proxied state table)))
(define (lookup-proxied name state)
"Return the proxied kernel NAME from STATE, or #f if it could not be
found."
(match (vhash-assoc name (proxy-state-proxied state))
(#f #f)
((_ . kernel) kernel)))
(define (proxy-state-proxied-number state)
"Return the number of proxied kernels in STATE."
(vlist-length (proxy-state-proxied state)))
(define (increment-execution-count state)
"Return STATE with its execution count incremented."
(let ((count (proxy-state-execution-count state)))
(set-proxy-state-execution-count state (+ 1 count))))
(define (terminate-proxied-kernels message state)
"Terminate all the proxies listed in the CONTAINERS vhash, sending them
MESSAGE. Return the new state."
(vlist-for-each (match-lambda
((name . proxy)
(format/log "terminating proxy ~s (PID ~s)...~%"
name (kernel-pid proxy))
;; Shutdown messages are sent on the control socket.
(send-message proxy message
#:kernel-socket kernel-control)
(close-kernel proxy)
(false-if-exception (kill (kernel-pid proxy) SIGTERM))))
(proxy-state-proxied state))
;; FIXME: We should tell the server loop to "unmonitor" them.
(set-proxy-state-proxied state vlist-null))
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