From fc7c764d2df2c1470b4fe7dadda5d50c87b4228e Mon Sep 17 00:00:00 2001 From: David Botton Date: Sun, 13 Dec 2020 23:35:07 -0500 Subject: [PATCH] Support receiving script results. --- clog-connection.lisp | 51 +++++++++++++++++++++++++++----------------- clog.lisp | 46 +++++++++++++++++++++++++++++---------- test/test-clog.lisp | 10 ++++++--- 3 files changed, 73 insertions(+), 34 deletions(-) diff --git a/clog-connection.lisp b/clog-connection.lisp index 852447b..2ea6d13 100644 --- a/clog-connection.lisp +++ b/clog-connection.lisp @@ -11,6 +11,7 @@ ;; Exports - clog-connection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (mgl-pax:define-package :clog-connection (:documentation "The Common List Omnificent GUI - Connection") (:use #:cl #:mgl-pax)) @@ -22,31 +23,41 @@ "CLOG connections" - (message function) - (execute-script function) - (validp function) - (cclose function) - (shutdown function) - (cwrite function) - (cwriteln function)) + (execute function) + (query function) + (validp function) + (cclose function) + (shutdown function) + (cwrite function) + (cwriteln function)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Implemetation - clog-connection +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;;;;;;;;; -;; message ;; +;; execute ;; ;;;;;;;;;;;;; -(defun message (connection-id message) - "Send MESSAGE to CONNECTION-ID." +(defun execute (connection-id message) + "Execute SCRIPT on CONNECTION-ID, disregard return value." (let ((con (clog::get-connection connection-id))) (when con (websocket-driver:send con message)))) -;;;;;;;;;;;;;;;;;;;; -;; execute-script ;; -;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;; +;; query ;; +;;;;;;;;;;; -(defun execute-script (connection-id script) - "Execute SCRIPT on CONNECTION-ID, disregard return value." - (message connection-id script)) +(defun query (connection-id script) + "Execute SCRIPT on CONNECTION-ID, return value." + (let ((uid (clog::generate-connection-id))) + (clog::store-query uid nil) + (execute connection-id + (format nil "ws.send (\"~A:\"+eval(\"~A\"));" uid script)) + (clog::wait-for-answer uid))) ;;;;;;;;;;;; ;; validp ;; @@ -65,7 +76,7 @@ (defun cclose (connection-id) "Close connection to CONNECTION-ID. The boot file may try to reistablish connectivity." - (execute-script connection-id "ws.close()")) + (execute connection-id "ws.close()")) ;;;;;;;;;;;;;; ;; shutdown ;; @@ -74,7 +85,7 @@ (defun shutdown (connection-id) "Shutdown connection to CONNECTION-ID. The boot file may not try to reistablish connectivity." - (execute-script connection-id "Shutdown_ws(event.reason='user')")) + (execute connection-id "Shutdown_ws(event.reason='user')")) ;;;;;;;;;;;; ;; cwrite ;; @@ -82,7 +93,7 @@ reistablish connectivity." (defun cwrite (connection-id text) "Write TEXT raw to document object of CONNECTION-ID with out new line." - (message connection-id (format nil "document.write('~A');" text))) + (execute connection-id (format nil "document.write('~A');" text))) ;;;;;;;;;;;;;; ;; cwriteln ;; @@ -90,4 +101,4 @@ reistablish connectivity." (defun cwriteln (connection-id text) "Write TEXT raw to document object of CONNECTION-ID with new line." - (message connection-id (format nil "document.writeln('~A');" text))) + (execute connection-id (format nil "document.writeln('~A');" text))) diff --git a/clog.lisp b/clog.lisp index 3b38700..58f2efe 100644 --- a/clog.lisp +++ b/clog.lisp @@ -59,11 +59,14 @@ application." (defvar *connection-lock* (bordeaux-threads:make-lock) "Protect the connection hash tables") +(defvar *queries* (make-hash-table) "Waiting queries") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; generate-connection-id ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun generate-connection-id () + "Generate unique ids for use in connections and sripts. (Private)" (incf *new-id*)) ;;;;;;;;;;;;;;;;;;;; @@ -102,9 +105,35 @@ application." ;; handle-message ;; ;;;;;;;;;;;;;;;;;;;; +(defvar *queries-lock* (bordeaux-threads:make-lock)) +(defvar *queries-sems* (make-hash-table)) + +(defun store-query (id answer) + (bordeaux-threads:with-lock-held (*queries-lock*) + (setf (gethash id *queries-sems*) (bordeaux-threads:make-semaphore)) + (setf (gethash id *queries*) answer))) + +(defun wait-for-answer (id) + (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout 3) + (let ((answer (gethash id *queries*))) + (bordeaux-threads:with-lock-held (*queries-lock*) + (remhash id *queries*) + (remhash id *queries-sems*)) + answer)) + (defun handle-message (connection message) - (let ((id (gethash connection *connections*))) - (format t "msg: ~A sent ~A - ~A~%" id message connection))) + (let ((id (gethash connection *connections*)) + (ml (ppcre:split ":" message :limit 2))) + (cond ((equal (car ml) "0") + (when *verbose-output* + (format t "~A Ping ~A~%" id (car ml)))) + (t + (when *verbose-output* + (format t "~A ~A = ~A~%" id (car ml) (cadr ml))) + (bordeaux-threads:with-lock-held (*queries-lock*) + (setf (gethash (parse-integer (car ml)) *queries*) (cadr ml))) + (bordeaux-threads:signal-semaphore + (gethash (parse-integer (car ml)) *queries-sems*)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; handle-close-connection ;; @@ -156,9 +185,7 @@ application." "Inititalze CLOG on a socket using HOST and PORT to serve BOOT-FILE as the default route to establish web-socket connections and static files located at STATIC-ROOT." - - (set-on-connect on-connect-handler) - + (set-on-connect on-connect-handler) (setf *app* (lack:builder (:static :path (lambda (path) @@ -168,14 +195,11 @@ located at STATIC-ROOT." :root static-root) (lambda (env) (clog-server env)))) - (setf *client-handler* (clack:clackup *app* :address host :port port)) - (when *verbose-output* - (progn - (format t "HTTP listening on : ~A:~A~%" host port) - (format t "HTML Root : ~A~%" static-root) - (format t "Boot file default : ~A~%" boot-file)))) + (format t "HTTP listening on : ~A:~A~%" host port) + (format t "HTML Root : ~A~%" static-root) + (format t "Boot file default : ~A~%" boot-file))) ;;;;;;;;;;;;;; ;; shutdown ;; diff --git a/test/test-clog.lisp b/test/test-clog.lisp index 008b534..f597717 100644 --- a/test/test-clog.lisp +++ b/test/test-clog.lisp @@ -1,10 +1,10 @@ (defpackage #:test-clog (:use #:cl) - (:export test-connect on-connect)) + (:export test-connect on-connect1 on-connect2)) (in-package :test-clog) -(defun on-connect (id) +(defun on-connect1 (id) (format t "Connection ~A is valid? ~A~%" id (clog-connection:validp id)) ;; (clog:execute-script id "alert('test1');") (dotimes (n 10) @@ -19,9 +19,13 @@ (clog-connection:cwrite id "
shutting down connection") (clog-connection:shutdown id)) +(defun on-connect2 (id) + (clog-connection:cwrite id "Query Result : ") + (clog-connection:cwrite id (clog-connection:query id "navigator.appVersion"))) + (defun test-connect () (print "Init connection") - (clog:initialize #'on-connect :boot-file "/debug.html") + (clog:initialize #'on-connect2 :boot-file "/debug.html") (print "Open browser") (clog:open-browser) )