-
+ 34C09AAE0020F81B9DD9A9120DAE84C0E996B578041E837785E814409F69D0D587A21C0C1454C6E39039C8CA3FD135092D4EFD006F39F0E47AC87F0314F6F92D
logbot/logbot.lisp
(0 . 0)(1 . 93)
82 (in-package #:logbot)
83
84
85 (defun get-and-purge-outbox-messages (db)
86 (postmodern:with-connection db
87 (postmodern:query
88 "with deleted as (
89 delete from outbox
90 returning target, message, queued_at
91 )
92 select target,
93 message
94 from deleted
95 order by queued_at"
96 :rows)))
97
98 (defun make-log-entry (db target message host source user)
99 (postmodern:with-connection db
100 (postmodern:execute
101 "insert into log (target, message, host, source, \"user\")
102 values ($1, $2, $3, $4, $5)"
103 target
104 message
105 (if (string= "" host) :null host)
106 source
107 (if (null user) :null user))))
108
109
110 (defclass logbot (ircbot)
111 ((pg-thread :accessor logbot-pg-thread :initform nil)
112 (db :reader logbot-db :initarg :db)))
113
114 (defmethod ircbot-connect :after ((bot logbot))
115 (let ((conn (ircbot-connection bot)))
116 (add-hook conn 'irc-mode-message (lambda (message)
117 (logbot-check-mode bot message)))
118 (add-hook conn 'irc-privmsg-message (lambda (message)
119 (destructuring-bind (target message-text) (arguments message)
120 (make-log-entry (logbot-db bot)
121 target
122 message-text
123 (host message)
124 (source message)
125 (user message)))))))
126
127 (defmethod ircbot-send-message :after ((bot logbot) target message-text)
128 (let* ((b-connection (ircbot-connection bot))
129 (b-user (user b-connection)))
130 (make-log-entry (logbot-db bot)
131 target
132 message-text
133 (hostname b-user)
134 (nickname b-user)
135 (username b-user))))
136
137 (defmethod logbot-check-mode ((bot logbot) message)
138 (if (= 3 (length (arguments message)))
139 (destructuring-bind (channel mode nick) (arguments message)
140 (when (and (string= (host message) "services.")
141 (string= channel (ircbot-channel bot))
142 (or (string= mode "+o") (string= mode "+v"))
143 (string= nick (ircbot-nick bot)))
144
145 (when (null (logbot-pg-thread bot))
146 (logbot-start-pg-thread bot)
147 (logbot-send-outbox bot))))))
148
149 (defmethod logbot-send-outbox ((bot logbot))
150 (loop
151 for (target message)
152 in (get-and-purge-outbox-messages (logbot-db bot))
153 do (ircbot-send-message bot target message)))
154
155 (defmethod logbot-start-pg-thread ((bot logbot))
156 (setf (logbot-pg-thread bot)
157 (sb-thread:make-thread
158 (lambda ()
159 (postmodern:with-connection (logbot-db bot)
160 (postmodern:execute "listen outbox_new_message")
161 (loop
162 (if (string= (cl-postgres:wait-for-notification postmodern:*database*)
163 "outbox_new_message")
164 (logbot-send-outbox bot)))))
165 :name "logbot-pg")))
166
167 (defun make-logbot (server port nick password channel db)
168 (make-instance 'logbot
169 :server server
170 :port port
171 :nick nick
172 :password password
173 :channel channel
174 :db db))