master
not manx 4 years ago
parent 5eb692944a
commit cd8b6cd616
Signed by: C-xC-c
GPG Key ID: F52ED472284EF2F4

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

@ -1,17 +0,0 @@
(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"))))))

@ -12,6 +12,5 @@
:Components ((:file "package") :Components ((:file "package")
(:file "config") (:file "config")
(:file "utils") (:file "utils")
(:file "lolinet")
(:file "loligram") (:file "loligram")
(:file "main"))) (:file "main")))

@ -10,8 +10,7 @@
:port (config-item :port) :port (config-item :port)
:name 'lolisp :name 'lolisp
:message-log-destination *error-output* :message-log-destination *error-output*
:access-log-destination *standard-output* :access-log-destination *standard-output*)))
:document-root (config-item :document-root))))
(defun start () (defun start ()
(handler-case (configure) (handler-case (configure)
@ -23,7 +22,19 @@
(defun stop () (defun stop ()
(hunchentoot:stop *serb* :soft t)) (hunchentoot:stop *serb* :soft t))
(export '(configure (toot:handle (get-loli :get "/loli/"
start :accessor 'lolisp)
stop (rating)
*serb*)) (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"))))))

@ -1,2 +1,6 @@
(defpackage #:lolisp (defpackage #:lolisp
(:use :cl)) (:use :cl)
(:export #:configure
#:start
#:stop
#:*serb*))

@ -1,49 +0,0 @@
(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*))

@ -3,21 +3,8 @@
(defmacro str (&rest strs) (defmacro str (&rest strs)
`(concatenate 'string ,@strs)) `(concatenate 'string ,@strs))
(defun copy-stream (from to &key (buffer-size 4096) (defmacro json-value (json &rest rest)
&aux (buffer (make-array buffer-size :element-type '(unsigned-byte 8)))) (let ((this `(jsown:val ,json ,(pop rest))))
(loop for bytes-read = (read-sequence buffer from) (loop while rest
while (plusp bytes-read) do (setf this `(jsown:val ,this ,(pop rest))))
do (write-sequence buffer to :end bytes-read))) this))
(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))

Loading…
Cancel
Save