blob: 52dd7f0c5b8291b99b1646b1dc0fd95e0f84fc50 (
plain)
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
|
;;;; posterbot.lisp
(in-package #:posterbot)
(defclass posterbot (client auto-joiner) ())
(defvar *posterbot* nil
"Dynamic variable holding the bot instance. Bound by HANDLE-EVENT.")
;; THE MAIN METHOD FOR RESPONDING TO USER TEXT EVENTS
(defmethod handle-event :after ((*posterbot* posterbot) (event text-message-event))
(mapc #'handle-link-candiate (ppcre:split " " (msg-body event))))
(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-zA-Z0-9]+)"
: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 () nil)))
(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 check-word-for-link (word)
(cond ((ppcre:scan-to-strings +image-link-regex+ word)
(ppcre:scan-to-strings +image-link-regex+ 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 0)))))
(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 :("))))))
(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)))
|
