Update cl-bbsHEADmaster

1 files changed, 903 insertions, 0 deletions

diff --git a/server/handlers.lisp b/server/handlers.lisp
new file mode 100644
index 0000000..11ec701
--- /dev/null
+++ b/server/handlers.lisp
@@ -0,0 +1,903 @@
+(defpackage :cl-bbs/handlers
+  (:use :cl)
+  (:import-from :cl-bbs/storage
+                #:*base-dir*
+                #:read-sexp-file
+                #:write-sexp-file
+                #:is-board-locked
+                #:ensure-board-dirs)
+                (:import-from :cl-bbs/rss
+                 #:generate-rss
+                 #:get-all-boards-rss-threads)
+                (:import-from :cl-bbs/views
+                 #:render-moderation
+                 #:render-index
+                #:render-list
+                #:render-preferences
+                #:render-error-page
+                #:render-thread
+                #:render-search-results
+                #:render-playground)
+  (:export #:handle-request
+           #:*headline-limit*
+           #:*body-limit*))
+
+(in-package :cl-bbs/handlers)
+
+(defparameter *headline-limit*
+  (or (and (uiop:getenv "SBBS_HEADLINE_LIMIT")
+           (parse-integer (uiop:getenv "SBBS_HEADLINE_LIMIT") :junk-allowed t))
+      128)
+  "Maximum character limit for post headlines.")
+
+(defparameter *body-limit*
+  (or (and (uiop:getenv "SBBS_BODY_LIMIT")
+           (parse-integer (uiop:getenv "SBBS_BODY_LIMIT") :junk-allowed t))
+      4096)
+  "Maximum character limit for post bodies.")
+
+(defun parse-cookies (cookie-string)
+  "Parses a Cookie header string like 'theme=dark; foo=bar' into an alist."
+  (when cookie-string
+    (let ((cookies '()))
+      (dolist (part (cl-ppcre:split ";" cookie-string))
+        (let ((pair (cl-ppcre:split "=" (string-trim '(#\Space #\Tab #\Newline #\Return) part) :limit 2)))
+          (when (= (length pair) 2)
+            (let ((name (string-trim '(#\Space #\Tab #\Newline #\Return) (first pair)))
+                  (val (string-trim '(#\Space #\Tab #\Newline #\Return) (second pair))))
+              (push (cons name val) cookies)))))
+      (nreverse cookies))))
+
+(defun sanitize-theme-name (theme-str)
+  "Validates and returns theme-str if it consists only of alphanumeric characters,
+hyphens, and underscores. Otherwise returns nil to prevent injection/directory traversal."
+  (when (and theme-str (cl-ppcre:scan "^[a-zA-Z0-9_-]+$" theme-str))
+    theme-str))
+
+(defun sanitize-board-name (board-str)
+  "Validates and returns board-str if it consists only of alphanumeric characters,
+hyphens, and underscores. Otherwise returns nil to prevent injection/directory traversal."
+  (when (and board-str (cl-ppcre:scan "^[a-zA-Z0-9_-]+$" board-str))
+    board-str))
+
+(defun get-default-board-from-env (env)
+  "Retrieves the default board name from the request cookies."
+  (let* ((headers (getf env :headers))
+         (cookie-str (and headers (gethash "cookie" headers)))
+         (cookies (parse-cookies cookie-str))
+         (cookie-board (sanitize-board-name (cdr (assoc "default_board" cookies :test #'string=)))))
+    (and (not (string= cookie-board "")) cookie-board)))
+
+(defun get-theme-from-env (env)
+  "Retrieves the active theme name from the request query parameters or cookies."
+  (let* ((query-str (getf env :query-string))
+         (query-theme (when (and query-str (not (string= query-str "")))
+                        (let ((params (quri:url-decode-params query-str)))
+                          (sanitize-theme-name (cdr (assoc "theme" params :test #'string=)))))))
+    (or query-theme
+        (let* ((headers (getf env :headers))
+               (cookie-str (and headers (gethash "cookie" headers)))
+               (cookies (parse-cookies cookie-str))
+               (cookie-theme (sanitize-theme-name (cdr (assoc "theme" cookies :test #'string=)))))
+          (or cookie-theme "default")))))
+
+(defun get-syntax-theme-from-env (env)
+  "Retrieves the active syntax theme name from the request cookies."
+  (let* ((headers (getf env :headers))
+         (cookie-str (and headers (gethash "cookie" headers)))
+         (cookies (parse-cookies cookie-str))
+         (cookie-theme (sanitize-theme-name (cdr (assoc "syntax_theme" cookies :test #'string=)))))
+    (or cookie-theme "simple")))
+
+(defun get-search-hide-input-from-env (env)
+  "Retrieves the setting for hiding search input in board view (returns \"yes\" or \"no\", default \"no\")."
+  (let* ((headers (getf env :headers))
+         (cookie-str (and headers (gethash "cookie" headers)))
+         (cookies (parse-cookies cookie-str))
+         (val (cdr (assoc "search_hide_input" cookies :test #'string=))))
+    (if (member val '("yes" "no") :test #'string=) val "no")))
+
+(defun get-search-local-only-from-env (env)
+  "Retrieves the setting for forcing local search in current board (returns \"yes\" or \"no\", default \"no\")."
+  (let* ((headers (getf env :headers))
+         (cookie-str (and headers (gethash "cookie" headers)))
+         (cookies (parse-cookies cookie-str))
+         (val (cdr (assoc "search_local_only" cookies :test #'string=))))
+    (if (member val '("yes" "no") :test #'string=) val "no")))
+
+(defun get-search-position-from-env (env)
+  "Retrieves the setting for search input placement (returns \"top\" or \"bottom\", default \"top\")."
+  (let* ((headers (getf env :headers))
+         (cookie-str (and headers (gethash "cookie" headers)))
+         (cookies (parse-cookies cookie-str))
+         (val (cdr (assoc "search_position" cookies :test #'string=))))
+    (if (member val '("top" "bottom") :test #'string=) val "top")))
+
+(defun get-board-description (board-name)
+  "Maps a board-name string to a friendly human-readable title."
+  (cond
+    ((string= board-name "prog") "Programming")
+    ((string= board-name "foo") "Foo Reference")
+    ((string= board-name "b") "random") 
+    (t (string-capitalize board-name))))
+
+(defun generate-boards-html-list ()
+  (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*))
+         (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir)))
+         (boards (sort (mapcar (lambda (path)
+                                 (car (last (pathname-directory path))))
+                               paths)
+                       #'string<))
+         (html-list '()))
+    (dolist (b boards)
+      (push (format nil "<li><a href=\"/~a/\">/~a/ - ~a</a></li>" b b (get-board-description b)) html-list))
+    (format nil "<ul>~{~A~%~}</ul>" (nreverse html-list))))
+
+(defun authenticate-admin (env)
+  "Checks if the request has valid admin credentials in environment variables."
+  (let* ((admin-user (or (uiop:getenv "SBBS_ADMIN_USER") "admin"))
+         (admin-password (or (uiop:getenv "SBBS_ADMIN_PASSWORD") "superchanner"))
+         (headers (getf env :headers))
+         (auth-str (and headers (gethash "authorization" headers)))
+         (creds (and auth-str (cl-ppcre:regex-replace-all "^Basic " auth-str ""))))
+    (when creds
+      (let* ((decoded (handler-case (cl-base64:base64-string-to-string creds)
+                        (error () nil)))
+             (parts (and decoded (cl-ppcre:split ":" decoded :limit 2))))
+        (and (= (length parts) 2)
+             (string= (first parts) admin-user)
+             (string= (second parts) admin-password))))))
+
+(defun delete-board-dir (board)
+  (let ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*)))
+    (when (probe-file board-dir)
+      (uiop:delete-directory-tree board-dir :validate t))))
+
+(defun get-board-threads (dir)
+  (let ((threads nil))
+    (loop for i from 1
+          for filepath = (merge-pathnames (format nil "~D" i) dir)
+          for exists = (probe-file filepath)
+          while (or exists (<= i 200))
+          do (when exists
+               (let ((data (read-sexp-file filepath)))
+                 (when data
+                   (push (cons i data) threads)))))
+    threads))
+
+(defun search-posts (query &optional board-filter)
+  "Searches across all boards (or a specific board if BOARD-FILTER is provided) for posts or headlines matching QUERY."
+  (let ((results '())
+        (sexp-dir (merge-pathnames "sexp/" *base-dir*)))
+    (when (and query (string/= "" (string-trim '(#\Space #\Tab #\Newline #\Return) query)))
+      (let ((board-dirs (if (and board-filter (string/= "" board-filter))
+                            (list (merge-pathnames (format nil "~a/" board-filter) sexp-dir))
+                            (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir)))))
+        (dolist (board-dir board-dirs)
+          (let ((board-name (car (last (pathname-directory board-dir))))
+                ;; Get only files whose namestring consists only of digits (which are the thread S-expression files)
+                (thread-files (and (probe-file board-dir)
+                                   (remove-if-not (lambda (file)
+                                                    (let ((name (file-namestring file)))
+                                                      (and (string/= name "")
+                                                           (every #'digit-char-p name))))
+                                                  (uiop:directory-files board-dir)))))
+            (dolist (thread-file thread-files)
+              (let* ((thread-id (file-namestring thread-file))
+                     (thread-data (read-sexp-file thread-file))
+                     (raw-thread (if (and (consp thread-data)
+                                          (consp (car thread-data))
+                                          (consp (caar thread-data)))
+                                     (car thread-data)
+                                     thread-data))
+                     (headline (cdr (assoc 'cl-bbs/models:headline raw-thread)))
+                     (posts-assoc (assoc 'cl-bbs/models:posts raw-thread)))
+                (when posts-assoc
+                  (let ((posts (get-flat-posts posts-assoc)))
+                    (dolist (post posts)
+                      (let* ((post-id (car post))
+                             (post-data (cdr post))
+                             (content (cdr (assoc 'cl-bbs/models:content post-data)))
+                             (date (cdr (assoc 'cl-bbs/models:date post-data))))
+                        (when (or (and headline (search query headline :test #'char-equal))
+                                  (and content (search query content :test #'char-equal)))
+                          (push (list :board board-name
+                                      :thread-id thread-id
+                                      :headline (or headline "No Headline")
+                                      :post-id post-id
+                                      :date (or date "")
+                                      :content (or content ""))
+                                results))))))))))))
+    (nreverse results)))
+
+(defun get-flat-posts (posts-assoc)
+  (when posts-assoc
+    (let* ((cdr-val (cdr posts-assoc))
+           (cadr-val (and (listp cdr-val) (car cdr-val))))
+      (if (and (listp cadr-val) (listp (car cadr-val)))
+          cadr-val
+          cdr-val))))
+
+(defun regenerate-board-index (board)
+  (let* ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*))
+         (threads-data (get-board-threads board-dir)))
+    (if (null threads-data)
+        (let ((list-path (merge-pathnames "list" board-dir))
+              (index-path (merge-pathnames "index" board-dir)))
+          (when (probe-file list-path) (delete-file list-path))
+          (when (probe-file index-path) (delete-file index-path)))
+        (let* ((sorted-threads
+                (sort threads-data
+                      (lambda (a b)
+                        (let* ((raw-a (if (and (consp (cdr a)) (consp (cadr a)) (consp (caadr a))) (cadr a) (cdr a)))
+                               (raw-b (if (and (consp (cdr b)) (consp (cadr b)) (consp (caadr b))) (cadr b) (cdr b)))
+                               (posts-assoc-a (assoc 'cl-bbs/models:posts raw-a))
+                               (posts-assoc-b (assoc 'cl-bbs/models:posts raw-b))
+                               (posts-a (get-flat-posts posts-assoc-a))
+                               (posts-b (get-flat-posts posts-assoc-b))
+                               (date-a (or (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts-a))))) ""))
+                               (date-b (or (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts-b))))) "")))
+                          (string> date-a date-b)))))
+               (list-entries
+                (mapcar (lambda (t-entry)
+                          (let* ((id (car t-entry))
+                                 (t-data (cdr t-entry))
+                                 (raw-t (if (and (consp t-data)
+                                                 (consp (car t-data))
+                                                 (consp (caar t-data)))
+                                            (car t-data)
+                                            t-data))
+                                 (posts-assoc (assoc 'cl-bbs/models:posts raw-t))
+                                 (posts (get-flat-posts posts-assoc))
+                                 (headline (cdr (assoc 'cl-bbs/models:headline raw-t)))
+                                 (date (cdr (assoc 'cl-bbs/models:date (cdr (car (last posts))))))
+                                 (messages (length posts)))
+                            `(,id (cl-bbs/models:headline . ,headline)
+                                  (cl-bbs/models:date . ,date)
+                                  (cl-bbs/models:messages . ,messages))))
+                        sorted-threads))
+               (frontpage-count (min 10 (length sorted-threads)))
+               (index-entries
+                (mapcar (lambda (t-entry)
+                          (let* ((id (car t-entry))
+                                 (t-data (cdr t-entry))
+                                 (raw-t (if (and (consp t-data)
+                                                 (consp (car t-data))
+                                                 (consp (caar t-data)))
+                                            (car t-data)
+                                            t-data))
+                                 (headline (cdr (assoc 'cl-bbs/models:headline raw-t)))
+                                 (posts-assoc (assoc 'cl-bbs/models:posts raw-t))
+                                 (posts (get-flat-posts posts-assoc))
+                                 (truncated-ids (if (> (length posts) 6)
+                                                    (mapcar #'car (butlast (cdr posts) 5))
+                                                    nil))
+                                 (selected-posts (if (> (length posts) 6) (cons (car posts) (last posts 5)) posts)))
+                            `(,id (cl-bbs/models:headline . ,headline)
+                                  (cl-bbs/models:truncated . ,truncated-ids)
+                                  (cl-bbs/models:posts ,selected-posts))))
+                        (subseq sorted-threads 0 frontpage-count)))
+               (list-path (merge-pathnames "list" board-dir))
+               (index-path (merge-pathnames "index" board-dir)))
+          (write-sexp-file list-path list-entries)
+          (write-sexp-file index-path index-entries)))))
+
+(defun delete-thread-file (board thread-id)
+  (let ((filepath (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+    (when (probe-file filepath)
+      (delete-file filepath)
+      (regenerate-board-index board))))
+
+(defun get-next-handler-thread-id (board)
+  (let* ((board-dir (merge-pathnames (format nil "sexp/~a/" board) *base-dir*))
+         (files (and (probe-file board-dir)
+                     (uiop:directory-files board-dir)))
+         (max-id 0))
+    (dolist (file files)
+      (let ((id (handler-case (parse-integer (pathname-name file))
+                  (error () nil))))
+        (when (and id (> id max-id))
+          (setf max-id id))))
+    (1+ max-id)))
+
+(defun shame-thread-file (board thread-id)
+  (let* ((source-file (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*))
+         (target-board "shame")
+         (target-dir (merge-pathnames (format nil "sexp/~a/" target-board) *base-dir*)))
+    (when (and (probe-file source-file) (string-not-equal board target-board))
+      (ensure-directories-exist target-dir)
+      (let* ((new-id (get-next-handler-thread-id target-board))
+             (target-file (merge-pathnames (format nil "~D" new-id) target-dir)))
+        (uiop:copy-file source-file target-file)
+        (delete-file source-file)
+        (regenerate-board-index board)
+        (regenerate-board-index target-board)))))
+
+(defun delete-thread-comment (board thread-id comment-id)
+  (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+    (when (probe-file thread-path)
+      (let* ((thread-data (read-sexp-file thread-path))
+             (raw-thread (if (and (consp thread-data)
+                                  (consp (car thread-data))
+                                  (consp (caar thread-data)))
+                             (car thread-data)
+                             thread-data))
+             (posts-assoc (assoc 'cl-bbs/models:posts raw-thread)))
+        (when posts-assoc
+          (let* ((actual-posts (get-flat-posts posts-assoc))
+                 (new-posts (remove-if (lambda (p) (= (car p) comment-id)) actual-posts)))
+            (if (null new-posts)
+                (delete-file thread-path)
+                (progn
+                  (setf (cdr posts-assoc) (list new-posts))
+                  (write-sexp-file thread-path thread-data)))
+            (regenerate-board-index board)))))))
+
+(defun edit-thread-comment (board thread-id comment-id new-content &optional new-headline)
+  (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+    (when (probe-file thread-path)
+      (let* ((thread-data (read-sexp-file thread-path))
+             (raw-thread (if (and (consp thread-data)
+                                  (consp (car thread-data))
+                                  (consp (caar thread-data)))
+                             (car thread-data)
+                             thread-data))
+             (posts-assoc (assoc 'cl-bbs/models:posts raw-thread)))
+        (when posts-assoc
+          (let* ((actual-posts (get-flat-posts posts-assoc))
+                 (new-posts (mapcar (lambda (p)
+                                      (if (= (car p) comment-id)
+                                          (cons (car p)
+                                                (mapcar (lambda (kv)
+                                                          (if (eq (car kv) 'cl-bbs/models:content)
+                                                              (cons (car kv) new-content)
+                                                              kv))
+                                                        (cdr p)))
+                                          p))
+                                    actual-posts)))
+            (setf (cdr posts-assoc) (list new-posts))
+            (when (and (= comment-id 1) new-headline)
+              (let ((headline-assoc (assoc 'cl-bbs/models:headline raw-thread)))
+                (if headline-assoc
+                    (setf (cdr headline-assoc) new-headline)
+                    (setf raw-thread (append raw-thread (list (cons 'cl-bbs/models:headline new-headline)))))))
+            (write-sexp-file thread-path thread-data)
+            (regenerate-board-index board)))))))
+
+(defun get-date ()
+  (multiple-value-bind (second minute hour date month year)
+      (get-decoded-time)
+    (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
+            year month date hour minute second)))
+
+(defun get-next-thread-number (threads)
+  (if (null threads)
+      1
+      (1+ (apply #'max (mapcar #'car threads)))))
+
+(defun create-thread (path headline date message)
+  (let ((thread `((cl-bbs/models:headline . ,headline)
+                  (cl-bbs/models:posts . ((1 (cl-bbs/models:date . ,date)
+                                             (cl-bbs/models:vip . nil)
+                                             (cl-bbs/models:content . ,message)))))))
+    (write-sexp-file path thread)))
+
+(defun add-thread-to-list (path thread-number headline date)
+  (let ((threads (read-sexp-file path)))
+    (write-sexp-file path
+                     (cons `(,thread-number (cl-bbs/models:headline . ,headline)
+                                            (cl-bbs/models:date . ,date)
+                                            (cl-bbs/models:messages . 1))
+                           threads))))
+
+(defun add-thread-to-index (path thread-number headline date message)
+  (let ((threads (read-sexp-file path))
+        (thread `(,thread-number
+                    (cl-bbs/models:headline . ,headline)
+                    (cl-bbs/models:truncated . nil)
+                    (cl-bbs/models:posts
+                     ((1 (cl-bbs/models:date . ,date)
+                         (cl-bbs/models:vip . nil)
+                         (cl-bbs/models:content . ,message)))))))
+    (write-sexp-file path (cons thread threads))))
+
+(defun update-thread-data (thread-data new-post)
+  (let* ((raw-thread (if (and (consp thread-data)
+                             (consp (car thread-data))
+                             (consp (caar thread-data)))
+                         (car thread-data)
+                         thread-data))
+         (posts-assoc (assoc 'cl-bbs/models:posts raw-thread)))
+    (if posts-assoc
+        (let* ((posts-list (if (listp (cdr posts-assoc))
+                               (if (listp (cadr posts-assoc))
+                                   (cadr posts-assoc)
+                                   (cdr posts-assoc))
+                               (cdr posts-assoc)))
+               (actual-posts (if (listp (car posts-list)) posts-list (list posts-list)))
+               (updated-posts (append actual-posts (list new-post))))
+          (setf (cdr posts-assoc) (list updated-posts))
+          thread-data)
+        (append thread-data (list `(cl-bbs/models:posts (,new-post)))))))
+
+(defvar *app* (make-instance 'ningle:<app>))
+
+(defun normalize-path (path)
+  (if (stringp path)
+      (let ((len (length path)))
+        (if (and (> len 1)
+                 (char= (char path (1- len)) #\/))
+            (subseq path 0 (1- len))
+            path))
+      path))
+
+(defun get-body-params (params env)
+  (let ((has-theme (assoc "theme" params :test #'string=))
+        (has-epistula (assoc "epistula" params :test #'string=))
+        (has-action (assoc "action" params :test #'string=)))
+    (if (or has-theme has-epistula has-action)
+        params
+        (let ((content-len (getf env :content-length)))
+          (if (and content-len (> content-len 0) (getf env :raw-body))
+              (let ((body-bytes (make-array content-len :element-type '(unsigned-byte 8)))
+                    (stream (getf env :raw-body)))
+                (let ((bytes-read (read-sequence body-bytes stream)))
+                  (let ((body-str (flexi-streams:octets-to-string
+                                   body-bytes :start 0 :end bytes-read :external-format :utf-8)))
+                    (quri:url-decode-params body-str))))
+              params)))))
+
+(defun handle-request (env)
+  "Accepts a Clack request environment plist, normalizes it, and dispatches it through ningle endpoints."
+  (let ((normalized-env (copy-list env)))
+    (setf (getf normalized-env :path-info) (normalize-path (getf env :path-info)))
+    (unless (hash-table-p (getf normalized-env :headers))
+      (setf (getf normalized-env :headers) (make-hash-table :test 'equal)))
+    (when (getf normalized-env :request-method)
+      (setf (getf normalized-env :request-method)
+            (intern (string-upcase (symbol-name (getf normalized-env :request-method))) :keyword)))
+    (let ((cl-bbs/views:*preferences* (cl-bbs/views:make-preferences
+                                       :theme (get-theme-from-env normalized-env)
+                                       :syntax-theme (get-syntax-theme-from-env normalized-env)
+                                       :default-board (or (get-default-board-from-env normalized-env) "")
+                                       :search-hide-input (get-search-hide-input-from-env normalized-env)
+                                       :search-local-only (get-search-local-only-from-env normalized-env)
+                                       :search-position (get-search-position-from-env normalized-env))))
+      (lack.component:call *app* normalized-env))))
+
+(defun render-main-index ()
+  (let ((index-file (pathname (or (uiop:getenv "SBBS_INDEX_FILE")
+                                  (merge-pathnames "src/static/index.html"
+                                                   (asdf:system-source-directory :cl-bbs/server))))))
+    (if (probe-file index-file)
+        (let* ((html-content (uiop:read-file-string index-file))
+               (boards-list-html (generate-boards-html-list))
+               (dynamic-html (cl-ppcre:regex-replace-all "<!--BOARDS-LIST-PLACEHOLDER-->"
+                                                        html-content
+                                                        (lambda (match &rest regs)
+                                                          (declare (ignore match regs))
+                                                          boards-list-html))))
+          `(200 (:content-type "text/html; charset=utf-8"
+                 :cache-control "no-store, no-cache, must-revalidate, max-age=0"
+                 :pragma "no-cache"
+                 :expires "0")
+                (,dynamic-html)))
+        `(200 (:content-type "text/plain"
+               :cache-control "no-store, no-cache, must-revalidate, max-age=0"
+               :pragma "no-cache"
+               :expires "0") ("SchemeBBS clone root")))))
+
+;; 1. GET /
+(setf (ningle:route *app* "/" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (let* ((env (lack.request:request-env ningle:*request*))
+               (default-board (get-default-board-from-env env)))
+          (if default-board
+              `(303 (:location ,(format nil "/~a/" default-board)) ("Redirecting..."))
+              (render-main-index)))))
+
+;; 1b. GET /index.html
+(setf (ningle:route *app* "/index.html" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (render-main-index)))
+
+;; 2. GET /about
+(setf (ningle:route *app* "/about" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (let ((about-file (pathname (merge-pathnames "src/static/about.html"
+                                                     (asdf:system-source-directory :cl-bbs/server)))))
+          (if (probe-file about-file)
+              `(200 (:content-type "text/html; charset=utf-8")
+                    (,(uiop:read-file-string about-file)))
+              `(404 (:content-type "text/plain") ("About page not found"))))))
+
+;; 3. GET /admin (Admin Control Panel)
+(setf (ningle:route *app* "/admin" :method :GET)
+      (lambda (params)
+        (let ((env (lack.request:request-env ningle:*request*)))
+          (if (not (authenticate-admin env))
+              `(401 (:content-type "text/plain"
+                     :www-authenticate "Basic realm=\"cl-bbs Admin\"")
+                    ("Unauthorized"))
+              (let* ((sexp-dir (merge-pathnames "sexp/" *base-dir*))
+                     (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir)))
+                     (boards (sort (mapcar (lambda (path) (car (last (pathname-directory path)))) paths) #'string<))
+                     (board (cdr (assoc "board" params :test #'string=)))
+                     (thread-id-str (cdr (assoc "thread" params :test #'string=)))
+                     (threads nil)
+                     (comments nil)
+                     (headline nil))
+                (when (and board (member board boards :test #'string=))
+                  (let ((list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*)))
+                    (when (probe-file list-path)
+                      (setf threads (read-sexp-file list-path)))))
+                (when (and board thread-id-str)
+                  (let ((thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id-str) *base-dir*)))
+                    (when (probe-file thread-path)
+                      (let* ((thread-data (read-sexp-file thread-path))
+                             (raw-thread (if (and (consp thread-data)
+                                                  (consp (car thread-data))
+                                                  (consp (caar thread-data)))
+                                             (car thread-data)
+                                             thread-data))
+                             (posts-assoc (assoc 'cl-bbs/models:posts raw-thread)))
+                        (setf headline (cdr (assoc 'cl-bbs/models:headline raw-thread)))
+                        (when posts-assoc
+                          (setf comments (get-flat-posts posts-assoc)))))))
+                `(200 (:content-type "text/html; charset=utf-8")
+                      (,(render-moderation boards board threads thread-id-str comments
+                                           cl-bbs/views:*preferences* headline))))))))
+
+;; 4. POST /admin/action (Admin Actions)
+(setf (ningle:route *app* "/admin/action" :method :POST)
+      (lambda (params)
+        (let* ((env (lack.request:request-env ningle:*request*))
+               (parsed-params (get-body-params params env)))
+          (if (not (authenticate-admin env))
+              `(401 (:content-type "text/plain"
+                     :www-authenticate "Basic realm=\"cl-bbs Admin\"")
+                    ("Unauthorized"))
+              (let ((action (cdr (assoc "action" parsed-params :test #'string=)))
+                    (board (cdr (assoc "board" parsed-params :test #'string=)))
+                    (thread-id-str (cdr (assoc "thread" parsed-params :test #'string=)))
+                    (comment-id-str (cdr (assoc "comment" parsed-params :test #'string=)))
+                    (content (cdr (assoc "content" parsed-params :test #'string=))))
+                (cond
+                  ((string= action "delete-board")
+                   (delete-board-dir board)
+                   `(303 (:location "/admin") ("Redirecting...")))
+                  ((string= action "create-board")
+                   (let ((sanitized (sanitize-board-name board)))
+                     (if sanitized
+                         (progn
+                           (ensure-board-dirs sanitized)
+                           `(303 (:location "/admin") ("Redirecting...")))
+                         `(400 (:content-type "text/plain") ("Invalid Board Name")))))
+                  ((string= action "delete-thread")
+                   (delete-thread-file board thread-id-str)
+                   `(303 (:location ,(format nil "/admin?board=~a" board)) ("Redirecting...")))
+                  ((string= action "shame-thread")
+                   (shame-thread-file board thread-id-str)
+                   `(303 (:location ,(format nil "/admin?board=~a" board)) ("Redirecting...")))
+                  ((string= action "delete-comment")
+                   (let ((cid (and comment-id-str (parse-integer comment-id-str :junk-allowed t))))
+                     (when cid
+                       (delete-thread-comment board thread-id-str cid)))
+                   `(303 (:location ,(format nil "/admin?board=~a&thread=~a" board thread-id-str)) ("Redirecting...")))
+                  ((string= action "edit-comment")
+                   (let ((cid (and comment-id-str (parse-integer comment-id-str :junk-allowed t)))
+                         (headline (cdr (assoc "headline" parsed-params :test #'string=))))
+                     (when cid
+                       (edit-thread-comment board thread-id-str cid content headline)))
+                   `(303 (:location ,(format nil "/admin?board=~a&thread=~a" board thread-id-str)) ("Redirecting...")))
+                  (t
+                   `(400 (:content-type "text/plain") ("Invalid Action")))))))))
+
+;; 5. GET /sw.js
+(setf (ningle:route *app* "/sw.js" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (let ((sw-file (merge-pathnames "src/static/sw.js"
+                                        (asdf:system-source-directory :cl-bbs/server))))
+          (if (probe-file sw-file)
+              `(200 (:content-type "application/javascript")
+                    (,(uiop:read-file-string sw-file)))
+              `(404 (:content-type "text/plain") ("Service worker not found"))))))
+
+;; 6. GET /manifest.json
+(setf (ningle:route *app* "/manifest.json" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (let ((manifest-file (merge-pathnames "src/static/manifest.json"
+                                              (asdf:system-source-directory :cl-bbs/server))))
+          (if (probe-file manifest-file)
+              `(200 (:content-type "application/json")
+                    (,(uiop:read-file-string manifest-file)))
+              `(404 (:content-type "text/plain") ("Manifest not found"))))))
+
+;; 6b. GET /search
+(setf (ningle:route *app* "/search" :method :GET)
+      (lambda (params)
+        (let* ((query (cdr (assoc "q" params :test #'string=)))
+               (board-filter (cdr (assoc "board" params :test #'string=)))
+               (results (if query (search-posts query board-filter) nil)))
+          `(200 (:content-type "text/html; charset=utf-8")
+                (,(render-search-results (or query "") results cl-bbs/views:*preferences*))))))
+
+;; 6b-api. POST /api/colorize
+(setf (ningle:route *app* "/api/colorize" :method :POST)
+      (lambda (params)
+        (let* ((env (lack.request:request-env ningle:*request*))
+               (parsed-params (get-body-params params env))
+               (code (cdr (assoc "code" parsed-params :test #'string=))))
+          (if code
+              `(200 (:content-type "text/html; charset=utf-8")
+                    (,(handler-case (colorize:html-colorization :common-lisp code)
+                        (error () (cl-who:escape-string code)))))
+              `(400 (:content-type "text/plain") ("No code provided"))))))
+
+;; 6c. GET /playground (Global Playground)
+(setf (ningle:route *app* "/playground" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        `(200 (:content-type "text/html; charset=utf-8")
+              (,(render-playground nil)))))
+
+;; 6d. GET /:board/playground (Board-scoped Playground)
+(setf (ningle:route *app* "/:board/playground" :method :GET)
+      (lambda (params)
+        (let ((board (cdr (assoc :board params))))
+          `(200 (:content-type "text/html; charset=utf-8")
+                (,(render-playground board))))))
+
+;; 7. GET /:board/list
+(setf (ningle:route *app* "/:board/list" :method :GET)
+      (lambda (params)
+        (let* ((board (cdr (assoc :board params)))
+               (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*)))
+          (if (probe-file list-path)
+              (let ((list-data (read-sexp-file list-path)))
+                `(200 (:content-type "text/html; charset=utf-8")
+                      (,(render-list board list-data cl-bbs/views:*preferences*))))
+              `(200 (:content-type "text/html; charset=utf-8")
+                    (,(render-list board nil cl-bbs/views:*preferences*)))))))
+
+;; 8. GET /:board/preferences
+(setf (ningle:route *app* "/:board/preferences" :method :GET)
+      (lambda (params)
+        (let ((board (cdr (assoc :board params))))
+          `(200 (:content-type "text/html; charset=utf-8")
+                (,(render-preferences board cl-bbs/views:*preferences*))))))
+
+;; 9. POST /:board/preferences
+(setf (ningle:route *app* "/:board/preferences" :method :POST)
+      (lambda (params)
+        (let* ((env (lack.request:request-env ningle:*request*))
+               (parsed-params (get-body-params params env))
+               (board (cdr (assoc :board params)))
+               (theme (cdr (assoc "theme" parsed-params :test #'string=)))
+               (syntax-theme (cdr (assoc "syntax_theme" parsed-params :test #'string=)))
+               (default-board (let ((val (cdr (assoc "default_board" parsed-params :test #'string=))))
+                                (if val (string-trim '(#\Space #\Tab #\Newline #\Return) val) "")))
+               (search-hide-input (let ((val (cdr (assoc "search_hide_input" parsed-params :test #'string=))))
+                                    (if (member val '("yes" "no") :test #'string=) val "no")))
+               (search-local-only (let ((val (cdr (assoc "search_local_only" parsed-params :test #'string=))))
+                                    (if (member val '("yes" "no") :test #'string=) val "no")))
+               (search-position (let ((val (cdr (assoc "search_position" parsed-params :test #'string=))))
+                                  (if (member val '("top" "bottom") :test #'string=) val "top"))))
+          `(303 (:location ,(format nil "/~a/preferences" board)
+                 :set-cookie ,(format nil "theme=~a; Path=/; Max-Age=31536000" (or theme "default"))
+                 :set-cookie ,(format nil "syntax_theme=~a; Path=/; Max-Age=31536000" (or syntax-theme "simple"))
+                 :set-cookie ,(format nil "default_board=~a; Path=/; Max-Age=31536000" (or default-board ""))
+                 :set-cookie ,(format nil "search_hide_input=~a; Path=/; Max-Age=31536000" search-hide-input)
+                 :set-cookie ,(format nil "search_local_only=~a; Path=/; Max-Age=31536000" search-local-only)
+                 :set-cookie ,(format nil "search_position=~a; Path=/; Max-Age=31536000" search-position))
+                ("Redirecting...")))))
+
+;; RSS Feed (All boards)
+(setf (ningle:route *app* "/rss" :method :GET)
+      (lambda (params)
+        (declare (ignore params))
+        (let ((env (lack.request:request-env ningle:*request*))
+              (all-threads (cl-bbs/rss:get-all-boards-rss-threads 20)))
+          (list 200 '(:content-type "application/rss+xml; charset=utf-8")
+                (list (cl-bbs/rss:generate-rss "all" all-threads env))))))
+
+;; RSS Feed (Specific board)
+(setf (ningle:route *app* "/:board/rss" :method :GET)
+      (lambda (params)
+        (let* ((board (cdr (assoc :board params)))
+               (env (lack.request:request-env ningle:*request*))
+               (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*))
+               (threads (when (probe-file list-path) (read-sexp-file list-path))))
+          (list 200 '(:content-type "application/rss+xml; charset=utf-8")
+                (list (cl-bbs/rss:generate-rss board threads env))))))
+
+;; 10. POST /:board/post (New Thread)
+(setf (ningle:route *app* "/:board/post" :method :POST)
+      (lambda (params)
+        (block out
+          (let* ((board (cdr (assoc :board params)))
+               (env (lack.request:request-env ningle:*request*))
+               (parsed-params (get-body-params params env))
+               (epistula (cdr (assoc "epistula" parsed-params :test #'string=)))
+               (titulus (cdr (assoc "titulus" parsed-params :test #'string=)))
+               (date (get-date))
+               (list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*))
+               (index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*))
+               (threads (read-sexp-file list-path))
+               (thread-number (get-next-thread-number threads))
+               (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-number) *base-dir*)))
+          (cond
+            ((or (null epistula)
+                 (string= "" (string-trim '(#\Space #\Tab #\Newline #\Return) epistula)))
+             `(400 (:content-type "text/html; charset=utf-8")
+                   (,(render-error-page "Post body cannot be empty" cl-bbs/views:*preferences*))))
+            ((and titulus (> (length titulus) *headline-limit*))
+             `(400 (:content-type "text/html; charset=utf-8")
+                   (,(render-error-page (format nil "Headline exceeds maximum length of ~D characters" *headline-limit*)
+                                        cl-bbs/views:*preferences*))))
+            ((and epistula (> (length epistula) *body-limit*))
+             `(400 (:content-type "text/html; charset=utf-8")
+                   (,(render-error-page (format nil "Post body exceeds maximum length of ~D characters" *body-limit*)
+                                        cl-bbs/views:*preferences*))))
+            (t
+             (progn
+                (when (is-board-locked board)
+                  (return-from out
+                    `(403 (:content-type "text/html; charset=utf-8")
+                          (,(render-error-page "This board is read-only"
+                                               cl-bbs/views:*preferences*)))))
+                (unless (probe-file (merge-pathnames (format nil "sexp/~a/" board) *base-dir*))
+                   (return-from out
+                     `(403 (:content-type "text/html; charset=utf-8")
+                           (,(render-error-page "Only administrators can create new boards"
+                                                cl-bbs/views:*preferences*)))))
+                (ensure-board-dirs board)
+                (create-thread thread-path titulus date epistula)
+                (add-thread-to-list list-path thread-number titulus date)
+                (add-thread-to-index index-path thread-number titulus date epistula)
+                `(303 (:location ,(format nil "/~a/" board)) ("Redirecting...")))))))))
+
+;; 11. GET /:board
+(setf (ningle:route *app* "/:board" :method :GET)
+      (lambda (params)
+        (let* ((board (cdr (assoc :board params)))
+               (index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*)))
+          (if (probe-file index-path)
+              (let ((index-data (read-sexp-file index-path)))
+                `(200 (:content-type "text/html; charset=utf-8")
+                      (,(render-index board index-data cl-bbs/views:*preferences*))))
+              `(200 (:content-type "text/html; charset=utf-8")
+                    (,(render-index board nil cl-bbs/views:*preferences*)))))))
+
+;; 12. GET /:board/:thread_id
+(setf (ningle:route *app* "/:board/:thread_id" :method :GET)
+      (lambda (params)
+        (let* ((board (cdr (assoc :board params)))
+               (thread-id (cdr (assoc :thread_id params)))
+               (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+          (if (probe-file thread-path)
+              (let ((thread-data (read-sexp-file thread-path)))
+                `(200 (:content-type "text/html; charset=utf-8")
+                      (,(render-thread board thread-id thread-data nil cl-bbs/views:*preferences*))))
+              `(404 (:content-type "text/plain") ("Thread not found"))))))
+
+;; 13. POST /:board/:thread_id/post (Reply to Thread)
+(setf (ningle:route *app* "/:board/:thread_id/post" :method :POST)
+      (lambda (params)
+        (block out
+          (let* ((board (cdr (assoc :board params)))
+                 (thread-id (cdr (assoc :thread_id params)))
+                 (env (lack.request:request-env ningle:*request*))
+                 (parsed-params (get-body-params params env))
+                 (epistula (cdr (assoc "epistula" parsed-params :test #'string=)))
+                 (date (get-date))
+                 (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+            (cond
+              ((or (null epistula)
+                   (string= "" (string-trim '(#\Space #\Tab #\Newline #\Return) epistula)))
+               `(400 (:content-type "text/html; charset=utf-8")
+                     (,(render-error-page "Post body cannot be empty" cl-bbs/views:*preferences*))))
+              ((and epistula (> (length epistula) *body-limit*))
+               `(400 (:content-type "text/html; charset=utf-8")
+                     (,(render-error-page (format nil "Post body exceeds maximum length of ~D characters" *body-limit*)
+                                          cl-bbs/views:*preferences*))))
+              (t
+               (progn
+                  (when (is-board-locked board)
+                    (return-from out
+                      `(403 (:content-type "text/html; charset=utf-8")
+                            (,(render-error-page "This board is read-only" cl-bbs/views:*preferences*)))))
+                  (if (probe-file thread-path)
+                      (let* ((thread-data (read-sexp-file thread-path))
+                             (raw-thread (if (and (consp thread-data)
+                                                  (consp (car thread-data))
+                                                  (consp (caar thread-data)))
+                                             (car thread-data)
+                                             thread-data))
+                             (posts-assoc (let ((assoc-res (assoc 'cl-bbs/models:posts raw-thread)))
+                                            (if assoc-res
+                                                assoc-res
+                                                (cadr (if (consp thread-data)
+                                                          thread-data
+                                                          (list thread-data))))))
+                             (posts-list (if (listp (cdr posts-assoc))
+                                             (if (listp (cadr posts-assoc))
+                                                 (cadr posts-assoc)
+                                                 (cdr posts-assoc))
+                                             (cdr posts-assoc)))
+                             (posts (if (listp (car posts-list)) posts-list (list posts-list)))
+                             (new-post `(,(1+ (reduce #'max posts :key #'car :initial-value 0))
+                                         (cl-bbs/models:date . ,date)
+                                         (cl-bbs/models:vip . nil)
+                                         (cl-bbs/models:content . ,epistula)))
+                             (new-thread-data (update-thread-data thread-data new-post)))
+                        (write-sexp-file thread-path new-thread-data)
+                        (let* ((list-path (merge-pathnames (format nil "sexp/~a/list" board) *base-dir*))
+                               (threads-list (read-sexp-file list-path))
+                               (str-id (if (stringp thread-id) (parse-integer thread-id) thread-id))
+                               (target-thread-assoc (assoc str-id threads-list)))
+                          (when target-thread-assoc
+                            (let* ((rem-threads (remove str-id threads-list :key #'car :test #'equal))
+                                   (raw-new-thread (if (and (consp new-thread-data)
+                                                            (consp (car new-thread-data))
+                                                            (consp (caar new-thread-data)))
+                                                       (car new-thread-data)
+                                                       new-thread-data))
+                                   (messages-count (length (cadr (assoc 'cl-bbs/models:posts raw-new-thread))))
+                                   (headline-val (if (stringp (cdr (assoc 'cl-bbs/models:headline
+                                                                          (cdr target-thread-assoc))))
+                                                     (cdr (assoc 'cl-bbs/models:headline
+                                                                 (cdr target-thread-assoc)))
+                                                     (cdr (assoc 'headline (cdr target-thread-assoc)))))
+                                   (updated-entry `(,str-id
+                                                     (cl-bbs/models:headline . ,headline-val)
+                                                     (cl-bbs/models:date . ,date)
+                                                     (cl-bbs/models:messages . ,messages-count))))
+                              (write-sexp-file list-path (cons updated-entry rem-threads))))
+                          (let* ((index-path (merge-pathnames (format nil "sexp/~a/index" board) *base-dir*))
+                                 (index-list (read-sexp-file index-path))
+                                 (target-index-assoc (assoc str-id index-list)))
+                            (when target-index-assoc
+                              (let* ((rem-index (remove str-id index-list :key #'car :test #'equal))
+                                     (raw-new-thread (if (and (consp new-thread-data)
+                                                              (consp (car new-thread-data))
+                                                              (consp (caar new-thread-data)))
+                                                         (car new-thread-data)
+                                                         new-thread-data))
+                                     (headline-val (if (stringp (cdr (assoc 'cl-bbs/models:headline
+                                                                            (cdr target-index-assoc))))
+                                                       (cdr (assoc 'cl-bbs/models:headline
+                                                                   (cdr target-index-assoc)))
+                                                       (cdr (assoc 'headline (cdr target-index-assoc)))))
+                                     (actual-posts (get-flat-posts (assoc 'cl-bbs/models:posts raw-new-thread)))
+                                     (truncated-ids (if (> (length actual-posts) 6)
+                                                        (mapcar #'car (butlast (cdr actual-posts) 5))
+                                                        nil))
+                                     (updated-entry `(,str-id
+                                                       (cl-bbs/models:headline . ,headline-val)
+                                                       (cl-bbs/models:truncated . ,truncated-ids)
+                                                       (cl-bbs/models:posts
+                                                        ,(if (> (length actual-posts) 6)
+                                                            (cons (car actual-posts) (last actual-posts 5))
+                                                            actual-posts)))))
+                               (write-sexp-file index-path (cons updated-entry rem-index))))))
+                        `(303 (:location ,(format nil "/~a/" board)) ("Redirecting...")))
+                      `(404 (:content-type "text/plain") ("Thread not found"))))))))))
+
+;; 14. GET /:board/:thread_id/:range (Thread Comments with Range)
+(setf (ningle:route *app* "/:board/:thread_id/:range" :method :GET)
+      (lambda (params)
+        (let* ((board (cdr (assoc :board params)))
+               (thread-id (cdr (assoc :thread_id params)))
+               (range-str (cdr (assoc :range params)))
+               (thread-path (merge-pathnames (format nil "sexp/~a/~a" board thread-id) *base-dir*)))
+          (if (probe-file thread-path)
+              (let ((thread-data (read-sexp-file thread-path)))
+                `(200 (:content-type "text/html; charset=utf-8")
+                      (,(render-thread board thread-id thread-data range-str cl-bbs/views:*preferences*))))
+              `(404 (:content-type "text/plain") ("Thread not found"))))))