1 ;;;; trilemabot.lisp
  2 
  3 (in-package #:trilemabot)
  4 
  5 ;; These are used to check that we're joining #trilema; make sure that
  6 ;; your bot is configured accordingly if you want to use
  7 ;; #trilema-specific functionality.
  8 (defparameter *trilema-server* ".freenode.net")
  9 (defparameter *trilema-channel* "#trilema")
 10 (defparameter *trilema-deedbot-nick* "deedbot")
 11 
 12 (defclass trilemabot (ircbot)
 13   ((in-chan :accessor trilemabot-in-chan :initform nil)
 14    (voiced :accessor trilemabot-voiced :initform nil)
 15    (voice-otp-stash :accessor trilemabot-voice-otp-stash
 16 		    :initarg :voice-otp-stash
 17 		    :initform nil)
 18    (inbox :accessor trilemabot-inbox
 19 	  :initform nil)
 20    (cmd-prefix :reader trilemabot-cmd-prefix :initarg :cmd-prefix)))
 21 
 22 ;; <command> ::= <cmd-prefix><space>*<command><space>+<arguments>
 23 (defgeneric trilemabot-handle-cmd (command bot message target arguments)
 24   (:documentation "Handle prefixed `command' sent to `bot'.
 25 
 26 `message' is the cl-irc message object sent to the bot. `arguments'
 27 is a string containing everything sent after the command."))
 28 
 29 (defmethod ircbot-connect :after ((bot trilemabot))
 30   (with-slots (connection) bot
 31     (add-hook connection 'irc-join-message
 32 	      #'(lambda (message) (trilemabot-join-channel bot message)))
 33     (add-hook connection 'irc-part-message
 34 	      #'(lambda (message) (trilemabot-part-channel bot message)))
 35     (add-hook connection 'irc-privmsg-message
 36 	      #'(lambda (message) (trilemabot-handle-privmsg bot message)))
 37     (add-hook connection 'irc-mode-message
 38 	      #'(lambda (message) (trilemabot-check-mode bot message)))))
 39 
 40 (defmethod ircbot-disconnect :after ((bot trilemabot) &optional (quit-msg ""))
 41   (declare (ignore quit-msg))
 42   (with-slots (in-chan voiced) bot
 43     (setf in-chan nil
 44 	  voiced nil)))
 45 
 46 (defmethod trilemabot-join-channel ((bot trilemabot) message)
 47   (destructuring-bind (channel) (arguments message)
 48     (when (and (string= (source message) (ircbot-nick bot))
 49 	       (string= channel *trilema-channel*)
 50 	       (search *trilema-server* (ircbot-server bot)))
 51       (setf (trilemabot-in-chan bot) t)
 52       (trilemabot-voice bot))))
 53 
 54 (defmethod trilemabot-part-channel ((bot trilemabot) message)
 55   (let ((channel (car (arguments message))))
 56    (when (and (string= (source message) (ircbot-nick bot))
 57 	      (string= channel *trilema-channel*)
 58 	      (search *trilema-server* (ircbot-server bot)))
 59      (setf (trilemabot-in-chan bot) nil
 60 	   (trilemabot-voiced bot) nil))))
 61 
 62 (defmethod trilemabot-handle-privmsg ((bot trilemabot) message)
 63   (destructuring-bind (target message-text) (arguments message)
 64     ;; Messages from deedbot go to inbox
 65     (when (and (string= (source message) *trilema-deedbot-nick*)
 66 	       (string= target (ircbot-nick bot)))
 67       (format *standard-output* "<~a>: ~a~%"
 68 	      (source message) message-text)
 69       (push (list :from (source message)
 70 		  :time (received-time message)
 71 		  :message message-text)
 72 	    (trilemabot-inbox bot)))
 73     ;; Prefixed commands go to trilemabot-handle-cmd
 74     (let ((command (parse-command bot message-text)))
 75       (when (= 2 (length command))
 76 	(trilemabot-handle-cmd (car command) bot message target (cadr command))))))
 77 
 78 (defmethod trilemabot-check-mode ((bot trilemabot) message)
 79   (when (= 3 (length (arguments message))) ; mode change for user in chan
 80     (destructuring-bind (channel mode nick) (arguments message)
 81       (when (and (string= channel *trilema-channel*)
 82 		 (string= nick (ircbot-nick bot)))
 83 	(cond
 84 	  ((or (string= mode "+o")
 85 	       (string= mode "+v")) (setf (trilemabot-voiced bot) t))
 86 	  ((or (string= mode "-o")
 87 	       (string= mode "-v")) (setf (trilemabot-voiced bot) nil)))))))
 88 
 89 (defmethod trilemabot-add-voice-otps ((bot trilemabot) &rest otps)
 90   (with-slots (voice-otp-stash) bot
 91     (setf voice-otp-stash (nconc voice-otp-stash otps))))
 92 
 93 (defmethod trilemabot-voice ((bot trilemabot))
 94   (with-slots (voice-otp-stash) bot
 95     (if voice-otp-stash
 96 	(trilemabot-send-otp bot (pop voice-otp-stash))
 97 	(format *standard-output* "[trilemabot ~a@~a] No OTPs available.~%"
 98 		(ircbot-nick bot) (ircbot-server bot)))))
 99 
100 (defmethod trilemabot-send-up ((bot trilemabot) &optional nick)
101   (ircbot-send-message bot *trilema-deedbot-nick*
102 		       (make-bot-command "!!up"
103 					 (or nick (ircbot-nick bot)))))
104 
105 (defmethod trilemabot-send-otp ((bot trilemabot) otp)
106   (ircbot-send-message bot *trilema-deedbot-nick*
107 		       (make-bot-command "!!v" otp)))
108 
109 (defun make-bot-command (command &rest arguments)
110   "Make raw bot command string consisting of `command' and
111 space-separated `arguments'."
112   (with-output-to-string (out)
113     (write-string command out)
114     (dolist (arg arguments)
115       (write-string " " out)
116       (write-string arg out))))
117 
118 (defmethod trilemabot-save-voice-otp-stash ((bot trilemabot) filespec)
119   (with-open-file (out filespec
120 		       :direction :output
121 		       :if-exists :supersede
122 		       :if-does-not-exist :create)
123     (print (trlb:trilemabot-voice-otp-stash bot) out)
124     (finish-output out)))
125 
126 ;; A default command handler
127 (trilemabot-define-default-cmd (command bot message target args)
128   (format *standard-output* "[trilemabot] Unhandled command: ~s ~a from ~a to ~a.~%"
129 	  command args (source message) target))
130 
131 ;; Wrapper over defmethod to specialize trilemabot-handle-cmd
132 (defmacro trilemabot-define-cmd ((command bot message-var target-var arguments-var)
133                            &body body)
134   (let ((%command-var (gensym "g-cmd-command-var")))
135     `(defmethod trilemabot-handle-cmd ((,%command-var (eql ',command))
136 				       (,bot trilemabot)
137 				       ,message-var ,target-var ,arguments-var)
138        ,@body)))
139 
140 (defmacro trilemabot-define-default-cmd ((command-var
141 					  bot message-var target-var arguments-var)
142                                    &body body)
143   `(defmethod trilemabot-handle-cmd (,command-var (,bot trilemabot)
144                            ,message-var ,target-var ,arguments-var)
145      ,@body))
146 
147 ;; Prefixed command parsing
148 (defun parse-command (bot message-text)
149   (when (prefix-matches-p bot message-text)
150     (let ((tokens (with-input-from-string (in (trim-prefix bot message-text))
151 		    (list (intern (symbol-name (read in nil)) :keyword)
152 			  (read-line in nil "")))))
153       (and (car tokens) tokens))))
154 
155 (defun trim-prefix (bot message-text)
156   (when (prefix-matches-p bot message-text)
157    (string-left-trim " "
158     (subseq message-text (length (trilemabot-cmd-prefix bot))))))
159 
160 (defun prefix-matches-p (bot message-text)
161   (let* ((prefix (trilemabot-cmd-prefix bot))
162          (prefix-end (length prefix)))
163     (when (>= (length message-text) prefix-end)
164         (string= prefix message-text
165                  :start1 0 :end1 prefix-end
166                  :start2 0 :end2 prefix-end))))
167 
168 (defun make-trilemabot (server port nick password channels cmd-prefix
169 			&optional voice-otps)
170   (make-instance 'trilemabot
171 		 :server server
172 		 :port port
173 		 :nick nick
174 		 :password password
175 		 :channels channels
176 		 :cmd-prefix cmd-prefix
177 		 :voice-otp-stash voice-otps))