52 lines
1.7 KiB
Common Lisp
52 lines
1.7 KiB
Common Lisp
|
(in-package #:live-chat-ws)
|
||
|
|
|
||
|
|
(defvar *connections* (make-hash-table))
|
||
|
|
|
||
|
|
(defun handle-post-message (message)
|
||
|
|
"Handle a new message being posted to the chat."
|
||
|
|
(let ((message (cl-who:escape-string message)))
|
||
|
|
(format *standard-output* "Message received: ~a~%" message)
|
||
|
|
(live-chat-db:insert-message message)))
|
||
|
|
|
||
|
|
(defun handle-new-connection (con)
|
||
|
|
(setf (gethash con *connections*)
|
||
|
|
(princ-to-string (gensym "USER-"))))
|
||
|
|
|
||
|
|
(defun broadcast-to-room (connection message)
|
||
|
|
(handle-post-message message)
|
||
|
|
(let ((message
|
||
|
|
(cl-who:with-html-output-to-string (*standard-output*)
|
||
|
|
(:div :class "box"
|
||
|
|
(format t "~a: ~a" (gethash connection *connections*) message)))))
|
||
|
|
(loop :for con :being :the :hash-key :of *connections* :do
|
||
|
|
(send con message))))
|
||
|
|
|
||
|
|
(defun handle-close-connection (connection)
|
||
|
|
(let ((message
|
||
|
|
(cl-who:with-html-output-to-string (*standard-output*)
|
||
|
|
(:div :class "box"
|
||
|
|
(format t "... ~a disconnected."
|
||
|
|
(gethash connection *connections*))))))
|
||
|
|
(loop :for con :being :the :hash-key :of *connections* :do
|
||
|
|
(send con message))))
|
||
|
|
|
||
|
|
(defun make-websocket-server (env)
|
||
|
|
(handler-case
|
||
|
|
(let ((ws (make-server env)))
|
||
|
|
(on :open ws
|
||
|
|
(lambda ()
|
||
|
|
(handle-new-connection ws)))
|
||
|
|
(on :message ws
|
||
|
|
(lambda (msg)
|
||
|
|
(broadcast-to-room ws msg)))
|
||
|
|
(on :close ws
|
||
|
|
(lambda (&key code reason)
|
||
|
|
(declare (ignore code reason))
|
||
|
|
(handle-close-connection ws)))
|
||
|
|
(lambda (responder)
|
||
|
|
(declare (ignore responder))
|
||
|
|
(start-connection ws)))
|
||
|
|
(error (e)
|
||
|
|
(declare (ignore e))
|
||
|
|
(format nil "Something went wrong. Try again?"))))
|