48 lines
1.5 KiB
Common Lisp
48 lines
1.5 KiB
Common Lisp
(in-package :smsg-network)
|
|
|
|
(defun command-loop (in out route)
|
|
(loop (let ((command (read-sexp in)))
|
|
(when (not (handle-inbound-command command in out route))
|
|
(return)))))
|
|
|
|
(defun handle-inbound-command (command in out route)
|
|
(ematch-sexp command
|
|
(("subscribe" filter sink name reply-sink reply-name)
|
|
(if (rebind-node filter nil route)
|
|
(when (plusp (length reply-sink))
|
|
(post reply-sink reply-name (sexp-build ("subscribe-ok" (= filter)))))
|
|
(report! `(rebind-failed ,command))))
|
|
(("unsubscribe" id)
|
|
(when (not (rebind-node id route nil))
|
|
(report! `(rebind-failed ,command))))
|
|
(("post" name body token)
|
|
(send name body))))
|
|
|
|
(defun relay (in out localname servermode)
|
|
(flet ((route (message)
|
|
(write-sexp message out)
|
|
(write-byte 13 out)
|
|
(write-byte 10 out)))
|
|
(if servermode
|
|
(route (sexp-quote ("hop" "0")))
|
|
(ematch-sexp (read-sexp in)
|
|
(("hop" "0") t)))
|
|
(force-output out)
|
|
(route (sexp-build ("subscribe" (= localname) "" "" "" "")))
|
|
(command-loop in out #'route)))
|
|
|
|
(defun handle-connection (stream)
|
|
(relay stream stream (sexp-quote "smsg") t))
|
|
|
|
(defun serve-on-port (port)
|
|
(usocket:socket-server "localhost" port 'handle-connection '()
|
|
:in-new-thread t
|
|
:multi-threading t
|
|
:reuse-address t
|
|
:element-type '(unsigned-byte 8)))
|
|
|
|
(defun client (localname hostname portnumber)
|
|
(let ((s (usocket:socket-stream
|
|
(usocket:socket-connect hostname portnumber :element-type '(unsigned-byte 8)))))
|
|
(relay s s localname nil)))
|