From: Christopher Allan Webber Date: Sat, 21 Jan 2017 14:59:46 +0000 (-0600) Subject: websockets support works! :D X-Git-Tag: fosdem-2017~105 X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=829df0120213f2bf7420b8ae153e761feb675106 websockets support works! :D --- diff --git a/data/web-static/css/main.css b/data/web-static/css/main.css index 46ed206..308a556 100644 --- a/data/web-static/css/main.css +++ b/data/web-static/css/main.css @@ -73,6 +73,12 @@ body { margin-bottom: 0px; } + +.self-sent { + color: #494949; + border-left-color: #b4b4b4; +} + #input-metabox { diff --git a/data/web-static/js/mudsync.js b/data/web-static/js/mudsync.js index 1a08b47..90f3daa 100644 --- a/data/web-static/js/mudsync.js +++ b/data/web-static/js/mudsync.js @@ -18,7 +18,7 @@ ;;; along with Mudsync. If not, see . */ -function displayMessage(data) { +function displayMessage(data, self_sent) { var new_entry = document.createElement("div"); var new_text = document.createTextNode(data); var stream_metabox = document.getElementById("stream-metabox"); @@ -28,7 +28,11 @@ function displayMessage(data) { should_scroll = true; } document.getElementById("main-input").value = ""; - new_entry.setAttribute("class", "stream-entry"); + if (self_sent) { + new_entry.setAttribute("class", "stream-entry self-sent"); + } else { + new_entry.setAttribute("class", "stream-entry"); + } new_entry.appendChild(new_text); document.getElementById("stream").appendChild(new_entry); if (should_scroll) { @@ -40,11 +44,10 @@ function installWebsocket() { // TODO: Don't hardcode the websocket path; pull it from the DOM var ws = new WebSocket("ws://127.0.0.1:8888"); ws.onmessage = function(evt) { - displayMessage(evt.data); + displayMessage(evt.data, false); }; ws.onopen = function() { console.log("connected"); - ws.send("Hello, there!"); }; ws.onclose = function () { console.log("closed websocket"); @@ -58,7 +61,9 @@ function installUIHooks(ws) { if (!e) e = window.event; var keyCode = e.keyCode || e.which; if (keyCode == '13') { - sendMessageToServer(ws, input.value); + var input_val = input.value; + displayMessage("> ".concat(input_val), true); + sendMessageToServer(ws, input_val); } } } diff --git a/mudsync/networking.scm b/mudsync/networking.scm index d62568b..1a8ece5 100644 --- a/mudsync/networking.scm +++ b/mudsync/networking.scm @@ -58,10 +58,11 @@ (if web-server-port (nm-install-web-server actor server web-server-port)) (nm-install-socket actor server port))) - (send-to-client - (lambda* (actor message #:key client data) - (nm-send-to-client-id actor client data))) - (new-client nm-new-client)) + (send-to-client nm-send-to-client-id) + (new-socket-client nm-new-socket-client) + (new-web-client nm-new-web-client) + (client-disconnected nm-client-disconnected) + (incoming-line nm-incoming-line-action)) (web-server #:accessor .web-server) @@ -135,78 +136,100 @@ (let loop () ;; (yield) ;; @@: Do we need this? (define client-connection (accept s)) - (<- (actor-id nm) 'new-client + (<- (actor-id nm) 'new-socket-client s client-connection) (loop))) -(define (nm-new-client nm message s client-connection) +(define (nm-new-socket-client nm message s client-connection) "Handle new client coming in to socket S" (define client-details (cdr client-connection)) - (define client (car client-connection)) + (define client-socket (car client-connection)) (define client-id (big-random-number)) (format #t "New client: ~s\n" client-details) (format #t "Client address: ~s\n" (gethostbyaddr (sockaddr:addr client-details))) - (fcntl client F_SETFL (logior O_NONBLOCK (fcntl client F_GETFL))) - (hash-set! (nm-clients nm) client-id client) + (fcntl client-socket F_SETFL (logior O_NONBLOCK (fcntl client-socket F_GETFL))) + (hash-set! (nm-clients nm) client-id + (cons 'socket client-socket)) (<- (nm-send-input-to nm) 'new-client #:client client-id) - (nm-client-receive-loop nm client client-id)) + (nm-client-receive-loop nm client-socket client-id)) -(define (nm-client-receive-loop nm client client-id) +(define (nm-new-web-client nm message ws-client-id) + ;; nm client id, as opposed to the websocket one + (define client-id (big-random-number)) + (hash-set! (nm-clients nm) client-id + (cons 'websocket ws-client-id)) + (<- (nm-send-input-to nm) 'new-client #:client client-id) + (<-reply message client-id)) + +(define (nm-client-receive-loop nm client-socket client-id) "Make a method to receive client data" (define (loop) - (define line (read-line client)) + (define line (read-line client-socket)) (if (eof-object? line) - (nm-handle-port-eof nm client client-id) + (<- (actor-id nm) 'client-disconnected client-id) (begin - (nm-handle-line nm client client-id + (nm-handle-line nm client-id (string-trim-right line #\return)) (when (actor-alive? nm) (loop))))) (loop)) -(define (nm-handle-port-closed nm client client-id) +(define (nm-client-disconnected nm message client-id) "Handle a closed port" - (format #t "DEBUG: handled closed port ~x\n" client-id) + (format #t "DEBUG: handled closed port ~a\n" client-id) (hash-remove! (nm-clients nm) client-id) (<-* `(#:actor ,nm) (nm-send-input-to nm) 'client-closed #:client client-id)) -(define-method (nm-handle-port-eof nm client client-id) - "Handle seeing an EOF on port" - (format #t "DEBUG: handled eof-object on port ~x\n" client-id) - (close client) - (hash-remove! (nm-clients nm) client-id) - (<-* `(#:actor ,nm) (nm-send-input-to nm) 'client-closed - #:client client-id)) - -(define-method (nm-handle-line nm client client-id line) +(define (nm-handle-line nm client-id line) "Handle an incoming line of input from a client" (<-* `(#:actor ,nm) (nm-send-input-to nm) 'client-input #:data line #:client client-id)) -(define-method (nm-send-to-client-id nm client-id data) +(define* (nm-send-to-client-id nm message #:key client data) "Send DATA to TO-CLIENT id" - (define client-obj (hash-ref (nm-clients nm) client-id)) - (if (not client-obj) - (throw 'no-such-client - "Asked to send data to client but that client doesn't exist" - #:client-id client-id - #:data data)) - (display data client-obj)) + (define client-obj (hash-ref (nm-clients nm) client)) + (match client-obj + (#f (throw 'no-such-client + "Asked to send data to client but that client doesn't exist" + #:client-id client + #:data data)) + (('socket . client-socket) + (display data client-socket)) + (('websocket . ws-client-id) + (<- (.web-server nm) 'ws-send ws-client-id data)))) + +(define (nm-incoming-line-action nm message client-id line) + "Handle LINE coming in, probably from an external message handler, +like the web one" + (nm-handle-line nm client-id line)) ;;; Web server interface +(define-class () + (network-manager #:init-keyword #:network-manager + #:accessor .network-manager) + ;; This is a kludge... we really shouldn't have to double + ;; record these, should we? + (nm-client-ids #:init-thunk make-hash-table + #:accessor .nm-client-ids)) + (define (nm-install-web-server nm server web-server-port) "This installs the web server, which we see in use below...." (set! (.web-server nm) - (pk 'web-server (create-actor nm - #:port web-server-port - #:http-handler (wrap-apply http-handler) - #:on-ws-message (wrap-apply websocket-new-message))))) + (create-actor nm + #:network-manager (actor-id nm) + #:port web-server-port + #:http-handler (wrap-apply http-handler) + #:on-ws-message (wrap-apply websocket-new-message) + #:on-ws-client-connect + (wrap-apply websocket-client-connect) + #:on-ws-client-disconnect + (wrap-apply websocket-client-disconnect)))) (define (view:main-display request body) (define one-entry @@ -216,9 +239,10 @@ (define body-tmpl `((div (@ (id "stream-metabox")) (div (@ (id "stream")) - ,@(map (const one-entry) (iota 25)) - (div (@ (class "stream-entry")) - (p (b "") " Last one!")))) + ;; ,@(map (const one-entry) (iota 25)) + ;; (div (@ (class "stream-entry")) + ;; (p (b "") " Last one!")) + )) (div (@ (id "input-metabox")) (input (@ (id "main-input")))))) @@ -271,8 +295,23 @@ ;; Respond to text messages by reversing the message. Respond to ;; binary messages with "hello". (define (websocket-new-message websocket-server client-id data) - (<- (actor-id websocket-server) 'ws-send - client-id - (if (string? data) - (string-reverse data) - "hello"))) + (cond + ((string? data) + (<- (.network-manager websocket-server) 'incoming-line + (hash-ref (.nm-client-ids websocket-server) + client-id) + data)) + ;; binary data is ignored + (else #f))) + +(define (websocket-client-connect websocket-server client-id) + (let ((nm-client-id + (mbody-val (<-wait (.network-manager websocket-server) + 'new-web-client client-id)))) + (hash-set! (.nm-client-ids websocket-server) + client-id nm-client-id))) + +(define (websocket-client-disconnect websocket-server client-id) + (<- (.network-manager websocket-server) 'client-disconnected + (hash-ref (.nm-client-ids websocket-server) client-id)) + (hash-remove! (.nm-client-ids websocket-server) client-id))