Actually handle nicknames properly, improve error & quit handling

irc-messages.lisp

@@ -2,7 +2,7 @@
 
 (in-package :nea/irc)
 
-(defvar *numeric-regex* "[0-9]+")
+(defparameter *numeric-regex* (create-scanner "[0-9]+"))
 
 ; Slightly stolen from protocol.lisp in cl-irc...
 (eval-when (:compile-toplevel :load-toplevel :execute)

ircd-registration.lisp

@@ -13,14 +13,12 @@
   (server-to-user
     c
     (make-irc-message (find-numeric 'err-notregistered)
-		      :params '("You have not registered")
-		      :lax t)))
+		      :params '("You have not registered"))))
 
 ; Basic IRC protocol registration stuff
 
 (defmethod handle-registration-message ((c unregistered-irc-client) (msg msg-nick))
-  ; FIXME: check nickname is actually valid
-  (setf (reginfo-nick (client-reginfo c)) (first (message-parameters msg))))
+  (claim-nickname c (first (message-parameters msg))))
 
 (defmethod handle-registration-message ((c unregistered-irc-client) (msg msg-user))
   (with-accessors
@@ -58,7 +56,7 @@
 (defmethod handle-registration-message ((c unregistered-irc-client) (msg msg-cap-end))
   (push 'end (reginfo-capabs (client-reginfo c))))
 
-(defvar *client-registration-wall-o-text*
+(defparameter *client-registration-wall-o-text*
   (mapcar
     (lambda (args) (apply #'make-irc-message args))
     (list

ircd-types.lisp

@@ -11,7 +11,9 @@
 (defparameter *irc-numerics*
   '((err-notregistered "451")
     (err-needmoreparams "461")
-    (err-unknowncommand "421"))
+    (err-unknowncommand "421")
+    (err-nicknameinuse "433")
+    (err-erroneousnickname "432"))
   "Map of IRC human-readable numeric names to numerics.")
 
 (defun find-numeric (name)
@@ -39,7 +41,10 @@
   (make-instance 'reginfo))
 
 (defclass irc-client ()
-  ((socket
+  ((uid
+     :initarg :uid
+     :reader client-uid)
+   (socket
      :initarg :socket)
    (address
      :initarg :address)
@@ -66,6 +71,7 @@
     (with-lock-held (wl) (write-irc-message msg (socket-stream sock)))))
 
 (defgeneric server-to-user (client msg))
+(defgeneric claim-nickname (client nick))
 
 (defun server-message (client msg)
   (write-irc-message
@@ -74,6 +80,14 @@
       (make-irc-message-source *server-name*))
     client))
 
+(defun make-client-source (client)
+  (with-accessors
+    ((n reginfo-nick) (u reginfo-username)) client
+  (make-irc-message-source
+    (format nil "~A" (slot-value client 'address))
+    :nick n
+    :user u)))
+
 (defmethod server-to-user ((client irc-client) (msg irc-message))
   (server-message client msg))
 
@@ -94,9 +108,16 @@
 (defmethod server-to-user ((client registered-irc-client) (msg irc-message))
   (call-next-method client (cons-onto-params (reginfo-nick (client-reginfo client)) msg)))
 
+(defvar *client-number* 0
+  "Monotonically incrementing client ID number")
+
+(defun make-client-uid ()
+  (incf *client-number*))
+
 (defun make-irc-client (sock)
   (let ((rl (make-lock)) (wl (make-lock)))
     (make-instance 'unregistered-irc-client
+		   :uid (make-client-uid)
                    :socket sock
                    :address (get-peer-address sock)
                    :socket-reader-lock rl

ircd.lisp

@@ -2,13 +2,53 @@
 
 (in-package :nea/ircd)
 
+(defvar *clients* (make-hash-table)
+  "A table of clients, indexed by their client UID.")
+(defvar *clients-lock* (make-lock))
+(defvar *nicknames* (make-hash-table :test #'equal)
+  "A map of nicknames => client UIDs.")
+(defvar *nicknames-lock* (make-lock))
+
+(defparameter *nickname-regex* (create-scanner "[A-Za-z][A-Za-z0-9\[\]\|\{\}]*"))
+
 (defgeneric handle-irc-message (client msg))
 (defgeneric handle-parse-condition (client condit))
-(defgeneric handle-quit (client))
+(defgeneric handle-quit (client reason))
+
+(defmethod claim-nickname ((client irc-client) (nick string))
+  (if (scan *nickname-regex* nick)
+    (with-lock-held
+      (*nicknames-lock*)
+      (let ((nickuid (gethash nick *nicknames*)))
+	(if nickuid
+	  (progn
+	    (server-to-user
+	      client
+	      (make-irc-message (find-numeric 'err-nicknameinuse)
+				:params (list nick "Nickname in use")))
+	    nil)
+	  (progn
+	    (remhash (reginfo-nick (client-reginfo client)) *nicknames*)
+	    (setf (gethash nick *nicknames*) (slot-value client 'uid))
+	    (setf (reginfo-nick (client-reginfo client)) nick)
+	    (unless (typep client (find-class 'unregistered-irc-client))
+	      (write-irc-message
+		(with-irc-source
+		  (make-irc-message "NICK" :params (list nick))
+		  (make-client-source client))
+		client))
+	    t))))
+    (progn
+      (server-to-user
+	client
+	(make-irc-message (find-numeric 'err-erroneousnickname)
+			  :params (list nick "Erroneous nickname")))
+      nil)))
 
 (defun graduate-client (c)
   (format t "Client at ~A registered~%" (slot-value c 'address))
   (change-class c 'registered-irc-client)
+  (setf (gethash (client-uid c) *clients*) c)
   (mapcar
     (lambda (msg) (server-to-user c msg))
     *client-registration-wall-o-text*))
@@ -19,14 +59,21 @@
 (defmethod handle-irc-message :after ((c irc-client) msg)
   (force-output (socket-stream (slot-value c 'socket))))
 
-(defmethod handle-quit :after ((c irc-client))
-  (server-message
-    c
-    (make-irc-message "ERROR"
-		      :params '("Closing link after QUIT")))
-  (socket-close (slot-value c 'socket)))
+(defmethod handle-quit :after ((c irc-client) reason)
+  (format t "Client at ~A quit: ~A~%" (slot-value c 'address) reason)
+  (ignore-errors
+    (server-message
+      c
+      (make-irc-message "ERROR"
+			:params (cons (or reason "Closing link after QUIT") nil)))
+    (socket-close (slot-value c 'socket)))
+  (when (typep c (find-class 'registered-irc-client))
+    (with-lock-held (*clients-lock*) (remhash (client-uid c) *clients*)))
+  (let ((nick (reginfo-nick (client-reginfo c))))
+    (when nick
+      (with-lock-held (*nicknames-lock*) (remhash nick *nicknames*)))))
 
-(defmethod handle-quit ((c irc-client)) ())
+(defmethod handle-quit ((c irc-client) reason) ())
 
 (defmethod handle-parse-condition ((c irc-client) (e invalid-arguments))
   (server-message
@@ -59,23 +106,24 @@
   (handler-case
     (loop do 
 	  (handler-case
-	    (let* ((message (read-irc-message client)))
+	    (let ((message 
+		    (handler-case (read-irc-message client)
+		      (invalid-arguments (c) (handle-parse-condition client c))
+		      (invalid-command-name (c) (handle-parse-condition client c)))))
 	      (when (equal (message-command message) "QUIT")
-		(handle-quit client)
+		(handle-quit client "Client Quit")
 		(return))
 	      (handle-irc-message client message))
-	    (invalid-arguments (c) (handle-parse-condition client c))
-	    (invalid-command-name (c) (handle-parse-condition client c))))
-    (end-of-file () nil)))
+	    (end-of-file () (handle-quit client "End of file"))))))
 
 (defun irc-listen (host port)
   (let ((master-socket (socket-listen host port
-                                      :reuse-address t)))
+				      :reuse-address t)))
     (loop do (let* ((sock (socket-accept master-socket))
-                    (client (make-irc-client sock)))
-               (make-thread
-                 (lambda ()
-                   (irc-client-thread client)))))))
+		    (client (make-irc-client sock)))
+	       (make-thread
+		 (lambda ()
+		   (irc-client-thread client)))))))
 
 (defun start-ircd (&optional (host *listen-host*) (port *listen-port*))
   (format t "Starting server on ~A, port ~A...~%" host port)

nea.asd

@@ -1,5 +1,5 @@
 (defsystem "nea"
-  :depends-on ("usocket" "bordeaux-threads" "uiop")
+  :depends-on ("usocket" "bordeaux-threads" "uiop" "cl-ppcre")
   :serial t
   :components
   ((:file "packages")

packages.lisp

@@ -45,6 +45,7 @@
         :nea/irc
         :nea/utils
         :usocket
+	:cl-ppcre
         :bordeaux-threads))
 
 

test-ircd.lisp

@@ -1,6 +1,3 @@
-(ql:quickload "cl-ppcre")
-(ql:quickload "bordeaux-threads")
-(ql:quickload "usocket")
 (asdf:load-system "nea")
 (in-package :nea/ircd)
 (sb-thread:release-foreground)

utils.lisp

@@ -36,6 +36,4 @@
 
 (defun join-by-spaces (arr)
   "Joins ARR with spaces, returning the result as a string."
-  (let ((s (make-string-output-stream)))
-    (format s "~{~A~^ ~}" arr)
-    (get-output-stream-string s)))
+  (format nil "~{~A~^ ~}" arr))