README.md

@@ -17,10 +17,9 @@ The command line option `--url` specifies the URL for the MovieNight chat server
 To produce logs set the env variables PLTSTDOUT or PLTSTDERR to "warning" or "info".
 See the [Racket docs on loggers](https://docs.racket-lang.org/reference/logging.html) for details.
 
+## Special commands
 
-# Prebuilt binaries
-
-Coming soon...
+- `/STATS` provide some basic statistics about the stream
 
 # Requirements & building
 

chat.rkt

@@ -1,7 +1,8 @@
 #lang typed/racket
 (provide (all-defined-out))
 (require/typed "unheck-html.rkt"
-  [unheck-html (-> String String)])
+  [unheck-html (-> String String)]
+  [unheck-all-html (-> String String)])
 (require typed/net/url
          "private/ws-typed.rkt" ;; web sockets
          typed/json
@@ -58,7 +59,7 @@
                      [(chat-message message from color type)
                       (match type
                         ['chat (on-chat from (unheck-html message))]
-                        ['response (on-response (unheck-html message))]
+                        ['response (on-response (unheck-all-html message))]
                         [_
                          (log-warning
                           (format "chat.rkt/handl-evt: cannot handle message type in ~s" msg))])]))]

ircd.rkt

@@ -17,10 +17,10 @@
 ;; Main entry point
 ;; Returns the main server loop thread (for synchronizing) and
 ;; a function for killing the server.
-(: serve (->* (#:port Integer #:hostname (U False String))
-              ()
+(: serve (->* ()
+              (#:port Integer #:hostname (U False String))
               (Values Thread (-> Void))))
-(define (serve #:port port-no #:hostname host)
+(define (serve #:port [port-no 6667] #:hostname [host #f])
   (define serve-cust (make-custodian))
   (parameterize ([current-custodian serve-cust])
     (define listener (tcp-listen port-no 5 #t host))
@@ -48,7 +48,12 @@
        (thread (lambda ()
           (handle-user-messages user-conn cust)))))))
   
-
+;; When we accept a new IRC connection we need to do several things:
+;; 1. Receive the user nick/user information
+;; 2. Prepare the IO ports
+;; 3. Create a new WebSocket connection through chat.rkt
+;; 4. Set up a ping thread
+;; 5. Send the MOTD to the user
 (: accept-irc-connection (-> Input-Port Output-Port Custodian irc-connection))
 (define (accept-irc-connection in out cust)
   (define nick
@@ -93,8 +98,19 @@
   (define conn (irc-connection in out nick user ws-c))
   ;;(set-irc-connection-ws-conn! conn ws-c)
   (welcome-user conn)
+  (void (thread (lambda () (ping-pong-thread conn))))
   conn)
 
+
+(: ping-pong-thread (-> irc-connection Void))
+(define (ping-pong-thread conn)
+  (sleep 120)
+  (send-to-client conn (irc-message
+                        ":lolcathost"
+                        "PING"
+                        '("fffffffffffffffffffffff")))
+  (ping-pong-thread conn))
+
 ;; Callbacks for the MoveNight chat api
 
 (: notify-users (-> irc-connection Void))
@@ -166,10 +182,14 @@
 ;; The loop for handling commands from the client
 
 ;; return type is Nothing ==> the function does not terminate
+;; NB: we read from the client with the timeout
+;;     of 333 > the frequency of PINGs
+;;     so the client should respond to the PING within
+;;     some number of seconds in order to keep the connection alive
 (: handle-user-messages (-> irc-connection Custodian Nothing))
 (define (handle-user-messages conn custodian)
   (define nick (irc-connection-nick conn))
-  (define msg (read-from-client conn))
+  (define msg (read-from-client conn #:timeout 333))
   (match msg
     [(irc-message _ "PING" (list ping))
      (send-to-client conn
@@ -177,6 +197,8 @@
                                   "PONG"
                                   (list "lolcathost"
                                         (string-append ":" ping))))]
+    [(irc-message _ "PONG" (list pong))
+     (void)]
     [(irc-message _ "NICK" params)
      ;; TODO: propagate this info along the WS
      (set-irc-connection-nick! conn (car params))]
@@ -242,15 +264,17 @@
     [(irc-message _ "PRIVMSG" (list chan msg))
      #:when (equal? chan channel)
      (send-ws-message conn msg)]
+    [(irc-message _ "STATS" '())
+     (send-ws-message conn "/STATS")]
     [(or (? eof-object?)
          (irc-message _ "QUIT" _))
-     ;; TODO remove from the user list
      ;; somehow attach this to a custodian?
-     (log-info (format "Closing socket for ~a" (irc-connection-nick conn)))
+     (log-warning (format "ircd.rkt: Closing socket for ~a" (irc-connection-nick conn)))
      (custodian-shutdown-all custodian)]
-    [#f (void)]
+    [#f ;;; were unable to parse the string correctly
+     (void)]
     [(var msg)
-     (log-warning (format "handle-user-message: unknown message: ~a" msg))])
+     (log-warning (format "ircd.rkt/handle-user-message: unknown message: ~a" msg))])
   (handle-user-messages conn custodian))
 
 
@@ -268,7 +292,8 @@
                     (irc-message "lolcathost" "002" (list nick msg))))
   ;; "001" has to be a string, otherwise it's converted to 1
   (send-to-client conn (irc-message "lolcathost" "001" (list nick "[OwO]")))
-  (notify-nick ":[Mar 2020] NEW! bug fixes (erc support), displaying correct topic")
+  (notify-nick ":[Mar 2020] NEW! /STATS command & timeouts for broken connections")
+  (notify-nick ":[Mar 2020] bug fixes (erc support), displaying correct topic")
   (notify-nick ":[Feb 2020] support for HexChat, JOIN & PARTs, html encoding of symbols")
   (notify-nick ":-----------------------------------------------------------------------------")
   (notify-nick ":If you encounter an error, try reconnecting!")

private/irc-functions.rkt

@@ -5,7 +5,7 @@
 (require "ws-typed.rkt")
 
 ;; :prefix command params crlf
-(struct irc-message ([prefix : String]
+(struct irc-message ([prefix : (U False String)]
                      ;; XXX: just Positive-Integer?
                      [command : (U Positive-Integer String)]
                      [params : (Listof String)])
@@ -47,9 +47,15 @@
             (parse-message line)
             eof))))
 
-(: read-from-client (-> irc-connection (U irc-message False EOF)))
-(define (read-from-client conn)
-  (read-from-input-port (irc-connection-in conn)))
+(: read-from-client (->* (irc-connection)
+                         (#:timeout (U False Nonnegative-Real))
+                         (U irc-message False EOF)))
+(define (read-from-client conn #:timeout [timeout #f])
+  (define in-port (irc-connection-in conn))
+  (if (and timeout (not (sync/timeout timeout in-port)))
+      ;; if the timeout was triggered
+      eof   ;; return eof so that the caller closes teh connection
+      (read-from-input-port in-port)))
 
 
 ;; Given the string of an IRC message, returns an irc-message that has been parsed as far as possible,
@@ -64,7 +70,7 @@
   (cond [(> (length parts) (if prefix 1 0))
          (define command (list-ref parts (if prefix 1 0)))
          (define param-parts (list-tail parts (if prefix 2 1)))
-         (irc-message (or prefix "") command (parse-params param-parts))]
+         (irc-message prefix (string-upcase command) (parse-params param-parts))]
         [(empty? parts) #f ;; the message is entirely empty
                         ;; don't log this as a warning
                         ;; this happens on erc because it ends messages

unheck-html.rkt

@@ -1,5 +1,7 @@
 #lang racket
-(provide unheck-html)
+(provide unheck-html unheck-all-html)
+(require (prefix-in h: html)
+         (prefix-in x: xml))
 
 ;; copied from somewhere tbh
 
@@ -30,3 +32,29 @@
              (string-append "&" mtch)))]))
   (regexp-replace* #px"&(#?[\\w\\d]+);?" str unheck))
 
+;; TODO: use this instead of unheck-html
+(define (unheck-all-html str)
+  (let* ([html (h:read-html (open-input-string str))]
+         [contents (extract-pcdata html)])
+    (string-join contents " ")))
+
+;; copied from the html-lib example
+; extract-pcdata: html-content/c -> (listof string)
+; Pulls out the pcdata strings from some-content.
+(define (extract-pcdata some-content)
+  (cond [(x:pcdata? some-content)
+         (list (x:pcdata-string some-content))]
+        [(x:entity? some-content)
+         (list)]
+        [else
+         (extract-pcdata-from-element some-content)]))
+
+; extract-pcdata-from-element: html-element -> (listof string)
+; Pulls out the pcdata strings from an-html-element.
+(define (extract-pcdata-from-element an-html-element)
+  (match an-html-element
+    [(struct h:html-full (attributes content))
+     (apply append (map extract-pcdata content))]
+    
+    [(struct h:html-element (attributes))
+     '()]))