Archive branch

README.org

@@ -1,3 +1,6 @@
+* DotnetFlags
+This branch exists as an archive of bantflags before it was rewritten
+in Common Lisp. The code here still works but is unmaintained.
 * BantFlags
 A user script and backend enabling user created flags on [[https://boards.4chan.org/bant][/bant/]],
 originally based on [[https://github.com/flaghunters/Extra-Flags-for-4chan][extraflags]].
@@ -27,7 +30,6 @@ declarations. Update your hecking browser.
 *** Prerequisites
 - .NET Core 3.1
 - MariaDB / MySQL
-
 *** .NET dependancies
 - Nito.AsyncEX
 - Newtonsoft.Json
@@ -38,7 +40,6 @@ declarations. Update your hecking browser.
 - Microsoft.EntityFrameworkCore.SqlServer
 - Microsoft.EntityFrameworkCore.Tools
 - Magick.NET-Q8-AnyCPU
-
 *** Setup
 1) [[https://dotnet.microsoft.com/download/dotnet-core][Install .NET Core]] 
 2) Clone and build the BantFlags solution.

src/bantflags.asd

@@ -1,16 +0,0 @@
-(asdf:defsystem #:bantflags
-  :description "the bantflags server component"
-  :author "Manx (boku@plum.moe)"
-  :mailto "boku@plum.moe"
-  :license "AGPLv3+"
-  :version "0.0.1"
-  :serial t
-  :depends-on (:hunchentoot
-               :str
-               :cl-dbi
-               :jonathan)
-  :Components
-  ((:file "utils")
-   (:file "db")
-   (:file "config")
-   (:file "main")))

src/config.example.lisp

@@ -1,6 +0,0 @@
-(defvar config
-  '((boards "bant")
-    (staging-password "not implemented")
-    (db-conn "bantflags" "flags" "default")
-    (poolsize 3)
-    (www-root #p"/path/to/files/")))

src/db.lisp

@@ -1,59 +0,0 @@
-;; Databases in common lisp are the fucking worst.
-;; Don't even bother.
-
-;; Comparing strings with both
-(defparameter *flags* (make-hash-table :test 'equal))
-(defparameter *boards* (make-hash-table :test 'equal))
-(defparameter *flags-txt* nil)
-(defparameter conn-str nil)
-
-(defvar get-posts-sql "SELECT posts.post_nr, flags.flag from flags left join postflags on (postflags.flag = flags.id) left join posts on (postflags.post_nr = posts.id) where posts.post_nr in (~{'~a'~^,~}) and posts.board = '~a';")
-
-(defun fuck-you-fukamachi (conn |;_;|)
-  "What the fuck is going on with what dbi:fetch returns? why is it a
-fucking list with the database columns as a symbols with pipes around
-them? How in the dicking shit am I supposed to use :|post_nr| 1234 in
-any useful or practical way? Why does this fucking Wumpus of a human
-being Fukamachi feel the need to duplicate so much data? Don't get me
-wrong, clsql is easily worse to work with, but at least it was fucking
-smart enough to make the database fields into (values rows columns)"
-  (mapcar (lambda (x) (list (nth 1 x) (nth 3 x)))
-          (dbi:fetch-all (dbi:execute (dbi:prepare conn |;_;|)))))
-
-(defmacro dbfun (name &rest body)
-  `(defun ,name ,(car body)
-     (dbi:with-connection  (conn :mysql
-                                 :database-name (car conn-str)
-                                 :username (nth 1 conn-str)
-                                 :password (nth 2 conn-str))
-       (dbi:do-sql conn "set names 'utf8';") ;; I fucking hate computers
-       ,@(cdr body))))
-
-(defun flag-id (flag)
-  (gethash flag *flags*))
-
-(dbfun ping ()
-       (dbi:ping conn))
-
-(dbfun insert-post (post_nr board flags)
-       (dbi:do-sql conn
-         (format nil "insert ignore into posts (post_nr, board) values (~a, '~a');" post_nr board))
-       (let ((post-id (cadr (dbi:fetch (dbi:execute (dbi:prepare conn (format nil "select id from posts where post_nr = ~a and board = '~a';" post_nr board)))))))
-         (dbi:do-sql conn
-             (with-output-to-string (s)
-               (format s "insert into postflags (post_nr, flag) values")
-               (loop for flag in (butlast flags)
-                     do (format s "(~a,~a)," post-id (flag-id flag)))
-               (format s "(~a,~a);" post-id (flag-id (car (last flags))))))))
-
-(dbfun get-posts (posts board)
-       (let ((result (fuck-you-fukamachi conn (format nil get-posts-sql posts board)))
-             (table (make-hash-table)))
-         (loop for (post_nr . flag) in result do
-           (unless (gethash post_nr table)
-             (setf (gethash post_nr table) '()))
-           (push (car flag) (gethash post_nr table)))
-         (jojo:to-json table)))
-
-(dbfun get-flags ()
-       (fuck-you-fukamachi conn "select flags.id, flags.flag from flags"))

src/main.lisp

@@ -1,58 +0,0 @@
-(defun init ()
-  (set-db-conn)
-  (dotimes (_ (cconf 'poolsize))
-    (dbi:connect-cached :mysql
-                        :database-name (car conn-str)
-                        :username (nth 1 conn-str)
-                        :password (nth 2 conn-str)))
-  (ping) ;; test db conn  
-  (set-boards)
-  (set-flags)
-  (defvar +serb+ (make-instance 'hunchentoot:easy-acceptor
-                                :port 4242
-                                :document-root (cconf 'www-root)))
-  (hunchentoot:start +serb+))
-
-(defun main ()
-  (handler-case (init)
-    (error (c)
-      (format t "Init fucked up, exiting ~a" c)
-      (return-from main)))  
-  (loop (sleep 43200) (gc :full t)))
-
-(defmethod hunchentoot:acceptor-status-message (acceptor (http-status-code (eql 404)) &key)
-  (format nil ""))
-
-(defmacro handle (method uri params &body body)
-  `(hunchentoot:define-easy-handler ,uri ,params
-     (unless (eq ,method (hunchentoot:request-method*))
-       (setf (hunchentoot:return-code*) hunchentoot:+http-not-found+)
-       (hunchentoot:abort-request-handler))
-     ,@body))
-
-(handle :post (api-post :uri "/api/post")
-    (post_nr regions board version)
-  (setf (hunchentoot:content-type*) "application/json")
-  (let ((separator (if (< 1 (get-version version)) "," "||")))
-    (multiple-value-bind (result msg) (post-valid-p post_nr regions board separator)
-      (cond
-        (result
-         (insert-post post_nr board msg)
-         (format nil "{\"~a\": [~{\"~a\"~^,~}]}~%" post_nr msg))
-        (t
-         (format nil "{\"Error\": \"~a\"}~%" msg))))))
-
-(handle :post (api-get :uri "/api/get")
-    (post_nrs board version)
-  (@json tbnl:*reply*)
-  (setf post_nrs (str:split "," post_nrs))
-  (cond
-    ((and (loop for x in post_nrs always (post-number-p x))
-          (boardp board))
-     (format nil "~a~%" (get-posts post_nrs board)))
-    (t (format nil "~a~%" "bad"))))
-
-(handle :get (api-flags :uri "/api/flags")
-    ()
-  (@plain tbnl:*reply*)
-  (format nil "~a~%" *flags-txt*))

src/utils.lisp

@@ -1,71 +0,0 @@
-(defvar empty-flag '("empty, or there were errors. Re-set your flags."))
-
-(defun conf (thing)
-  (let ((item (cdr (assoc thing config))))
-    (if (null item)
-        (error "no such config item" thing)
-        item)))
-
-(defun cconf (thing)
-  (car (conf thing)))
-
-(defun set-boards ()
-  (setf *boards* (make-hash-table :test 'equal))
-  (mapc (lambda (board) (setf (gethash board *boards*) t)) (conf 'boards)))
-
-(defun set-flags ()
-  (setf *flags* (make-hash-table :test 'equal))
-
-  (let ((flags (get-flags)))
-    (loop for (id . flag) in flags
-          do (setf (gethash (car flag) *flags*) id))
-    (setf *flags-txt*
-          (cl-ppcre:regex-replace "empty, or there were errors. Re-set your flags\\.\\n"
-                                  (format nil "~{~a~^~%~}" (mapcan (lambda (x) (cdr x)) flags))
-                                  ""))))
-(defun set-db-conn ()
-  (setq conn-str (conf 'db-conn)))
-
-(defun get-version (thing)
-  (if (null thing) 0
-      (or (parse-integer thing :junk-allowed t) 0)))
-
-(defun post-number-p (post_nr)
-  (if (or (null post_nr)
-          (null (parse-integer post_nr :junk-allowed t)))
-      nil
-      post_nr))
-
-(defun boardp (board)
-  (gethash board *boards*))
-
-(defun post-valid-p (post_nr regions board separator)
-  (let ((flags (str:split separator regions)))
-    (cond
-      ((not (post-number-p post_nr))
-       (values nil "Invalid post number"))
-      ((not (boardp board))
-       (values nil "Invalid board parameter."))
-      ((null regions)
-       (values t empty-flag))
-      ((< 30 (length flags))
-       (values nil "Too many flags."))
-      ((loop for flag in flags
-             always (gethash flag *flags*))
-       (values t flags))
-      (t (values t empty-flag)))))
-
-(defun host-dir (uri path)
-  (push
-   (hunchentoot:create-folder-dispatcher-and-handler uri path)
-   hunchentoot:*dispatch-table*))
-
-;; This is uneccessarily complicated, no I'm not sorry
-(defmacro content-type (types)
-  (cons 'progn
-        (mapcar (lambda (type) `(defun ,(car type) (reply)
-                             (setf (tbnl:content-type* reply) ,(cadr type))))
-                types)))
-(content-type
- ((@json "application/json")
-  (@plain "text/plain")))