2024-10-11 16:45:22 -04:00
|
|
|
(in-package #:live-chat)
|
|
|
|
|
2024-10-12 19:53:34 -04:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defvar *handler* nil
|
|
|
|
"The clack chat server app.")
|
|
|
|
|
|
|
|
;; to wrap with multiple middlewares at once, use lack's builder macro
|
|
|
|
(defparameter *app*
|
|
|
|
(lack:builder
|
|
|
|
:session
|
|
|
|
(:static :path "/public/"
|
|
|
|
:root #P"/static-files/")
|
|
|
|
;; (lambda (app)
|
|
|
|
;; (lambda (env)
|
|
|
|
;; (prog1 (funcall app env)
|
|
|
|
;; (do-before-responding))))
|
|
|
|
(:mount "/ws-chat-messages" #'live-chat-ws:make-websocket-server)
|
|
|
|
live-chat-routes::*app*))
|
|
|
|
|
|
|
|
;; Start the chat server
|
|
|
|
(defun start-chat-server (&rest args &key (address "localhost") (port 8080) &allow-other-keys)
|
|
|
|
"Start the Clack chat server."
|
2024-10-13 00:31:11 -04:00
|
|
|
(slynk:create-server :port 4005 :dont-close t)
|
2024-10-12 19:53:34 -04:00
|
|
|
(setf *handler*
|
|
|
|
(apply #'clack:clackup *app*
|
|
|
|
:port port :host address args))
|
|
|
|
(when *handler*
|
2024-10-13 00:31:11 -04:00
|
|
|
(format t ";; Chat server started on ~A port ~A~%" address port)))
|
2024-10-12 19:53:34 -04:00
|
|
|
|
|
|
|
(defun stop-chat-server (&rest args)
|
|
|
|
(declare (ignore args))
|
|
|
|
(when *handler*
|
|
|
|
(prog1
|
|
|
|
(clack:stop *handler*)
|
|
|
|
(setf *handler* nil)))
|
|
|
|
(unless *handler*
|
2024-10-13 00:31:11 -04:00
|
|
|
(format t ";; Chat server stopped.~%")))
|
2024-10-12 19:53:34 -04:00
|
|
|
|
|
|
|
(defun restart-chat-server (&rest args)
|
|
|
|
(apply #'stop-chat-server args)
|
|
|
|
(apply #'start-chat-server args))
|
|
|
|
|
2024-10-13 00:31:11 -04:00
|
|
|
(defun main (&rest args &key (foreground t) &allow-other-keys)
|
|
|
|
(setf (cl-who:html-mode) :html5)
|
|
|
|
(create-messages-table)
|
|
|
|
(apply #'start-chat-server args)
|
|
|
|
(print (bt:all-threads))
|
|
|
|
(if foreground
|
|
|
|
(wait-for-clack-handler "clack-handler-")))
|
2024-10-12 19:53:34 -04:00
|
|
|
|
|
|
|
;; https://stackoverflow.com/a/30424968
|
2024-10-13 00:31:11 -04:00
|
|
|
(defun wait-for-clack-handler (name)
|
2024-10-12 19:53:34 -04:00
|
|
|
(bt:join-thread
|
|
|
|
(find-if
|
|
|
|
(lambda (th)
|
|
|
|
(prefixp name (bt:thread-name th)))
|
|
|
|
(bt:all-threads))))
|
|
|
|
|
|
|
|
;; https://github.com/brown/base?tab=readme-ov-file#prefixp-prefix-sequence-key-test-eql
|
|
|
|
(defun prefixp (prefix sequence &key (test #'eql))
|
|
|
|
"Does PREFIX match a prefix of SEQUENCE?"
|
|
|
|
(let ((mismatch (mismatch prefix sequence :test test)))
|
|
|
|
(or (null mismatch) (= mismatch (length prefix)))))
|