Archive branch

dotnetflags
not manx 4 years ago
parent 5c2c2a627d
commit 7129d0375c
Signed by: C-xC-c
GPG Key ID: F52ED472284EF2F4

@ -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 * BantFlags
A user script and backend enabling user created flags on [[https://boards.4chan.org/bant][/bant/]], 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]]. originally based on [[https://github.com/flaghunters/Extra-Flags-for-4chan][extraflags]].
@ -27,7 +30,6 @@ declarations. Update your hecking browser.
*** Prerequisites *** Prerequisites
- .NET Core 3.1 - .NET Core 3.1
- MariaDB / MySQL - MariaDB / MySQL
*** .NET dependancies *** .NET dependancies
- Nito.AsyncEX - Nito.AsyncEX
- Newtonsoft.Json - Newtonsoft.Json
@ -38,7 +40,6 @@ declarations. Update your hecking browser.
- Microsoft.EntityFrameworkCore.SqlServer - Microsoft.EntityFrameworkCore.SqlServer
- Microsoft.EntityFrameworkCore.Tools - Microsoft.EntityFrameworkCore.Tools
- Magick.NET-Q8-AnyCPU - Magick.NET-Q8-AnyCPU
*** Setup *** Setup
1) [[https://dotnet.microsoft.com/download/dotnet-core][Install .NET Core]] 1) [[https://dotnet.microsoft.com/download/dotnet-core][Install .NET Core]]
2) Clone and build the BantFlags solution. 2) Clone and build the BantFlags solution.

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

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

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

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

@ -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")))
Loading…
Cancel
Save