112 lines
4.7 KiB
Fennel
112 lines
4.7 KiB
Fennel
;; the server for pond.
|
|
;;
|
|
;; usage: fennel server.fnl <port>
|
|
;;
|
|
;; test via websocat ws://127.0.0.1:<port>
|
|
|
|
(local port (or (. arg 1) 0))
|
|
(local http-server (require :http.server))
|
|
(local http-headers (require :http.headers))
|
|
(local websocket (require :http.websocket))
|
|
(local json (require :json))
|
|
|
|
(fn log [msg]
|
|
(assert (io.stdout:write (.. "[" (os.date "%d/%b/%Y:%H:%M:%S %z") "] " msg "\n"))))
|
|
|
|
;; this will be used to generate random names later
|
|
|
|
(local birbs
|
|
(with-open [f (io.open "birbs.txt" "r")]
|
|
(icollect [line (fn [] (f:read))]
|
|
line)))
|
|
|
|
(fn table-length [tbl]
|
|
(accumulate [n 0 _ _ (pairs tbl)] (+ n 1)))
|
|
|
|
(local open-sockets {})
|
|
|
|
;; this handler contains the main logic. it is called further down in this
|
|
;; file, as soon as a websocket connection has been established.
|
|
|
|
(fn handle-websocket [ws]
|
|
(assert (ws:accept))
|
|
; connection is open; pick a random name and make sur eit is not reused
|
|
(local i (math.random (table-length birbs)))
|
|
(local name (string.lower (table.remove birbs i)))
|
|
; register this socket so other sockets can send messages to it
|
|
(tset open-sockets name ws)
|
|
(log (.. name " joined" ))
|
|
(local greeting (json.encode {:type "presence-information"
|
|
:others (- (table-length open-sockets) 1)}))
|
|
(each [_ ws (pairs open-sockets)]
|
|
(ws:send greeting))
|
|
(var closed? false)
|
|
; receive loop
|
|
(while (not closed?)
|
|
(local (data opcode) (ws:receive))
|
|
(if data
|
|
; handle incoming messages; since this is mostly a relay, we're trying
|
|
; to make sure no junk is sent around
|
|
(do
|
|
(assert (= opcode :text))
|
|
(assert (string.match data "ripple"))
|
|
(assert (< (string.len data) 1000))
|
|
(log (.. "relaying message for " name ": " data))
|
|
(each [other-name ws (pairs open-sockets)]
|
|
(when (not= name other-name)
|
|
(ws:send data))))
|
|
; connection has been closed. time for cleanup
|
|
(do
|
|
(log (.. name " left"))
|
|
(ws:close)
|
|
(tset open-sockets name nil) ; close connection
|
|
(local goodbye (json.encode {:type "presence-information"
|
|
:others (- (table-length open-sockets) 1)}))
|
|
(each [_ ws (pairs open-sockets)]
|
|
(ws:send goodbye))
|
|
(table.insert birbs name) ; name is available again
|
|
(set closed? true)))))
|
|
|
|
;; this is the low-level server code. it's an adapted version of
|
|
;; https://github.com/daurnimator/lua-http/blob/ddab2835/examples/server_hello.lua
|
|
|
|
(local server
|
|
(assert (http-server.listen {:host :localhost
|
|
:onerror (fn [server context op err errno]
|
|
(var msg (.. op " on " (tostring context) " failed"))
|
|
(when err
|
|
(set msg (.. msg ": " (tostring err))))
|
|
(assert (io.stderr:write msg "\n")))
|
|
:onstream (fn [server stream]
|
|
(let [headers (assert (stream:get_headers))
|
|
method (headers:get ":method")]
|
|
;; log request
|
|
(log (string.format "\"%s %s HTTP/%g\" \"%s\" \"%s\""
|
|
(or method "")
|
|
(or (headers:get ":path") "")
|
|
stream.connection.version
|
|
(or (headers:get :referer) "-")
|
|
(or (headers:get :user-agent) "-")))
|
|
;; start and handle websocket connection
|
|
(local ws (websocket.new_from_stream stream headers))
|
|
(if ws
|
|
(handle-websocket ws)
|
|
;; if we couldn't establish the websocket connection, something's wrong
|
|
(assert (stream:write_headers (doto (http-headers.new)
|
|
(: :append ::status :400)) true)))))
|
|
: port})))
|
|
|
|
(assert (server:listen))
|
|
|
|
(let [(_ _ bound-port) (server:localname)]
|
|
(log (.. "Now listening on port " bound-port)))
|
|
|
|
;; automatically start server when run from the command line
|
|
(when (> (length arg) 0)
|
|
(assert (server:loop)))
|
|
|
|
(comment
|
|
;; run this to handle a response manually
|
|
(for [i 1 3]
|
|
(server:step))
|
|
)
|