C-xC-c
/
lolisp
1
0
Fork 0
Code Issues Pull Requests Releases Activity

Full rewrite

Browse Source
master
not manx 4 years ago
parent 58b3c80e8a
commit 5eb692944a
Signed by: C-xC-c
GPG Key ID: F52ED472284EF2F4
8 changed files with 156 additions and 90 deletions
Show Stats Download Patch File Download Diff File

66
loli.lisp
Unescape View File

@ -1,66 +0,0 @@
(in-package #:lolisp)
(defparameter *serb* nil
"The hunchentoot acceptor (server) that will serve our handlers and
files.")
(defmacro str (&rest strs)
"Concatenate a list of strings `strs' to one string."
`(concatenate 'string ,@strs))
(defmacro config-item (thing &aux (item (gensym)))
"Get `thing' from the alist `config', error if it doesn't exist"
`(let ((,item (assoc ,thing config)))
(when (atom ,item)
(error "No such config item"))
(cdr ,item)))
(defun loli-link (rating)
"Extract file_url from the JSON returned by `dex:get' and replace
escaped backslashes (\\\\/) with /.
Use cl-rng to pick a random page from the lolibooru API"
(cl-ppcre:register-groups-bind (url)
("(?:file_url\":\")(.*?)(?:\",)"
(dex:get (str "https://lolibooru.moe/post/index.json?tags=rating:"
(or (cl-ppcre:scan-to-strings "^-?[sqe]$" rating) "s")
"+-3dcg+-rape&limit=1&page="
(write-to-string (cl-rng:crandom :limit 25000 :transform 'floor)))))
(cl-ppcre:regex-replace-all "\\\\/" url "/")))
(defun based-loli (url)
(str "data:image/jpeg;base64," (qbase64:encode-bytes (dex:get url))))
(henh:handle (get-loli :get "/loli/")
(rating)
(cl-who:with-html-output-to-string (x)
(:html
(:head
(:meta :charset "utf-8")
(:meta :name "viewport" :content "width=device-width, initial-scale=1")
(:title "lolisp")
(:style "body{position:relative;}img{object-fit:contain;width:100%;height:100%;}#about{position:absolute;top:8px;right:16px}"))
(:body
(:img :src (based-loli (loli-link rating)))
(:a :id "about" :href "/loli/about.html" "about")))
x))
(defun configure ()
(setf *serb* (make-instance 'henh:acceptor
:port (config-item :port)
:document-root (config-item :document-root))))
(defun start ()
(handler-case (configure)
(error (e) "Configuration failed: ~a" e))
(when (null *serb*)
(error "Serb is nill? ehh?"))
(hunchentoot:start *serb*))
(defun stop ()
(hunchentoot:stop *serb* :soft t))
(export '(configure
start
stop
*serb*))

28
loligram.lisp
Unescape View File

@ -0,0 +1,28 @@
(in-package #:lolisp)
(defvar *send-loli* (str "https://api.telegram.org/bot" (config-item :loligram-url) "/sendPhoto?chat_id=~a&photo=~a"))
(defvar *no-loli* (str "https://api.telegram.org/bot" (config-item :loligram-url) "/sendMessage?chat_id=~a&text=Go away"))
(defvar *chats* (make-hash-table))
(defun configure-loligram ()
(setf *send-loli* (str "https://api.telegram.org/bot" (config-item :loligram-url) "/sendPhoto?chat_id=~a&photo=~a"))
(setf *no-loli* (str "https://api.telegram.org/bot" (config-item :loligram-url) "/sendMessage?chat_id=~a&text=Go away"))
(setf *chats* (make-hash-table))
(loop for chat in (config-item :loligram-chats)
do (setf (gethash chat *chats*) t)))
(toot:handle (loligram :get (str "/loli/" (config-item :loligram-url)) :content-type toot:@plain)
()
(when (null (tbnl:raw-post-data))
(tbnl:abort-request-handler))
(let* ((json (jsown:parse (babel:octets-to-string (tbnl:raw-post-data))))
(chat-id (jsown:val (jsown:val (jsown:val json "message") "chat") "id"))
(text (jsown:val (jsown:val json "message") "text")))
(cond
((not (gethash chat-id *chats*))
(dex:get (format nil *no-loli* chat-id)))
((string= text "/loli")
(dex:get (format nil *send-loli* chat-id (rori:loli-link "s"))))))
"mwee")

17
lolinet.lisp
Unescape View File

@ -0,0 +1,17 @@
(in-package #:lolisp)
(toot:handle (get-loli :get "/loli/")
(rating)
(let ((loli (rori:loli-get (or rating "s"))))
(cl-who:with-html-output-to-string (page)
(:html
(:head
(:meta :charset "utf-8")
(:meta :name "viewport" :content "width=device-width, initial-scale=1")
(:title "lolisp")
(:link :rel "stylesheet" :href "https://plum.moe/static/css/style.css")
(:link :rel "stylesheet" :href "https://plum.moe/static/css/loli.css"))
(:body
(:img :src (rori:based-loli (cdr (assoc :file-url loli))))
(:p :id "tags" (format page "~a" (cdr (assoc :tags loli))))
(:a :id "about" :href "/loli/about.html" "about"))))))

19
lolisp.asd
Unescape View File

@ -1,16 +1,17 @@
(asdf:defsystem #:lolisp
:description "The worst lolibooru scraper you've ever seen"
:author "Manx (boku@plum.moe)"
:license "X11/MIT"
:version "1.0.0"
:description "Lolis in lisp"
:author "Manx <boku@plum.moe>"
:license "GPLv3"
:version "2.0.0"
:serial t
:depends-on (:hunchentoot
:hunchenhelpers
:cl-who
:dexador
:qbase64
:cl-ppcre
:cl-rng)
:lolicore
:jsown)
:Components ((:file "package")
(:file "config")
(:file "loli")))
(:file "utils")
(:file "lolinet")
(:file "loligram")
(:file "main")))

15
lolisp.example.service
Unescape View File

@ -1,15 +0,0 @@
[Unit]
Description=lolis
[Service]
WorkingDirectory=/path/to/your/lolisp
ExecStart=/bin/env sbcl --non-interactive --load loli.lisp
Restart=always
# restarts 10 seconds after it goes bang
RestartSec=10
KillSignal=SIGINT
SyslogIdentifier=loli
User=www-data
[Install]
WantedBy=multi-user.target

29
main.lisp
Unescape View File

@ -0,0 +1,29 @@
(in-package :lolisp)
(defvar *serb* nil
"The hunchentoot acceptor (server) that will serve our handlers and
files.")
(defun configure ()
(configure-loligram)
(setf *serb* (make-instance 'toot:acceptor
:port (config-item :port)
:name 'lolisp
:message-log-destination *error-output*
:access-log-destination *standard-output*
:document-root (config-item :document-root))))
(defun start ()
(handler-case (configure)
(error (e) "Configuration failed: ~a" e))
(when (null *serb*)
(error "Serb is nill? ehh?"))
(hunchentoot:start *serb*))
(defun stop ()
(hunchentoot:stop *serb* :soft t))
(export '(configure
start
stop
*serb*))

49
upload.lisp
Unescape View File

@ -0,0 +1,49 @@
(in-package #:lolisp)
(defconstant png-header #(137 80 78 71 13 10 26 10))
(defvar hunchenroot (merge-pathnames "flags/" (toot:config-item :document-root)))
(toot:handle (form :post "/upload" toot:@plain)
()
(let ((thing (do-upload (tbnl:post-parameter "flag"))))
(typecase thing
(string thing)
(t "Upload Success"))))
(defun do-upload (file)
(let ((tmp-name (first file))
(mime-type (third file)))
(cond
((not (string= "image/png" mime-type))
"Image should be a PNG")
((not (probe-file tmp-name))
"What the fuck?")
((< 15360 (image-size tmp-name))
"Image too large. Max size is 15KB")
((not (image-dimensions-p tmp-name))
"Wrong image dimensions.")
((not (valid-header-p tmp-name))
"Invalid PNG header")
(t (upload-file tmp-name (second file))))))
(defun upload-file (tmp-name real-name)
(real-move-file tmp-name (merge-pathnames real-name hunchenroot))
t)
(defun image-size (img)
(osicat-posix:stat-size (osicat-posix:stat img)))
(defun image-dimensions-p (img)
"This is silly"
(string= "1611" (inferior-shell:run/ss (str "/usr/bin/identify -format \"%w%h\" " img))))
(defun valid-header-p (img)
(with-open-file (s img :element-type '(unsigned-byte 8))
(loop for header-byte across png-header
for file-byte = (read-byte s)
always (= header-byte file-byte))))
(hunchentoot:start (make-instance 'toot:acceptor
:port 4244
:access-log-destination *standard-output*
:message-log-destination *error-output*))

23
utils.lisp
Unescape View File

@ -0,0 +1,23 @@
(in-package #:lolisp)
(defmacro str (&rest strs)
`(concatenate 'string ,@strs))
(defun copy-stream (from to &key (buffer-size 4096)
&aux (buffer (make-array buffer-size :element-type '(unsigned-byte 8))))
(loop for bytes-read = (read-sequence buffer from)
while (plusp bytes-read)
do (write-sequence buffer to :end bytes-read)))
(defun real-copy-file (from to)
(with-open-file (from from :direction :input
:element-type '(unsigned-byte 8))
(with-open-file (to to :direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))
(copy-stream from to))))
(defun real-move-file (from to)
(real-copy-file from to)
(delete-file from))
Write Preview
Loading…
Cancel
Save