Add lua-based server implementation

lua-server/server.fnl

@@ -0,0 +1,112 @@
+;; 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))
+  )