(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)) (defun configure () (setf *serb* (make-instance 'hunchentoot:easy-acceptor :port (config-item :port) :address (config-item :host) :document-root (config-item :document-root) :error-template-directory (config-item :error-root) ;; We (eval) these because quoting streams is werid. ;; '*standard-ouput* is not of type stream why? :access-log-destination (eval (config-item :access-log)) :message-log-destination (eval (config-item :error-log))))) (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*)) (export '(configure start stop *serb*))