diff --git a/README.org b/README.org index aea6d31..9fb2c17 100644 --- a/README.org +++ b/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. diff --git a/src/bantflags.asd b/src/bantflags.asd deleted file mode 100644 index 343a6ef..0000000 --- a/src/bantflags.asd +++ /dev/null @@ -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"))) diff --git a/src/config.example.lisp b/src/config.example.lisp deleted file mode 100644 index bb053bf..0000000 --- a/src/config.example.lisp +++ /dev/null @@ -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/"))) diff --git a/src/db.lisp b/src/db.lisp deleted file mode 100644 index c518e08..0000000 --- a/src/db.lisp +++ /dev/null @@ -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")) diff --git a/src/main.lisp b/src/main.lisp deleted file mode 100644 index 475db99..0000000 --- a/src/main.lisp +++ /dev/null @@ -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*)) diff --git a/src/utils.lisp b/src/utils.lisp deleted file mode 100644 index 907607c..0000000 --- a/src/utils.lisp +++ /dev/null @@ -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")))