README.md

@@ -29,18 +29,15 @@ This developement is known to work on Racket v7.5 with packages:
 Build it with `raco make main.rkt` and run `racket main.rkt`.
 Or: build native with `raco exe main.rkt`.
 
-# TODOs
-
-- Support for the user list. Specifically:
-    + Handle WHO better
-    + Handle nickname changes (via the /nick command)
-    TODO: so far we only handle nickname changes *incoming* from movie night
-- Better handling of error messages. E.g. in case of an invalid
-  nickname, return the ERR_ and kill the connection to the client
-- Handle /me actions
-- Unfuck the HTML -- this is somewhat working, see unheck-html.rkt
-- TESTS!!11
-
+# Known issues
+
+- Nick change is not implemented in the ircd
+- Nick collisions are handled weirdly: the ircd will send you a notice
+  but won't change your nickname.
+- /me actions are not handeled
+- Bans from the MovieNight chat are not handled
+- HTML is not entierly unfucked, although this is somewhat working;
+  see unheck-html.rkt.
 
 # Reading
 

ircd.rkt

@@ -6,9 +6,11 @@
          (prefix-in movie-night: "chat.rkt"))
 (provide (all-defined-out))
 
-
+;; Each channel a user joins is associated with a WS connection
 (define movie-night-ws-url (make-parameter "wss://stream.ihatebeinga.live/ws"))
 
+(define-type Channel-List (Listof (Pairof String WS)))
+
 (: users (Listof String))
 (define users '())
 
@@ -44,9 +46,11 @@
     ;; other connections
     (thread
      (lambda ()
+       ;; TODO: custodian should be part of irc-connection
        (define user-conn (accept-irc-connection in out cust))
+       (define channels '())
        (thread (lambda ()
-          (handle-user-messages user-conn cust)))))))
+          (handle-user-messages user-conn channels cust)))))))
   
 ;; When we accept a new IRC connection we need to do several things:
 ;; 1. Receive the user nick/user information
@@ -74,29 +78,9 @@
 
   (file-stream-buffer-mode out 'line)
 
-  ;; TODO:
-  ;; Defining ws-c and conn simulateneously like that is asking for trouble
-  ;; inb4 a race condition
-  (: ws-c WS)
-  (define ws-c
-    (movie-night:make-connection
-       (movie-night-ws-url)
-       nick
-       #:on-join (lambda ([n : String]) (on-join conn n))
-       #:on-leave (lambda ([n : String]) (on-leave conn n))
-       #:on-name-change (lambda ([n1 : String] [n2 : String])
-                          (on-name-change conn n1 n2))
-       #:on-users (lambda ([l : (Listof String)])
-                    (set! users l) (notify-users conn))
-       #:on-chat (lambda ([from : String] [msg : String])
-                   (on-chat conn from msg))
-       #:on-response (lambda ([msg : String]) (on-response conn msg))
-       #:on-notify (lambda ([msg : String]) (on-response conn msg))
-       #:on-topic (lambda ([topic : String]) (on-topic conn topic))
-       #:on-close-conn (lambda () (custodian-shutdown-all cust))))
   (: conn irc-connection)
-  (define conn (irc-connection in out nick user ws-c))
-  ;;(set-irc-connection-ws-conn! conn ws-c)
+  (define conn (irc-connection in out nick user))
+
   (welcome-user conn)
   (void (thread (lambda () (ping-pong-thread conn))))
   conn)
@@ -186,10 +170,13 @@
 ;;     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)
+;; XXX this is a galaxy brain version of making sure that the connection stays alive
+;; ideally this should be rewritten
+(: handle-user-messages (-> irc-connection Channel-List Custodian Nothing))
+(define (handle-user-messages conn channels custodian)
   (define nick (irc-connection-nick conn))
   (define msg (read-from-client conn #:timeout 333))
+  (log-info (format "Raw irc-message: ~a" msg))
   (match msg
     [(irc-message _ "PING" (list ping))
      (send-to-client conn
@@ -202,26 +189,14 @@
     [(irc-message _ "NICK" params)
      ;; TODO: propagate this info along the WS
      (set-irc-connection-nick! conn (car params))]
+    ;; TODO: implement PART as well
     [(irc-message _ "JOIN" (list chan))
-     #:when (equal? chan channel)
-     (define c (irc-connection-ws-conn conn))
-     (ws:send-join c (irc-connection-nick conn) "#00FFAA")
-
-     (send-to-client conn (irc-message
-                           (format "~a!~a@lolcathost"
-                                   (irc-connection-nick conn)
-                                   (irc-connection-user conn))
-                           "JOIN"
-                           (list channel)))
-     (send-to-client conn (irc-message
-                           ":lolcathost"
-                           RPL_TOPIC
-                           (list nick channel ":chatting hard")))
-
-     (sleep 1.5) ;; is there a way around going to sleep? :-<
-     (ws:send-users c)]
+     #:when (and (equal? chan channel)
+                 (not (member chan channels)))
+     (define ws (join-new-channel conn chan custodian))
+     (set! channels (cons (cons chan ws) channels))]
     [(irc-message _ "MODE" (cons chan _))
-     #:when (equal? chan channel)
+     #:when (channel-joined? chan channels)
      (send-to-client conn (irc-message
                            ":lolcathost"
                            RPL_CHANNELMODEIS
@@ -233,7 +208,7 @@
                            (list nick " /list not implemented ")))
      ]
     [(irc-message _ "WHO" (list chan))
-     #:when (equal? chan channel)
+     #:when (channel-joined? chan channels)
      (send-to-client conn (irc-message
                            ":lolcathost"
                            RPL_WHOREPLY
@@ -262,10 +237,12 @@
                            RPL_ENDOFWHOIS
                            (list nick target ":End of /WHOIS list")))]
     [(irc-message _ "PRIVMSG" (list chan msg))
-     #:when (equal? chan channel)
-     (send-ws-message conn msg)]
-    [(irc-message _ "STATS" '())
-     (send-ws-message conn "/STATS")]
+     (define ws (lookup-ws-conn channels chan))
+     (when ws
+       (ws:send-message ws msg))]
+    ;; TODO imlement STATS again
+    ;; [(irc-message _ "STATS" '())
+    ;;  (send-ws-message conn "/STATS")]
     [(irc-message _ "MOTD" _)
      (send-to-client conn (irc-message
                            ":lolcathost"
@@ -289,13 +266,55 @@
      (void)]
     [(var msg)
      (log-warning (format "ircd.rkt/handle-user-message: unknown message: ~a" msg))])
-  (handle-user-messages conn custodian))
+  (handle-user-messages conn channels custodian))
+
+(: join-new-channel (-> irc-connection String Custodian WS))
+(define (join-new-channel conn channel-name cust)
+  (: ws-c WS)
+  (define ws-c
+    (movie-night:make-connection
+     (movie-night-ws-url)
+     (irc-connection-nick conn)
+     #:on-join (lambda ([n : String]) (on-join conn n))
+     #:on-leave (lambda ([n : String]) (on-leave conn n))
+     #:on-name-change (lambda ([n1 : String] [n2 : String])
+                        (on-name-change conn n1 n2))
+     #:on-users (lambda ([l : (Listof String)])
+                  (set! users l) (notify-users conn))
+     #:on-chat (lambda ([from : String] [msg : String])
+                 (on-chat conn from msg))
+     #:on-response (lambda ([msg : String]) (on-response conn msg))
+     #:on-notify (lambda ([msg : String]) (on-response conn msg))
+     #:on-topic (lambda ([topic : String]) (on-topic conn topic))
+     #:on-close-conn (lambda () (custodian-shutdown-all cust))))
+  
+  (ws:send-join ws-c (irc-connection-nick conn) "#00FFAA")
+  
+  (send-to-client conn (irc-message
+                        (format "~a!~a@lolcathost"
+                                (irc-connection-nick conn)
+                                (irc-connection-user conn))
+                        "JOIN"
+                        (list channel)))
+  (send-to-client conn (irc-message
+                        ":lolcathost"
+                        RPL_TOPIC
+                        (list (irc-connection-nick conn) channel ":chatting hard")))
+  
+  (sleep 1.5) ;; is there a way around going to sleep? :-<
+  (ws:send-users ws-c)
+  ws-c)
 
 
 ;; Utils
-(: send-ws-message (-> irc-connection String Void))
-(define (send-ws-message conn msg)
-  (ws:send-message (irc-connection-ws-conn conn) msg))
+(: lookup-ws-conn (-> Channel-List String (U WS False)))
+(define (lookup-ws-conn ls x)
+  (define v (assoc x ls))
+  (and v (cdr v)))
+
+(: channel-joined? (-> String Channel-List Boolean))
+(define (channel-joined? x channels)
+  (if (assoc x channels) #t #f))
 
 (: welcome-user (-> irc-connection Void))
 (define (welcome-user conn)

private/irc-functions.rkt

@@ -2,7 +2,6 @@
 ;; A bunch of code in this file was copied from the irc package
 ;; (c) Jonathan Schuster
 (provide (all-defined-out))
-(require "ws-typed.rkt")
 
 ;; :prefix command params crlf
 (struct irc-message ([prefix : (U False String)]
@@ -13,8 +12,7 @@
 (struct irc-connection ([in : Input-Port]
                         [out : Output-Port]
                         [nick : String]
-                        [user : String]
-                        [ws-conn : WS])
+                        [user : String])
   #:mutable)
 
 (: send-to-client (-> irc-connection irc-message Void))