|
|
|
@ -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) |
|
|
|
|