mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-05 18:20:36 -08:00
Code Issues Projects Releases Wiki Activity

first commit

Browse source
This commit is contained in:
David Botton 2020-12-13 16:21:26 -05:00
commit e4731e2fa1
13 changed files with 543 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

19
.gitignore vendored Normal file
View file

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

29
LICENSE Normal file
View file

@ -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.

8
README.md Normal file
View file

@ -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

93
clog-connection.lisp Normal file
View file

@ -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)))

15
clog.asd Normal file
View file

@ -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")))

207
clog.lisp Normal file
View file

@ -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))

15
static-files/boot.html Normal file
View file

@ -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>

16
static-files/debug.html Normal file
View file

@ -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>

BIN
static-files/favicon.ico Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 766 B

108
static-files/js/boot.js Normal file
View file

@ -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.");
}
});

4
static-files/js/jquery.min.js vendored Normal file
View file

File diff suppressed because one or more lines are too long

2
static-files/robots.txt Normal file
View file

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

27
test/test-clog.lisp Normal file
View file

@ -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)
)