diff --git a/loli.lisp b/loli.lisp deleted file mode 100644 index e58aeaa..0000000 --- a/loli.lisp +++ /dev/null @@ -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*)) diff --git a/loligram.lisp b/loligram.lisp new file mode 100644 index 0000000..7d391c1 --- /dev/null +++ b/loligram.lisp @@ -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") + + diff --git a/lolinet.lisp b/lolinet.lisp new file mode 100644 index 0000000..5ed2f04 --- /dev/null +++ b/lolinet.lisp @@ -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")))))) diff --git a/lolisp.asd b/lolisp.asd index 6f370bb..c97080d 100644 --- a/lolisp.asd +++ b/lolisp.asd @@ -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 " + :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"))) diff --git a/lolisp.example.service b/lolisp.example.service deleted file mode 100644 index 8da86a8..0000000 --- a/lolisp.example.service +++ /dev/null @@ -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 diff --git a/main.lisp b/main.lisp new file mode 100644 index 0000000..89c681a --- /dev/null +++ b/main.lisp @@ -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*)) diff --git a/upload.lisp b/upload.lisp new file mode 100644 index 0000000..c8ebb03 --- /dev/null +++ b/upload.lisp @@ -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*)) diff --git a/utils.lisp b/utils.lisp new file mode 100644 index 0000000..f728d1a --- /dev/null +++ b/utils.lisp @@ -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)) +