Browse Source

Actually handle nicknames properly, improve error & quit handling

master
eta 3 years ago
parent
commit
eb53b3c2df
  1. 2
      irc-messages.lisp
  2. 8
      ircd-registration.lisp
  3. 25
      ircd-types.lisp
  4. 84
      ircd.lisp
  5. 2
      nea.asd
  6. 1
      packages.lisp
  7. 3
      test-ircd.lisp
  8. 4
      utils.lisp

2
irc-messages.lisp

@ -2,7 +2,7 @@ @@ -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)

8
ircd-registration.lisp

@ -13,14 +13,12 @@ @@ -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 @@ @@ -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

25
ircd-types.lisp

@ -11,7 +11,9 @@ @@ -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 @@ @@ -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 @@ @@ -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 @@ @@ -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 @@ @@ -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

84
ircd.lisp

@ -2,13 +2,53 @@ @@ -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 @@ @@ -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 @@ @@ -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)

2
nea.asd

@ -1,5 +1,5 @@ @@ -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")

1
packages.lisp

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

3
test-ircd.lisp

@ -1,6 +1,3 @@ @@ -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)

4
utils.lisp

@ -36,6 +36,4 @@ @@ -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))

Loading…
Cancel
Save