not manx
4 years ago
parent
f0441780af
commit
53ca0a271c
GPG Key ID:
F52ED472284EF2F4
@ -1,4 +1,4 @@
|
||||
config.lisp
|
||||
loli.service
|
||||
lolisp.service
|
||||
\#*#
|
||||
*~
|
||||
@ -1 +0,0 @@
|
||||
(defparameter *host* "localhost")
|
||||
@ -1,62 +1,63 @@
|
||||
(ql:quickload :aserve)
|
||||
(ql:quickload :dexador)
|
||||
(ql:quickload :jsown)
|
||||
(ql:quickload :qbase64)
|
||||
(ql:quickload :cl-ppcre)
|
||||
(ql:quickload :cl-rng)
|
||||
(ql:quickload :manx-utils)
|
||||
|
||||
(load #p"config.lisp")
|
||||
|
||||
(when (null *host*)
|
||||
(print "Host can't be nil")
|
||||
(exit :code -1))
|
||||
|
||||
(defun get-loli (rating)
|
||||
(jsown:val
|
||||
(car ;; %parse-json returns a list of a list
|
||||
(jsown:parse
|
||||
(dex:get
|
||||
(manx-utils:to-string
|
||||
"https://lolibooru.moe/post/index.json?tags=rating:" rating "+-3dcg+-rape&limit=1&page="
|
||||
(cl-rng:crandom :limit 25000 :transform 'floor)))))
|
||||
"file_url"))
|
||||
|
||||
(defun main (&rest args)
|
||||
(net.aserve:start :port 8080 :host *host*)
|
||||
|
||||
(net.aserve:publish
|
||||
:path "/loli"
|
||||
:content-type "text/html"
|
||||
:function 'this-is-bad-code)
|
||||
|
||||
(net.aserve:publish-file
|
||||
:path "/loli/about"
|
||||
:file #p"about.html")
|
||||
|
||||
(loop (sleep 10000)))
|
||||
|
||||
(defun loli-rating (rating)
|
||||
(or (cl-ppcre:scan-to-strings "-?(s|q|e)" rating)
|
||||
"s"))
|
||||
|
||||
(defun based-loli (req)
|
||||
(manx-utils:to-string
|
||||
"data:image/jpg;base64,"
|
||||
(qbase64:encode-bytes
|
||||
(dex:get (get-loli
|
||||
(loli-rating (net.aserve:request-query-value "rating" req)))))))
|
||||
|
||||
(defun this-is-bad-code (req ent)
|
||||
(net.aserve:with-http-response (req ent)
|
||||
(net.aserve:with-http-body (req ent)
|
||||
(net.html.generator:html
|
||||
(:html
|
||||
(:head
|
||||
((:meta name "viewport" content "width=device-width, initial-scale=1")))
|
||||
((:body :style "position:relative")
|
||||
((:img :style "object-fit: contain; width: 100%; height:100%"
|
||||
:src (based-loli req)))
|
||||
((:a :style "position:absolute;top:8px;right:16px;" href "/loli/about") "about"))))))
|
||||
(gc :full t)) ;; Removes downloaded files from memory
|
||||
(main)
|
||||
(in-package :lolisp)
|
||||
|
||||
(defvar @html "text/html")
|
||||
(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 :uri "/loli/") @html
|
||||
(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" "about")))
|
||||
x))
|
||||
|
||||
(henh:host-file "/loli/about" "about.html" @html)
|
||||
|
||||
(defun configure ()
|
||||
(setf *serb* (make-instance 'hunchentoot:easy-acceptor
|
||||
:port (config-item :port)
|
||||
:document-root (config-item :document-root))))
|
||||
|
||||
(defun start ()
|
||||
(handler-case (configure)
|
||||
(error (e) "Configuration failed: ~a" e))
|
||||
(hunchentoot:start *serb*))
|
||||
|
||||
(export '(configure
|
||||
start
|
||||
*serb*))
|
||||
|
||||
@ -0,0 +1,16 @@
|
||||
(asdf:defsystem :lolisp
|
||||
:description "The worst lolibooru scraper you've ever seen"
|
||||
:author "Manx (boku@plum.moe)"
|
||||
:license "X11/MIT"
|
||||
:version "1.0.0"
|
||||
:serial t
|
||||
:depends-on (:hunchentoot
|
||||
:hunchenhelpers
|
||||
:cl-who
|
||||
:dexador
|
||||
:qbase64
|
||||
:cl-ppcre
|
||||
:cl-rng)
|
||||
:Components ((:file "package")
|
||||
(:file "config")
|
||||
(:file "loli")))
|
||||
@ -0,0 +1,2 @@
|
||||
(defpackage :lolisp
|
||||
(:use :cl))
|
||||
Loading…
Reference in new issue