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-genesis 9 (channel :reader ircbot-channel :initarg :channel)
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-genesis 45 (join (ircbot-connection bot)
ircbot-genesis 46 (ircbot-channel bot))))
ircbot-genesis 47 (add-hook conn 'irc-notice-message (lambda (message)
ircbot-genesis 48 (ircbot-handle-nickserv bot message)))
ircbot-genesis 49 (add-hook conn 'irc-pong-message (lambda (message)
ircbot-genesis 50 (ircbot-handle-pong bot message)))
ircbot-genesis 51 (add-hook conn 'irc-rpl_welcome-message (lambda (message)
ircbot-genesis 52 (ircbot-start-ping-thread bot)
ircbot-genesis 53 (ircbot-check-nick bot message)))))
ircbot-genesis 54
ircbot-genesis 55 (defmethod ircbot-connect-thread ((bot ircbot))
ircbot-genesis 56 (setf (ircbot-run-thread bot)
ircbot-genesis 57 (sb-thread:make-thread (lambda () (ircbot-connect bot))
ircbot-genesis 58 :name "ircbot-run")))
ircbot-genesis 59
ircbot-genesis 60 (defmethod ircbot-disconnect ((bot ircbot) &optional (quit-msg "..."))
ircbot-genesis 61 (sb-sys:without-interrupts
ircbot-genesis 62 (quit (ircbot-connection bot) quit-msg)
ircbot-genesis 63 (setf (ircbot-lag-track bot) nil)
ircbot-genesis 64 (setf (ircbot-connection bot) nil)
ircbot-genesis 65 (if (not (null (ircbot-run-thread bot)))
ircbot-genesis 66 (sb-thread:terminate-thread (ircbot-run-thread bot)))
ircbot-genesis 67 (sb-thread:terminate-thread (ircbot-ping-thread bot))))
ircbot-genesis 68
ircbot-genesis 69 (defmethod ircbot-reconnect ((bot ircbot) &optional (quit-msg "..."))
ircbot-genesis 70 (let ((threaded-p (not (null (ircbot-run-thread bot)))))
ircbot-genesis 71 (ircbot-disconnect bot quit-msg)
ircbot-genesis 72 (if threaded-p
ircbot-genesis 73 (ircbot-connect-thread bot)
ircbot-genesis 74 (ircbot-connect bot))))
ircbot-genesis 75
ircbot-genesis 76 (defmethod ircbot-handle-nickserv ((bot ircbot) message)
ircbot-genesis 77 (let ((conn (ircbot-connection bot)))
ircbot-genesis 78 (if (string= (host message) "services.")
ircbot-genesis 79 (destructuring-bind (target msgtext) (arguments message)
ircbot-genesis 80 (declare (ignore target))
ircbot-genesis 81 (cond ((string= msgtext "This nickname is registered. Please choose a different nickname, or identify via /msg NickServ identify <password>.")
ircbot-genesis 82 (ircbot-nickserv-auth bot))
ircbot-genesis 83 ((string= msgtext (format nil "~A has been ghosted." (ircbot-nick bot)))
ircbot-genesis 84 (nick conn (ircbot-nick bot)))
ircbot-genesis 85 ((string= msgtext (format nil "~A is not online." (ircbot-nick bot)))
ircbot-genesis 86 (ircbot-nickserv-auth bot))
ircbot-genesis 87 ((string= msgtext (format nil "You are now identified for ~A." (ircbot-nick bot)))
ircbot-genesis 88 (join conn (ircbot-channel bot))))))))
ircbot-genesis 89
ircbot-genesis 90 (defmethod ircbot-handle-pong ((bot ircbot) message)
ircbot-genesis 91 (destructuring-bind (server ping) (arguments message)
ircbot-genesis 92 (declare (ignore server))
ircbot-genesis 93 (let ((response (ignore-errors (parse-integer ping))))
ircbot-genesis 94 (when response
ircbot-genesis 95 (setf (ircbot-lag-track bot) (delete response (ircbot-lag-track bot) :test #'=))
ircbot-genesis 96 (setf (ircbot-lag bot) (- (received-time message) response))))))
ircbot-genesis 97
ircbot-genesis 98 (defmethod ircbot-nickserv-auth ((bot ircbot))
ircbot-genesis 99 (privmsg (ircbot-connection bot) "NickServ"
ircbot-genesis 100 (format nil "identify ~A" (ircbot-password bot))))
ircbot-genesis 101
ircbot-genesis 102 (defmethod ircbot-nickserv-ghost ((bot ircbot))
ircbot-genesis 103 (privmsg (ircbot-connection bot) "NickServ"
ircbot-genesis 104 (format nil "ghost ~A ~A" (ircbot-nick bot) (ircbot-password bot))))
ircbot-genesis 105
ircbot-genesis 106 (defmethod ircbot-randomize-nick ((bot ircbot))
ircbot-genesis 107 (nick (ircbot-connection bot)
ircbot-genesis 108 (format nil "~A-~A" (ircbot-nick bot) (+ (random 90000) 10000))))
ircbot-genesis 109
ircbot-genesis 110 (defmethod ircbot-send-message ((bot ircbot) target message-text)
ircbot-genesis 111 (privmsg (ircbot-connection bot) target message-text))
ircbot-genesis 112
ircbot-genesis 113 (defmethod ircbot-start-ping-thread ((bot ircbot))
ircbot-genesis 114 (let ((conn (ircbot-connection bot)))
ircbot-genesis 115 (setf (ircbot-ping-thread bot)
ircbot-genesis 116 (sb-thread:make-thread
ircbot-genesis 117 (lambda ()
ircbot-genesis 118 (loop
ircbot-genesis 119 do (progn (sleep *ping-freq*)
ircbot-genesis 120 (let ((ct (get-universal-time)))
ircbot-genesis 121 (push ct (ircbot-lag-track bot))
ircbot-genesis 122 (ping conn (princ-to-string ct))))
ircbot-genesis 123 until (ircbot-timed-out-p bot))
ircbot-genesis 124 (ircbot-reconnect bot))
ircbot-genesis 125 :name "ircbot-ping"))))
ircbot-genesis 126
ircbot-genesis 127 (defmethod ircbot-timed-out-p ((bot ircbot))
ircbot-genesis 128 (loop
ircbot-genesis 129 with ct = (get-universal-time)
ircbot-genesis 130 for v in (ircbot-lag-track bot)
ircbot-genesis 131 when (> (- ct v) *max-lag*)
ircbot-genesis 132 do (return t)))
ircbot-genesis 133
ircbot-genesis 134
ircbot-genesis 135 (defun make-ircbot (server port nick password channel)
ircbot-genesis 136 (make-instance 'ircbot
ircbot-genesis 137 :server server
ircbot-genesis 138 :port port
ircbot-genesis 139 :nick nick
ircbot-genesis 140 :password password
ircbot-genesis 141 :channel channel))