From 8a62348edd198838f75c1c8a8b50ee29ee2beeae Mon Sep 17 00:00:00 2001 From: David Botton Date: Tue, 19 Jan 2021 18:48:24 -0500 Subject: [PATCH] Added multiple paths and default routes. --- clog-connection.lisp | 41 ++++++++++++++++++++++-------- clog-system.lisp | 59 ++++++++++++++++++++++++++++---------------- 2 files changed, 69 insertions(+), 31 deletions(-) diff --git a/clog-connection.lisp b/clog-connection.lisp index d9b1af9..c832d5b 100644 --- a/clog-connection.lisp +++ b/clog-connection.lisp @@ -29,6 +29,7 @@ script." (initialize function) (shutdown-clog function) (set-on-connect function) + (set-clog-path function) (get-connection-data function) "CLOG system utilities" @@ -78,6 +79,8 @@ script." (defvar *queries-sems* (make-hash-table) "Query ID to semiphores") (defvar *query-time-out* 3 "Number of seconds to timeout waiting for a query") +(defvar *url-to-boot-file* (make-hash-table :test 'equalp) "URL to boot-file") + ;;;;;;;;;;;;;;;;; ;; generate-id ;; ;;;;;;;;;;;;;;;;; @@ -230,23 +233,31 @@ the default answer. (Private)" (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) + "Initialize CLOG on a socket using HOST and PORT to serve BOOT-FILE as +the default route for '/' to establish web-socket connections and static files +located at STATIC-ROOT. If BOOT-FILE is nil no initial clog-path's will be +setup, use clog-path to add. The on-connect-handler needs to indentify the +path by querying the browser. See PATH-NAME (CLOG-LOCATION)." + + (set-on-connect on-connect-handler) + + (when boot-file + (set-clog-path "/" boot-file)) + (setf *app* (lack:builder (:static :path (lambda (path) - (cond ((ppcre:scan "^(?:/clog$)" path) nil) - ((equal path "/") boot-file) - (t path))) + (let ((clog-path (gethash path *url-to-boot-file*))) + (cond ((ppcre:scan "^(?:/clog$)" path) nil) + (clog-path clog-path) + (t path)))) :root static-root) (lambda (env) (clog-server env)))) (setf *client-handler* (clack:clackup *app* :address host :port port)) - (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 for path / : ~A~%" boot-file)) ;;;;;;;;;;;;;;;;;;; ;; shutdown-clog ;; @@ -259,6 +270,7 @@ located at STATIC-ROOT." (clrhash *connection-data*) (clrhash *connections*) (clrhash *connection-ids*)) + (clrhash *url-to-boot-file*) (setf *app* nil) (setf *client-handler* nil)) @@ -270,6 +282,15 @@ located at STATIC-ROOT." "Change the ON-CONNECTION-HANDLER set during Initialize." (setf *on-connect-handler* on-connect-handler)) +;;;;;;;;;;;;;;;;;;; +;; set-clog-path ;; +;;;;;;;;;;;;;;;;;;; + +(defun set-clog-path (path boot-file) + (if boot-file + (setf (gethash path *url-to-boot-file*) boot-file) + (remhash path *url-to-boot-file*))) + ;;;;;;;;;;;;;;;;;;; ;; escape-string ;; ;;;;;;;;;;;;;;;;;;; diff --git a/clog-system.lisp b/clog-system.lisp index 549cbe8..dab102b 100644 --- a/clog-system.lisp +++ b/clog-system.lisp @@ -13,18 +13,27 @@ ;; Implementation - CLOG System ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar *url-to-on-new-window* (make-hash-table :test 'equalp) + "URL to on-new-window handlers") + +(defvar *clog-running* nil "If clog running.") + ;;;;;;;;;;;;;;;; ;; initialize ;; ;;;;;;;;;;;;;;;; -(defvar *on-new-window* nil "Store the on-new-window handler") - (defun on-connect (connection-id) (when cc:*verbose-output* (format t "Start new window handler on connection-id - ~A" connection-id)) (let ((body (make-clog-body connection-id))) - (funcall *on-new-window* body))) - + (let* ((path (path-name (location body))) + (on-new-window (or (gethash path *url-to-on-new-window*) + (gethash "default" *url-to-on-new-window*) + (gethash "/" *url-to-on-new-window*)))) + (if on-new-window + (funcall on-new-window body) + (put-br (html-document win) "No route to on-new-window"))))) + (defun initialize (on-new-window-handler &key (host "0.0.0.0") @@ -35,27 +44,34 @@ the default route to establish web-socket connections and static files located at STATIC-ROOT. If CLOG was already initialized and not shut down, this function does the same as set-on-new-window. If the variable -clog:*overide-static-root* is set STATIC-ROOT will be ignored." - (if *on-new-window* - (set-on-new-window on-new-window-handler) - (progn - (set-on-new-window on-new-window-handler) - - (cc:initialize #'on-connect - :host host - :port port - :boot-file boot-file - :static-root (if (boundp '*overide-static-root*) - *overide-static-root* - static-root))))) +clog:*overide-static-root* is set STATIC-ROOT will be ignored. If BOOT-FILE +is nil no default boot-file will be set for /." + + (set-on-new-window on-new-window-handler :path "/" :boot-file boot-file) + + (unless *clog-running* + (setf *clog-running* t) + (cc:initialize #'on-connect + :host host + :port port + :boot-file boot-file + :static-root (if (boundp '*overide-static-root*) + *overide-static-root* + static-root)))) ;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-new-window ;; ;;;;;;;;;;;;;;;;;;;;;;; -(defun set-on-new-window (on-new-window-handler) - "Change the on-new-window handler." - (setf *on-new-window* on-new-window-handler)) +(defun set-on-new-window (on-new-window-handler + &key (path "/") (boot-file "/boot.html")) + "Set or change the on-new-window handler or set a new one for PATH +using BOOT_FILE. If PATH is set to default will use boot-file when +the path can not be determined." + (cc:set-clog-path path boot-file) + (if boot-file + (setf (gethash path *url-to-on-new-window*) on-new-window-handler) + (remhash path *url-to-on-new-window*))) ;;;;;;;;;;;;;; ;; shutdown ;; @@ -63,5 +79,6 @@ clog:*overide-static-root* is set STATIC-ROOT will be ignored." (defun shutdown () "Shutdown CLOG." - (set-on-new-window nil) + (clrhash *url-to-on-new-window*) + (setf *clog-running* nil) (cc:shutdown-clog))