ircbot-genesis 1 (in-package #:ircbot)
ircbot-genesis 2
ircbot-genesis 3 (defvar *max-lag* 60)
ircbot-genesis 4 (defvar *ping-freq* 30)
ircbot-genesis 5
ircbot-genesis 6
ircbot-genesis 7 (defclass ircbot ()
ircbot-genesis 8 ((connection :accessor ircbot-connection :initform nil)
ircbot-multiple-c... 9 (channels :reader ircbot-channels :initarg :channels)
ircbot-genesis 10 (server :reader ircbot-server :initarg :server)
ircbot-genesis 11 (port :reader ircbot-port :initarg :port)
ircbot-genesis 12 (nick :reader ircbot-nick :initarg :nick)
ircbot-genesis 13 (password :reader ircbot-password :initarg :password)
ircbot-genesis 14 (connection-security :reader ircbot-connection-security
ircbot-genesis 15 :initarg :connection-security
ircbot-genesis 16 :initform :none)
ircbot-genesis 17 (run-thread :accessor ircbot-run-thread :initform nil)
ircbot-genesis 18 (ping-thread :accessor ircbot-ping-thread :initform nil)
ircbot-genesis 19 (lag :accessor ircbot-lag :initform nil)
ircbot-genesis 20 (lag-track :accessor ircbot-lag-track :initform nil)))
ircbot-genesis 21
ircbot-genesis 22 (defmethod ircbot-check-nick ((bot ircbot) message)
ircbot-genesis 23 (destructuring-bind (target msgtext) (arguments message)
ircbot-genesis 24 (declare (ignore msgtext))
ircbot-genesis 25 (if (string= target (ircbot-nick bot))
ircbot-genesis 26 (ircbot-nickserv-auth bot)
ircbot-genesis 27 (ircbot-nickserv-ghost bot))))
ircbot-genesis 28
ircbot-genesis 29 (defmethod ircbot-connect :around ((bot ircbot))
ircbot-genesis 30 (let ((conn (connect :nickname (ircbot-nick bot)
ircbot-genesis 31 :server (ircbot-server bot)
ircbot-genesis 32 :port (ircbot-port bot)
ircbot-genesis 33 :connection-security (ircbot-connection-security bot))))
ircbot-genesis 34 (setf (ircbot-connection bot) conn)
ircbot-genesis 35 (call-next-method)
ircbot-genesis 36 (read-message-loop conn)))
ircbot-genesis 37
ircbot-genesis 38 (defmethod ircbot-connect ((bot ircbot))
ircbot-genesis 39 (let ((conn (ircbot-connection bot)))
ircbot-genesis 40 (add-hook conn 'irc-err_nicknameinuse-message (lambda (message)
ircbot-genesis 41 (declare (ignore message))
ircbot-genesis 42 (ircbot-randomize-nick bot)))
ircbot-genesis 43 (add-hook conn 'irc-kick-message (lambda (message)
ircbot-genesis 44 (declare (ignore message))
ircbot-multiple-c... 45 (map nil
ircbot-multiple-c... 46 (lambda (c) (join (ircbot-connection bot) c))
ircbot-multiple-c... 47 (ircbot-channels bot))))
ircbot-genesis 48 (add-hook conn 'irc-notice-message (lambda (message)
ircbot-genesis 49 (ircbot-handle-nickserv bot message)))
ircbot-genesis 50 (add-hook conn 'irc-pong-message (lambda (message)
ircbot-genesis 51 (ircbot-handle-pong bot message)))
ircbot-genesis 52 (add-hook conn 'irc-rpl_welcome-message (lambda (message)
ircbot-genesis 53 (ircbot-start-ping-thread bot)
ircbot-genesis 54 (ircbot-check-nick bot message)))))
ircbot-genesis 55
ircbot-genesis 56 (defmethod ircbot-connect-thread ((bot ircbot))
ircbot-genesis 57 (setf (ircbot-run-thread bot)
ircbot-genesis 58 (sb-thread:make-thread (lambda () (ircbot-connect bot))
ircbot-genesis 59 :name "ircbot-run")))
ircbot-genesis 60
ircbot-genesis 61 (defmethod ircbot-disconnect ((bot ircbot) &optional (quit-msg "..."))
ircbot-genesis 62 (sb-sys:without-interrupts
ircbot-genesis 63 (quit (ircbot-connection bot) quit-msg)
ircbot-genesis 64 (setf (ircbot-lag-track bot) nil)
ircbot-genesis 65 (setf (ircbot-connection bot) nil)
ircbot-genesis 66 (if (not (null (ircbot-run-thread bot)))
ircbot-genesis 67 (sb-thread:terminate-thread (ircbot-run-thread bot)))
ircbot-genesis 68 (sb-thread:terminate-thread (ircbot-ping-thread bot))))
ircbot-genesis 69
ircbot-genesis 70 (defmethod ircbot-reconnect ((bot ircbot) &optional (quit-msg "..."))
ircbot-genesis 71 (let ((threaded-p (not (null (ircbot-run-thread bot)))))
ircbot-genesis 72 (ircbot-disconnect bot quit-msg)
ircbot-genesis 73 (if threaded-p
ircbot-genesis 74 (ircbot-connect-thread bot)
ircbot-genesis 75 (ircbot-connect bot))))
ircbot-genesis 76
ircbot-genesis 77 (defmethod ircbot-handle-nickserv ((bot ircbot) message)
ircbot-genesis 78 (let ((conn (ircbot-connection bot)))
ircbot-genesis 79 (if (string= (host message) "services.")
ircbot-genesis 80 (destructuring-bind (target msgtext) (arguments message)
ircbot-genesis 81 (declare (ignore target))
ircbot-genesis 82 (cond ((string= msgtext "This nickname is registered. Please choose a different nickname, or identify via /msg NickServ identify <password>.")
ircbot-genesis 83 (ircbot-nickserv-auth bot))
ircbot-genesis 84 ((string= msgtext (format nil "~A has been ghosted." (ircbot-nick bot)))
ircbot-genesis 85 (nick conn (ircbot-nick bot)))
ircbot-genesis 86 ((string= msgtext (format nil "~A is not online." (ircbot-nick bot)))
ircbot-genesis 87 (ircbot-nickserv-auth bot))
ircbot-genesis 88 ((string= msgtext (format nil "You are now identified for ~A." (ircbot-nick bot)))
ircbot-multiple-c... 89 (map nil (lambda (c) (join conn c)) (ircbot-channels bot))))))))
ircbot-genesis 90
ircbot-genesis 91 (defmethod ircbot-handle-pong ((bot ircbot) message)
ircbot-genesis 92 (destructuring-bind (server ping) (arguments message)
ircbot-genesis 93 (declare (ignore server))
ircbot-genesis 94 (let ((response (ignore-errors (parse-integer ping))))
ircbot-genesis 95 (when response
ircbot-genesis 96 (setf (ircbot-lag-track bot) (delete response (ircbot-lag-track bot) :test #'=))
ircbot-genesis 97 (setf (ircbot-lag bot) (- (received-time message) response))))))
ircbot-genesis 98
ircbot-genesis 99 (defmethod ircbot-nickserv-auth ((bot ircbot))
ircbot-genesis 100 (privmsg (ircbot-connection bot) "NickServ"
ircbot-genesis 101 (format nil "identify ~A" (ircbot-password bot))))
ircbot-genesis 102
ircbot-genesis 103 (defmethod ircbot-nickserv-ghost ((bot ircbot))
ircbot-genesis 104 (privmsg (ircbot-connection bot) "NickServ"
ircbot-genesis 105 (format nil "ghost ~A ~A" (ircbot-nick bot) (ircbot-password bot))))
ircbot-genesis 106
ircbot-genesis 107 (defmethod ircbot-randomize-nick ((bot ircbot))
ircbot-genesis 108 (nick (ircbot-connection bot)
ircbot-genesis 109 (format nil "~A-~A" (ircbot-nick bot) (+ (random 90000) 10000))))
ircbot-genesis 110
ircbot-genesis 111 (defmethod ircbot-send-message ((bot ircbot) target message-text)
ircbot-genesis 112 (privmsg (ircbot-connection bot) target message-text))
ircbot-genesis 113
ircbot-genesis 114 (defmethod ircbot-start-ping-thread ((bot ircbot))
ircbot-genesis 115 (let ((conn (ircbot-connection bot)))
ircbot-genesis 116 (setf (ircbot-ping-thread bot)
ircbot-genesis 117 (sb-thread:make-thread
ircbot-genesis 118 (lambda ()
ircbot-genesis 119 (loop
ircbot-genesis 120 do (progn (sleep *ping-freq*)
ircbot-genesis 121 (let ((ct (get-universal-time)))
ircbot-genesis 122 (push ct (ircbot-lag-track bot))
ircbot-genesis 123 (ping conn (princ-to-string ct))))
ircbot-genesis 124 until (ircbot-timed-out-p bot))
ircbot-genesis 125 (ircbot-reconnect bot))
ircbot-genesis 126 :name "ircbot-ping"))))
ircbot-genesis 127
ircbot-genesis 128 (defmethod ircbot-timed-out-p ((bot ircbot))
ircbot-genesis 129 (loop
ircbot-genesis 130 with ct = (get-universal-time)
ircbot-genesis 131 for v in (ircbot-lag-track bot)
ircbot-genesis 132 when (> (- ct v) *max-lag*)
ircbot-genesis 133 do (return t)))
ircbot-genesis 134
ircbot-genesis 135
ircbot-genesis 136 (defun make-ircbot (server port nick password channel)
ircbot-genesis 137 (make-instance 'ircbot
ircbot-genesis 138 :server server
ircbot-genesis 139 :port port
ircbot-genesis 140 :nick nick
ircbot-genesis 141 :password password
ircbot-genesis 142 :channel channel))