Full rewrite

loli.lisp

@@ -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*))

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")
+
+

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"))))))

lolisp.asd

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

lolisp.example.service

@@ -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

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*))

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*))

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))
+