first commit

.gitignore

@@ -0,0 +1,19 @@
+*.fas
+*.FASL
+*.fasl
+*.lisp-temp
+*.dfsl
+*.pfsl
+*.d64fsl
+*.p64fsl
+*.lx64fsl
+*.lx32fsl
+*.dx64fsl
+*.dx32fsl
+*.fx64fsl
+*.fx32fsl
+*.sx64fsl
+*.sx32fsl
+*.wx64fsl
+*.wx32fsl
+*~

LICENSE

@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2020-2021, David Botton
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its
+   contributors may be used to endorse or promote products derived from
+   this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,8 @@
+# cl-webinjector
+### David Botton <david@botton.com
+
+Communication framework for using a browser as a stateful GUI
+
+## License BSD 3-Clause License
+
+

clog-connection.lisp

@@ -0,0 +1,93 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; CLOG - The Common Lisp Omnificent GUI                                 ;;;;
+;;;; (c) 2020-2021 David Botton                                            ;;;;
+;;;; License BSD 3 Clause                                                  ;;;;
+;;;;                                                                       ;;;;
+;;;; clog-connection.lisp                                                  ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Exports - clog-connection
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(mgl-pax:define-package :clog-connection
+  (:documentation "The Common List Omnificent GUI - Connection")
+  (:use #:cl #:mgl-pax))
+
+(in-package :clog-connection)
+
+(defsection @clog-connection (:title "CLOG Connection")
+  "Low level connectivity to the web client and boot file script."
+
+  "CLOG connections"
+  
+  (message        function)
+  (execute-script function)
+  (validp         function)
+  (cclose         function)
+  (shutdown       function)
+  (cwrite         function)
+  (cwriteln       function))
+
+;;;;;;;;;;;;;
+;; message ;;
+;;;;;;;;;;;;;
+
+(defun message (connection-id message)
+  "Send MESSAGE to CONNECTION-ID."
+  (let ((con (clog::get-connection connection-id)))
+    (when con
+      (websocket-driver:send con message))))
+
+;;;;;;;;;;;;;;;;;;;;
+;; execute-script ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defun execute-script (connection-id script)
+  "Execute SCRIPT on CONNECTION-ID, disregard return value."
+  (message connection-id script))
+
+;;;;;;;;;;;;
+;; validp ;;
+;;;;;;;;;;;;
+
+(defun validp (connection-id)
+  "Check if CONNECTION-ID is valid."
+  (if (clog::get-connection connection-id)
+      t
+      nil))
+
+;;;;;;;;;;;;
+;; cclose ;;
+;;;;;;;;;;;;
+
+(defun cclose (connection-id)
+  "Close connection to CONNECTION-ID. The boot file may try to reistablish
+ connectivity."
+  (execute-script connection-id "ws.close()"))
+
+;;;;;;;;;;;;;;
+;; shutdown ;;
+;;;;;;;;;;;;;;
+
+(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')"))
+
+;;;;;;;;;;;;
+;; cwrite ;;
+;;;;;;;;;;;;
+
+(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)))
+
+;;;;;;;;;;;;;;
+;; cwriteln ;;
+;;;;;;;;;;;;;;
+
+(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)))

clog.asd

@@ -0,0 +1,15 @@
+;;;; clog.asd
+
+(asdf:defsystem #:clog
+  :description "The Common Lisp Omnificent GUI"
+
+  :author "David Botton <david@botton.com>"
+  :license  "BSD"
+  :version "0.0.1"
+  :serial t
+  :depends-on (#:clack #:websocket-driver #:alexandria #:hunchentoot #:cl-ppcre
+		       #:bordeaux-threads #:trivial-open-browser
+		       #:lack-middleware-static #:lack-middleware-session
+                       #:mgl-pax)
+  :components ((:file "clog")
+	       (:file "clog-connection")))

clog.lisp

@@ -0,0 +1,207 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; CLOG - The Common Lisp Omnificent GUI                                 ;;;;
+;;;; (c) 2020-2021 David Botton                                            ;;;;
+;;;; License BSD 3 Clause                                                  ;;;;
+;;;;                                                                       ;;;;
+;;;; clog.lisp                                                             ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Exports - clog
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(mgl-pax:define-package :clog
+  (:documentation "The Common List Omnificent GUI - Parent package")
+  (:use #:cl #:mgl-pax))
+
+(in-package :clog)
+
+(defsection @clog-manual (:title "The CLOG manual")
+  "The Common Lisp Omnificient GUI, CLOG for short, uses web technology
+to produce graphical user interfaces for applications locally or
+remotely. The CLOG package starts up the connectivity to the browser
+or other websocket client (often a browser embedded in a native
+application."
+
+  (clog asdf:system)
+
+  (@clog-top-level  section))
+
+(defsection @clog-top-level (:title "CLOG Top level")
+  "CLOG system startup and shutdown"
+
+  (*verbose-output* variable)
+  
+  (initialize      function)
+  (shutdown        function)
+  (set-on-connect  function)
+  
+  "CLOG utilities"
+  
+  (open-browser function))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation - clog
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *verbose-output* t "Verbose server output (default true)")
+
+(defvar *app*                nil "Clack 'app' middle-ware")
+(defvar *client-handler*     nil "Clack 'handler' for socket traffic")
+(defvar *on-connect-handler* nil "New connection event handler.")
+
+(defvar *new-id* 0 "Connection IDs")
+
+(defvar *connections*    (make-hash-table) "Connections to IDs")
+(defvar *connection-ids* (make-hash-table) "IDs to connections")
+
+(defvar *connection-lock* (bordeaux-threads:make-lock)
+  "Protect the connection hash tables")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; generate-connection-id ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun generate-connection-id ()
+  (incf *new-id*))
+
+;;;;;;;;;;;;;;;;;;;;
+;; get-connection ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defun get-connection (connection-id)
+  "Return the connection associated with CONNECITION-ID. (Private)"
+  (gethash connection-id *connection-ids*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; handle-new-connection ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun handle-new-connection (connection id)
+  (cond (id
+	 (when *verbose-output*
+	   (format t "Reconnection id - ~A to ~A~%" id connection))
+	 (bordeaux-threads:with-lock-held (*connection-lock*)
+	   (setf (gethash id *connection-ids*) connection)
+	   (setf (gethash connection *connections*) id)))
+	(t
+	 (setf id (generate-connection-id))
+	 (bordeaux-threads:with-lock-held (*connection-lock*)
+	   (setf (gethash connection *connections*) id)
+	   (setf (gethash id *connection-ids*) connection))
+	 (when *verbose-output*
+	   (format t "New connection id - ~A - ~A~%" id connection))
+	 (websocket-driver:send connection
+				(format nil "clog['connection_id']=~A" id))
+	 (bordeaux-threads:make-thread
+	  (lambda ()
+	    (funcall *on-connect-handler* id))))))
+
+;;;;;;;;;;;;;;;;;;;;
+;; handle-message ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defun handle-message (connection message)
+  (let ((id (gethash connection *connections*)))
+    (format t "msg: ~A sent ~A - ~A~%" id message connection)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; handle-close-connection ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun handle-close-connection (connection)
+  (let ((id (gethash connection *connections*)))
+    (when id
+      (when *verbose-output*
+	(format t "Connection id ~A has closed. ~A~%" id connection))
+      (bordeaux-threads:with-lock-held (*connection-lock*)
+	(remhash id *connection-ids*)
+	(remhash connection *connections*)))))
+
+;;;;;;;;;;;;;;;;;
+;; clog-server ;;
+;;;;;;;;;;;;;;;;;
+
+(defun clog-server (env)
+  (let ((ws (websocket-driver:make-server env)))
+    (websocket-driver:on :open ws
+                         (lambda ()
+			   (let ((id (getf env :query-string)))
+			     (when (typep id 'string)
+			       (setf id (parse-integer id)))
+			     (handle-new-connection ws id))))
+    
+    (websocket-driver:on :message ws
+                         (lambda (msg) (handle-message ws msg)))
+
+    (websocket-driver:on :close ws
+                         (lambda (&key code reason)
+                           (declare (ignore code reason))
+                           (handle-close-connection ws)))
+    (lambda (responder)
+      (declare (ignore responder))
+      (websocket-driver:start-connection ws))))
+
+;;;;;;;;;;;;;;;;
+;; initialize ;;
+;;;;;;;;;;;;;;;;
+
+(defun initialize (on-connect-handler
+		   &key
+		     (host           "0.0.0.0")
+		     (port           8080)
+		     (boot-file      "/boot.html")
+		     (static-root    #P"./static-files/"))
+  "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)
+  
+  (setf *app*
+	(lack:builder
+	 (:static :path (lambda (path)
+			  (cond ((ppcre:scan "^(?:/clog$)" path) nil)
+				((equal path "/") boot-file)
+				(t path)))
+		  :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))))
+
+;;;;;;;;;;;;;;
+;; shutdown ;;
+;;;;;;;;;;;;;;
+
+(defun shutdown ()
+  "Shutdown CLOG."
+  (clack:stop *client-handler*)
+  (bordeaux-threads:with-lock-held (*connection-lock*)
+    (clrhash *connections*)
+    (clrhash *connection-ids*))
+  (setf *app* nil)
+  (setf *client-handler* nil))
+
+;;;;;;;;;;;;;;;;;;;;
+;; set-on-connect ;;
+;;;;;;;;;;;;;;;;;;;;
+
+(defun set-on-connect (on-connect-handler)
+  "Change the ON-CONNECTION-HANDLER set during Initialize."
+  (setf *on-connect-handler* on-connect-handler))
+
+;;;;;;;;;;;;;;;;;;
+;; open-browser ;;
+;;;;;;;;;;;;;;;;;;
+
+(defun open-browser (&key (url "http://127.0.0.1:8080"))
+  "Open a web browser to URL."
+  (trivial-open-browser:open-browser url))

static-files/boot.html

@@ -0,0 +1,15 @@
+<!doctype HTML>
+<HTML>
+   <HEAD>
+      <meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate" />
+      <meta http-equiv="Pragma" content="no-cache" />
+      <meta http-equiv="Expires" content="0" />
+      <meta charset="utf-8">
+      <meta name="viewport" content="width=device-width, initial-scale=1">
+      <script src="/js/jquery.min.js" type="text/javascript"></script>
+      <script src="/js/boot.js" type="text/javascript"></script>
+   </HEAD>
+<BODY>
+</BODY>
+<noscript>Your browser must support JavaScript and be HTML 5 compilant to see this site.</noscript>
+</HTML>

static-files/debug.html

@@ -0,0 +1,16 @@
+<!doctype HTML>
+<HTML>
+   <HEAD>
+      <meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate" />
+      <meta http-equiv="Pragma" content="no-cache" />
+      <meta http-equiv="Expires" content="0" />
+      <meta charset="utf-8">
+      <meta name="viewport" content="width=device-width, initial-scale=1">
+      <script src="/js/jquery.min.js" type="text/javascript"></script>
+      <script>var clog_debug = true;</script>
+      <script src="/js/boot.js" type="text/javascript"></script>
+   </HEAD>
+<BODY>
+</BODY>
+<noscript>Your browser must support JavaScript and be HTML 5 compilant to see this site.</noscript>
+</HTML>

static-files/js/boot.js

@@ -0,0 +1,108 @@
+var ws;
+var adr;
+var params={};
+var clog={};
+var pingerid;
+
+if (typeof clog_debug == 'undefined') {
+    clog_debug = false;
+}
+
+function Ping_ws() {
+    if (ws.readyState == 1) {
+        ws.send ("0");
+    }
+}
+
+function Shutdown_ws(event) {
+    ws.onerror = null;
+    ws.onclose = null;
+    ws.close ();
+    ws = null;
+    clearInterval (pingerid);
+    if (clog['html_on_close'] != "") {
+        $(document.body).html(clog['html_on_close']);
+    } else {
+        alert ("Server connection lost " + event.reason);
+    }
+}
+
+function Setup_ws() {
+    ws.onmessage = function (event) {
+        try {
+            if (clog_debug == true) {
+		console.log ("eval data = " + event.data);
+            }
+            eval (event.data);
+        } catch (e) {
+            console.error (e.message);
+        }
+    }
+    
+    ws.onerror = function (event) {
+        console.log ("onerror: reconnect");
+        ws = null;
+        ws = new WebSocket (adr  + "?" + clog['connection_id']);
+        ws.onopen = function (event) {
+            console.log ("onerror: reconnect successful");
+            Setup_ws();
+        }
+        ws.onclose = function (event) {
+            console.log ("onerror: reconnect failure");
+            Shutdown_ws(event);
+        }
+    }
+    
+    ws.onclose = function (event) {
+        console.log ("onclose: reconnect");
+        ws = null;
+        ws = new WebSocket (adr  + "?" + clog['connection_id']);
+        ws.onopen = function (event) {
+            console.log ("onclose: reconnect successful");
+            Setup_ws();
+        }
+        ws.onclose = function (event) {
+            console.log ("onclose: reconnect failure");
+            Shutdown_ws(event);
+        }
+    }
+}
+
+$( document ).ready(function() {
+    var s = document.location.search;
+    var tokens;
+    var r = /[?&]?([^=]+)=([^&]*)/g;
+    
+    s = s.split("+").join(" ");
+    
+    while (tokens = r.exec(s)) {
+        params[decodeURIComponent(tokens[1])] = decodeURIComponent(tokens[2]);
+    }
+    
+    if (location.protocol == "https:") {
+        adr = "wss://" + location.hostname;
+    } else {
+        adr = "ws://" + location.hostname;
+    }
+    
+    if (location.port != "") { adr = adr + ":" + location.port; }
+    adr = adr + "/clog";
+    
+    try {
+        console.log ("connecting to " + adr);
+        ws = new WebSocket (adr);
+    } catch (e) {
+        console.log ("trying again, connecting to " + adr);
+        ws = new WebSocket (adr);
+    }
+    
+    if (ws != null) {
+        ws.onopen = function (event) {
+            console.log ("connection successful");
+            Setup_ws();
+        }
+        pingerid = setInterval (function () {Ping_ws ();}, 10000);
+    } else {
+        document.writeln ("If you are seeing this your browser or your connection to the internet is blocking websockets.");
+    }
+});

static-files/robots.txt

@@ -0,0 +1,2 @@
+User-agent: *
+Disallow:

test/test-clog.lisp

@@ -0,0 +1,27 @@
+(defpackage #:test-clog
+  (:use #:cl)
+  (:export test-connect on-connect))
+
+(in-package :test-clog)
+
+(defun on-connect (id)
+  (format t "Connection ~A is valid? ~A~%" id (clog-connection:validp id))
+  ;; (clog:execute-script id "alert('test1');")
+  (dotimes (n 10)
+    (clog-connection:cwrite id "<b>connection-write</b>")
+    (clog-connection:cwriteln id "<i>connection-writeln</i>")
+    (sleep .2))
+  (clog-connection:cwrite id "<hr>simulate network interupt")
+  (clog-connection:cclose id)
+  (sleep .2)
+  (clog-connection:cwrite id "<br><b>reconnected</b>")
+  (sleep .2)
+  (clog-connection:cwrite id "<br><b>shutting down connection</b>")
+  (clog-connection:shutdown id))
+
+(defun test-connect ()
+  (print "Init connection")
+  (clog:initialize #'on-connect :boot-file "/debug.html")
+  (print "Open browser")
+  (clog:open-browser)
+)