1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
;;;; posterbot.lisp
(in-package #:posterbot)
;;; An Example Bot with Granolin:
;;;
;;; A bot is a class that extends granolin:client. There are several
;;; "plug-in" classes that you can also extend, each one implements a
;;; self-contained functionality that might be useful. For example,
;;; the posterbot class that is defined below extends the
;;; granolin:auto-joiner plugin. An instance of a class extending
;;; auto-joiner will join any room to which it is invited.
(defclass posterbot (client auto-joiner) ())
(defvar *posterbot* nil
"Dynamic variable holding the bot instance. Bound by HANDLE-EVENT.")
;;; All you need to do to plug your bot into granolin's logic is
;;; specialize HANDLE-EVENT :AFTER or HANDLE-EVENT :BEFORE methods on
;;; your bot class.
;;; Granolin defines a number of event types, and you can specialize
;;; HANDLE-EVENT for each one. The folling handler is specialized for
;;; TEXT-MESSAGE-EVENT.
;;;
;;; Within the extent of a HANDLE-EVENT call, the special variable
;;; *ROOM-ID* is bound to the id of the matrix room where the EVENT
;;; occurred.
(defmethod handle-event :after ((*posterbot* posterbot) (event text-message-event))
(mapc #'handle-link-candiate (ppcre:split " " (msg-body event))))
;;; Finally, when you want to use a bot - you make an instance of your
;;; class and call the GRANOLIN:LOGIN method on it, and, assuming the
;;; login is successful, GRANOLIN:START, which will begin polling the
;;; homeserver for messages.
;;;
;;; Instantiating a bot instance accepts a few paramters, like
;;; :USER-ID and :HOMESERVER, which should be self explanatory.
;;;
;;; The :HARDCOPY parameter is the name of a file where bot state will
;;; be saved if it is stopped or if it dies. You can use this
;;; "hardcopy" to resume your bot.
(defun start-posterbot ()
"A start function to pass in as the :toplevel to SAVE-LISP-AND-DIE"
(let* ((config (if (uiop:file-exists-p "posterbot.config")
(with-open-file (input "posterbot.config")
(read input))
(progn (format t "I think you need a posterbot.config~%~%")
(return-from start-posterbot))))
(bot (make-instance 'posterbot
:ssl (if (member :ssl config)
(getf config :ssl)
t)
:hardcopy (getf config :hardcopy)
:user-id (getf config :user-id)
:homeserver (getf config :homeserver))))
(when (not (logged-in-p bot))
(login bot (getf config :user-id) (getf config :password)))
(start bot)))
(defparameter +image-link-regex+
(ppcre:create-scanner "http.+\\\.(png|gif|jpeg|bmp|jpg)"
:case-insensitive-mode t))
(defparameter +giphy-link-regex+
(ppcre:create-scanner "https://giphy.com/gifs/([a-z0-9]+-)*([a-zA-Z0-9]+)"
:case-insensitive-mode t))
(defparameter +tenor-link-regex+
(ppcre:create-scanner "(https://tenor.com/view/.+$)|(https://tenor.com/[a-zA-Z0-9]+.gif$)"
:case-insensitive-mode t))
;; e.g. "https://images.app.goo.gl/5S8RGSdZajBxe83W6"
(defparameter +google-image-share-link+
(ppcre:create-scanner "https://images.app.goo.gl/.+"
:case-insensitive-mode t))
(defun download-link (link)
"Downloads the file at LINK to a temporary file. Returns the path to
the downloaded file. If there is an error thrown at any point, returns NIL."
(handler-case
(cl-fad:with-output-to-temporary-file (out :element-type '(unsigned-byte 8))
(let ((buffer (make-array 4096 :element-type '(unsigned-byte 8)))
(file-stream (drakma:http-request link :want-stream t)))
(loop :for bytes = (read-sequence buffer file-stream)
:while (plusp bytes) :do (write-sequence buffer out))))
(error (c)
(format *error-output*
"While downloading image file at ~a.~%Encountered Error: ~a~%~%"
link c))))
(defun filename-from-link (link)
"Extracts the filename of a link. I.e. everything after the last / character."
(first (last (ppcre:split "/" link))))
(defun make-mime-type (filename)
"Given a string FILENAME, returns a string representing a sensible guess for a mimetype."
(format nil "image/~a"
(let ((type (string-downcase (pathname-type filename))))
(cond ((member type '("jpg" "jpeg") :test #'equal) "jpeg")
((equal type "svg") "svg+xml")
(t type)))))
(defun fetch-link-from-tenor-page (page-uri)
"Scrapes an image link from a the HTML served up by tenor."
(handler-case
(let* ((dom (plump:parse (drakma:http-request page-uri)))
(elems (clss:select "#single-gif-container .Gif > img" dom)))
(and (plusp (length elems))
(plump:attribute (elt elems 0) "src")
(first (ppcre:split "\\\?" (plump:attribute (elt elems 0) "src")))))
(error (e)
(format *error-output*
"Error while processing tenor link ~a~%Error: ~a~%~%"
page-uri
e))))
(defun fetch-link-from-google-image-page (page-uri)
"Scrapes an image link provided from a google image search's share button"
(handler-case
(let* ((dom (plump:parse (drakma:http-request page-uri)))
(elems (clss:select "img" dom)))
(and (< 1 (length elems))
(plump:attribute (elt elems 1) "src")
(ppcre:scan-to-strings +image-link-regex+
(plump:attribute (elt elems 1) "src"))))
(error (e)
(format *error-output*
"Error while processing google image share link: ~a~%Error: ~a~%~%"
page-uri
e))))
(defun check-word-for-link (word)
(cond
((ppcre:scan-to-strings +google-image-share-link+ word)
(fetch-link-from-google-image-page word))
((ppcre:scan-to-strings +giphy-link-regex+ word)
(multiple-value-bind (string matches)
(ppcre:scan-to-strings +giphy-link-regex+ word)
(declare (ignore string))
(when (plusp (length matches))
(format nil "https://media.giphy.com/media/~a/giphy.gif" (elt matches 1)))))
((ppcre:scan-to-strings +tenor-link-regex+ word)
(fetch-link-from-tenor-page word))
((ppcre:scan-to-strings +image-link-regex+ word)
(ppcre:scan-to-strings +image-link-regex+ word))
(t nil)))
(defun handle-link-candiate (word)
"Checks if WORD is an HTTP URI pointing to an image resource. If it
is, downloads the image and posts it to the current room."
(let ((link (check-word-for-link word)))
(when link
(let* ((file-path (download-link link))
(file-name (filename-from-link link))
(mxc-uri
(and file-path
(upload *posterbot*
file-name
(alexandria:read-file-into-byte-vector file-path)
:content-type (make-mime-type file-name)))))
(if mxc-uri
(progn
(send-image-message *posterbot* *room-id* file-name mxc-uri
:info (list :|mimetype| (make-mime-type file-name)))
(uiop:delete-file-if-exists file-path))
(send-text-message *posterbot* *room-id* "I have failed you 🤖"))))))
|
