path: root/server/admin.lisp

(defpackage :cl-bbs-admin
  (:use :cl)
  (:export #:main))

(in-package :cl-bbs-admin)

(defun expand-tilde (path)
  (if (and (>= (length path) 2) (string= (subseq path 0 2) "~/"))
      (concatenate 'string (namestring (user-homedir-pathname)) (subseq path 2))
      path))

(defun get-data-dir ()
  (let ((env (uiop:getenv "SBBS_DATADIR")))
    (if (and env (not (string= env "")))
        (namestring (uiop:ensure-absolute-pathname (expand-tilde env) (uiop:getcwd)))
        (let ((root-dir (asdf:system-source-directory :cl-bbs/server)))
          (if root-dir
              (namestring (merge-pathnames "data/" root-dir))
              (namestring (merge-pathnames "bbs/" (user-homedir-pathname))))))))

(defun lookup-def (key alist)
  (let ((p (assoc key alist :test (lambda (k1 k2) (string-equal (string k1) (string k2))))))
    (if p
        (let ((res (cdr p)))
          (cond ((string-equal (string key) "posts") res)
                ((not (consp res)) res)
                ((null (cdr res)) (car res))
                (t res)))
        nil)))

(defun last-element (lst)
  (car (last lst)))

(defun take-right (lst n)
  (let ((len (length lst)))
    (if (<= len n)
        lst
        (nthcdr (- len n) lst))))

(defun take (lst n)
  (if (or (null lst) (<= n 0))
      nil
      (cons (car lst) (take (cdr lst) (1- n)))))

(defun latest-posts (posts)
  (if (> (length posts) 6)
      `((cl-bbs/models:truncated . ,(mapcar #'car (butlast (cdr posts) 5)))
        (cl-bbs/models:posts ,(cons (car posts) (take-right posts 5))))
      `((cl-bbs/models:truncated . nil) (cl-bbs/models:posts ,posts))))

(defun get-flat-posts (posts)
  (when posts
    (let* ((cdr-val posts)
           (cadr-val (and (listp cdr-val) (car cdr-val))))
      (if (and (listp cadr-val) (listp (car cadr-val)))
          cadr-val
          cdr-val))))

(defun build-list-entry (t-entry)
  (let* ((id (car t-entry))
         (thread-data (cdr t-entry))
         (headline (lookup-def 'cl-bbs/models:headline thread-data))
         (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts thread-data)))
         (last-post (last-element posts))
         (date (lookup-def 'cl-bbs/models:date (cdr last-post)))
         (messages (length posts)))
    `(,id (cl-bbs/models:headline . ,headline) (cl-bbs/models:date . ,date) (cl-bbs/models:messages . ,messages))))

(defun build-index-entry (t-entry)
  (let* ((id (car t-entry))
         (thread-data (cdr t-entry))
         (headline (lookup-def 'cl-bbs/models:headline thread-data))
         (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts thread-data))))
    `(,id (cl-bbs/models:headline . ,headline) . ,(latest-posts posts))))

(defun read-sexp-file (path)
  (with-open-file (stream path :direction :input :if-does-not-exist nil)
    (if stream
        (let ((*read-eval* nil))
          (read stream nil nil))
        nil)))

(defun write-sexp-file (path data)
  (with-open-file (stream path :direction :output :if-exists :supersede
                               :if-does-not-exist :create
                               :external-format :utf-8)
    (write data :stream stream :pretty t)
    (terpri stream)))

(defun get-threads (dir)
  (let ((threads nil))
    (loop for i from 1
          for misses = 0 then (if exists 0 (1+ misses))
          for filepath = (format nil "~A~D" dir i)
          for exists = (probe-file filepath)
          while (<= misses 200)
          do (when exists
               (let ((data (read-sexp-file filepath)))
                 (when data
                   (push (cons i data) threads)))))
    threads))

(defun generate-index (board)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (dir (format nil "~A/sexp/~A/" data-dir board))
         (threads-data (get-threads dir)))
    (unless threads-data
      (format t "No threads found for board ~A.~%" board)
      (return-from generate-index nil))
    (let* ((sorted-threads
            (sort threads-data
                  (lambda (a b)
                    (let* ((posts-a (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr a))))
                           (posts-b (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr b))))
                           (date-a (or (lookup-def 'cl-bbs/models:date (cdr (last-element posts-a))) ""))
                           (date-b (or (lookup-def 'cl-bbs/models:date (cdr (last-element posts-b))) "")))
                      (string> date-a date-b)))))
           (list-entries (mapcar #'build-list-entry sorted-threads))
           (frontpage-count 10)
           (index-entries (mapcar #'build-index-entry
                                  (if (> (length sorted-threads) frontpage-count)
                                      (take sorted-threads frontpage-count)
                                      sorted-threads)))
           (list-path (format nil "~Alist" dir))
           (index-path (format nil "~Aindex" dir)))
      (write-sexp-file list-path list-entries)
      (write-sexp-file index-path index-entries)
      (format t "Generated list and index for ~A~%" board))))

(defun get-iso-datetime ()
  (multiple-value-bind (second minute hour date month year)
      (get-decoded-time)
    (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
            year month date hour minute second)))

(defun read-backup-metadata (archive-name)
  (let ((output (make-string-output-stream)))
    (handler-case
        (progn
          (uiop:run-program (list "tar" "-xzf" archive-name "-O" "metadata.txt")
                            :output output :error-output nil)
          (string-trim '(#\Space #\Tab #\Newline #\Return) (get-output-stream-string output)))
      (error () ""))))

(defun list-backups ()
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (backup-dir (format nil "~A/backup" data-dir))
         (backups (and (probe-file backup-dir)
                       (sort (directory (format nil "~A/*.tar.gz" backup-dir))
                             #'string> :key #'namestring))))
    (if backups
        (progn
          (format t "Available backups:~%")
          (dolist (b backups)
            (let ((meta (read-backup-metadata (namestring b))))
              (format t "  ~A ~A~%" (file-namestring b)
                      (if (and meta (not (string= meta "")))
                          (format nil "- ~A" meta)
                          "")))))
        (format t "No backups found.~%"))))

(defun ask-confirmation (prompt)
  (format t "~A [y/N]: " prompt)
  (force-output)
  (let ((response (read-line *standard-input* nil "")))
    (or (string-equal response "y")
        (string-equal response "yes"))))

(defun backup (&optional arg1)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (backup-dir (format nil "~A/backup" data-dir))
         (is-filename (and arg1 (uiop:string-suffix-p arg1 ".tar.gz")))
         (message (if is-filename nil arg1))
         (archive-name (if is-filename
                           arg1
                           (format nil "~A/sbbs-~A.tar.gz" backup-dir (get-iso-datetime))))
         (metadata-file (format nil "~A/metadata.txt" backup-dir)))
    (ensure-directories-exist (format nil "~A/" backup-dir))
    (when message
      (with-open-file (stream metadata-file :direction :output :if-does-not-exist :create :if-exists :supersede)
        (write-line message stream)))
    (if message
        (uiop:run-program (list "tar" "-czf" archive-name "-C" data-dir "sexp" "-C" backup-dir "metadata.txt")
                          :output *standard-output* :error-output *error-output*)
        (uiop:run-program (list "tar" "-czf" archive-name "-C" data-dir "sexp")
                          :output *standard-output* :error-output *error-output*))
    (when (and message (probe-file metadata-file))
      (delete-file metadata-file))
    (format t "Backup created: ~A~%" archive-name)))

(defun restore (&optional archive-name)
  (if archive-name
      (let* ((data-dir (string-right-trim "/" (get-data-dir)))
             (backup-dir (format nil "~A/backup" data-dir))
             (archive-path (if (probe-file archive-name)
                               archive-name
                               (format nil "~A/~A" backup-dir archive-name))))
        (if (probe-file archive-path)
            (progn
              (uiop:run-program (list "tar" "-xzf" archive-path "-C" data-dir)
                                :output *standard-output* :error-output *error-output*)
              (format t "Restore completed from: ~A~%" archive-path))
            (format t "Archive not found: ~A~%" archive-name)))
      (list-backups)))

(defun remove-post (board post-id)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id)))
    (if (probe-file sexp-file)
        (let* ((data (read-sexp-file sexp-file))
               (headline (lookup-def 'cl-bbs/models:headline data))
               (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
               (first-post (car posts))
               (date (lookup-def 'cl-bbs/models:date (cdr first-post)))
               (content (lookup-def 'cl-bbs/models:content (cdr first-post))))
          (format t "Post Headline: ~A~%" headline)
          (format t "Post Date: ~A~%" date)
          (format t "Post Content:~%~A~%" content)
          (when (ask-confirmation (format nil "Are you sure you want to remove thread ~A?" post-id))
            (backup (format nil "Before removing thread ~A from board ~A" post-id board))
            (delete-file sexp-file)
            (format t "Removed thread ~A.~%" sexp-file)
            (generate-index board)))
        (format t "Thread ~A does not exist.~%" sexp-file))))

(defun remove-comment (board post-id comment-id-str)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id))
         (comment-id (parse-integer comment-id-str :junk-allowed t)))
    (unless (probe-file sexp-file)
      (format t "Thread ~A does not exist.~%" sexp-file)
      (return-from remove-comment nil))
    (let* ((data (read-sexp-file sexp-file))
           (headline (lookup-def 'cl-bbs/models:headline data))
           (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
           (comment (find comment-id posts :key #'car)))
      (if (not comment)
          (format t "Comment ~A not found in thread ~A.~%" comment-id post-id)
          (let ((comment-content (lookup-def 'cl-bbs/models:content (cdr comment)))
                (comment-date (lookup-def 'cl-bbs/models:date (cdr comment))))
            (format t "Post Headline: ~A~%" headline)
            (format t "Comment Date: ~A~%" comment-date)
            (format t "Comment Content:~%~A~%" comment-content)
            (when (ask-confirmation (format nil "Are you sure you want to remove comment ~A from thread ~A?"
                                            comment-id post-id))
              (backup (format nil "Before removing comment ~A from thread ~A on board ~A" comment-id post-id board))
              (let ((new-posts (remove-if (lambda (p) (= (car p) comment-id)) posts)))
                (if (null new-posts)
                    (progn
                      (when (probe-file sexp-file) (delete-file sexp-file))
                      (format t "Removed thread ~A entirely as it has no remaining comments.~%" post-id))
                    (progn
                      (write-sexp-file sexp-file `((cl-bbs/models:headline . ,headline)
                                                   (cl-bbs/models:posts ,new-posts)))
                      (format t "Removed comment ~A from thread ~A.~%" comment-id post-id)))
                (generate-index board))))))))

(defun edit-comment (board post-id comment-id-str)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id))
         (comment-id (parse-integer comment-id-str :junk-allowed t)))
    (unless (probe-file sexp-file)
      (format t "Thread ~A does not exist.~%" sexp-file)
      (return-from edit-comment nil))
    (let* ((data (read-sexp-file sexp-file))
           (headline (lookup-def 'cl-bbs/models:headline data))
           (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
           (comment (find comment-id posts :key #'car)))
      (if (not comment)
          (format t "Comment ~A not found in thread ~A.~%" comment-id post-id)
          (let* ((content-cell (assoc 'cl-bbs/models:content (cdr comment)))
                 (content-value (cdr content-cell)))
            (uiop:with-temporary-file (:pathname tmp-path :keep t)
              (with-open-file (stream tmp-path :direction :output :if-exists :supersede
                                               :external-format :utf-8)
                (write-line content-value stream))
              (let ((editor (or (uiop:getenv "EDITOR") "vi")))
                (format t "Opening ~A with ~A...~%" tmp-path editor)
                (uiop:run-program (format nil "~A ~A" editor (namestring tmp-path))
                                  :output :interactive
                                  :input :interactive
                                  :error-output :interactive)
                (let ((new-content-value (uiop:read-file-string tmp-path)))
                  (delete-file tmp-path)
                  (when (and new-content-value (string/= new-content-value ""))
                    (backup (format nil "Before editing comment ~A from thread ~A on board ~A"
                                    comment-id post-id board))
                    (let ((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)
                                                                             (string-right-trim '(#\Newline #\Return)
                                                                                                new-content-value))
                                                                       kv))
                                                                 (cdr p)))
                                                   p))
                                             posts)))
                      (write-sexp-file sexp-file `((cl-bbs/models:headline . ,headline)
                                                   (cl-bbs/models:posts ,new-posts)))
                      (format t "Edited comment ~A from thread ~A.~%" comment-id post-id)
                      (generate-index board)))))))))))

(defun get-next-post-id (board)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-dir (format nil "~A/sexp/~A/" data-dir board))
         (files (and (probe-file sexp-dir)
                     (uiop:directory-files (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd)))))
         (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 move-post (source-board post-id target-board)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (source-file (format nil "~A/sexp/~A/~A" data-dir source-board post-id))
         (target-dir (format nil "~A/sexp/~A/" data-dir target-board)))
    (if (probe-file source-file)
        (progn
          (unless (uiop:directory-exists-p (uiop:ensure-absolute-pathname target-dir (uiop:getcwd)))
            (format t "Target board ~A does not exist.~%" target-board)
            (return-from move-post nil))
          (let* ((new-id (get-next-post-id target-board))
                 (target-file (format nil "~A~A" target-dir new-id)))
            (backup (format nil "Before moving thread ~A from ~A to ~A as ~A" post-id source-board target-board new-id))
            (uiop:copy-file source-file target-file)
            (delete-file source-file)
            (format t "Moved thread ~A from ~A to ~A as thread ~A.~%" post-id source-board target-board new-id)
            (generate-index source-board)
            (generate-index target-board)))
        (format t "Thread ~A does not exist in board ~A.~%" post-id source-board))))

(defun parse-post-date (date-string)
  (let ((year (parse-integer date-string :start 0 :end 4))
        (month (parse-integer date-string :start 5 :end 7))
        (day (parse-integer date-string :start 8 :end 10))
        (hour (parse-integer date-string :start 11 :end 13))
        (minute (parse-integer date-string :start 14 :end 16)))
    (encode-universal-time 0 minute hour day month year 0)))

(defun format-post-date (universal-time)
  (multiple-value-bind (second minute hour day month year)
      (decode-universal-time universal-time 0)
    (declare (ignore second))
    (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D" year month day hour minute)))

(defun add-timezone-offset (date-string offset-hours)
  (let* ((ut (parse-post-date date-string))
         (new-ut (+ ut (* offset-hours 3600))))
    (format-post-date new-ut)))

(defun list-all (&optional board post-id-str)
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-dir (format nil "~A/sexp/" data-dir)))
    (cond
      ((null board)
       (let ((boards (and (probe-file sexp-dir)
                          (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd))))))
         (if boards
             (progn
               (format t "Boards:~%")
               (dolist (b-path boards)
                 (format t "  ~A~%" (car (last (pathname-directory b-path))))))
             (format t "No boards found in ~A~%" sexp-dir))))
      ((and board post-id-str)
       (let ((sexp-file (format nil "~A/sexp/~A/~A" data-dir board post-id-str))
             (post-id (parse-integer post-id-str :junk-allowed t)))
         (if (and post-id (probe-file sexp-file))
             (let* ((data (read-sexp-file sexp-file))
                    (headline (lookup-def 'cl-bbs/models:headline data))
                    (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data))))
               (format t "Thread ~A: ~A~%" post-id-str headline)
               (dolist (p posts)
                 (let* ((cid (car p))
                        (pdata (cdr p))
                        (date (lookup-def 'cl-bbs/models:date pdata))
                        (author (lookup-def 'cl-bbs/models:name pdata))
                        (content (lookup-def 'cl-bbs/models:content pdata)))
                   (format t "~%[~A] #~A by ~A~%" date cid (or author "Anonymous"))
                   (format t "~A~%" content))))
             (format t "Thread ~A not found in board ~A.~%" post-id-str board))))
      (board
       (let* ((board-dir (format nil "~A/sexp/~A/" data-dir board))
              (threads-data (get-threads board-dir)))
         (if threads-data
             (let ((sorted (sort threads-data
                                 (lambda (a b)
                                   (let* ((posts-a (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr a))))
                                          (last-a (last-element posts-a))
                                          (date-a (lookup-def 'cl-bbs/models:date (cdr last-a)))
                                          (ut-a (parse-post-date date-a))
                                          (posts-b (get-flat-posts (lookup-def 'cl-bbs/models:posts (cdr b))))
                                          (last-b (last-element posts-b))
                                          (date-b (lookup-def 'cl-bbs/models:date (cdr last-b)))
                                          (ut-b (parse-post-date date-b)))
                                     (> ut-a ut-b))))))
               (progn
                 (format t "Threads in board ~A:~%" board)
                 (format t "~10A ~20A ~A~%" "ID" "Last Update" "Headline")
                 (format t "~v@{~A~:*~}~%" 60 "-")
                 (dolist (t-data sorted)
                   (let* ((tid (car t-data))
                          (t-content (cdr t-data))
                          (headline (lookup-def 'cl-bbs/models:headline t-content))
                          (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts t-content)))
                          (last-date (lookup-def 'cl-bbs/models:date (cdr (last-element posts)))))
                     (format t "~10D ~20A ~A~%" tid last-date headline)))))
             (format t "No threads found in board ~A.~%" board)))))))

(defun set-timezone (offset-hours)
  (backup (format nil "Before setting timezone offset to ~D" offset-hours))
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-dir (format nil "~A/sexp/" data-dir))
         (boards (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd)))))
    (dolist (board-path boards)
      (let ((board (car (last (pathname-directory board-path))))
            (threads (uiop:directory-files board-path)))
        (dolist (thread threads)
          (when (handler-case (parse-integer (pathname-name thread))
                  (error () nil))
            (let* ((data (read-sexp-file thread))
                   (headline (lookup-def 'cl-bbs/models:headline data))
                   (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
                   (new-posts (mapcar (lambda (p)
                                        (let* ((post-id (car p))
                                               (post-data (cdr p))
                                               (old-date (lookup-def 'cl-bbs/models:date post-data))
                                               (new-date (add-timezone-offset old-date offset-hours)))
                                          (cons post-id
                                                (mapcar (lambda (kv)
                                                          (if (eq (car kv) 'cl-bbs/models:date)
                                                              (cons (car kv) new-date)
                                                              kv))
                                                        post-data))))
                                      posts)))
              (write-sexp-file thread `((cl-bbs/models:headline . ,headline) (cl-bbs/models:posts ,new-posts)))))
        (generate-index board))))))

(defun find-duplicates (posts)
  (let ((duplicates nil)
        (prev-post (car posts)))
    (dolist (curr-post (cdr posts))
      (let ((prev-content (lookup-def 'cl-bbs/models:content (cdr prev-post)))
            (curr-content (lookup-def 'cl-bbs/models:content (cdr curr-post))))
        (if (equal prev-content curr-content)
            (push curr-post duplicates)
            (setf prev-post curr-post))))
    (nreverse duplicates)))

(defun remove-duplicates-command ()
  (let* ((data-dir (string-right-trim "/" (get-data-dir)))
         (sexp-dir (format nil "~A/sexp/" data-dir))
         (boards (uiop:subdirectories (uiop:ensure-absolute-pathname sexp-dir (uiop:getcwd))))
         (all-duplicates nil))
    (dolist (board-path boards)
      (let ((board (car (last (pathname-directory board-path))))
            (threads (uiop:directory-files board-path)))
        (dolist (thread-path threads)
          (let ((thread-id (pathname-name thread-path)))
            (when (handler-case (parse-integer thread-id)
                    (error () nil))
              (let* ((data (read-sexp-file thread-path))
                     (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
                     (dups (find-duplicates posts)))
                (when dups
                  (push (list board thread-id dups thread-path data) all-duplicates)))))))
    (if (null all-duplicates)
        (format t "No sequential duplicate comments found.~%")
        (progn
          (format t "Found sequential duplicate comments:~%~%")
          (dolist (entry (reverse all-duplicates))
            (destructuring-bind (board thread-id dups thread-path data) entry
              (declare (ignore thread-path data))
              (format t "Board: ~A, Thread: ~A~%" board thread-id)
              (dolist (dup dups)
                (let ((comment-id (car dup))
                      (content (lookup-def 'cl-bbs/models:content (cdr dup))))
                  (format t "  - Duplicate Comment ID: ~A~%" comment-id)
                  (format t "    Content: ~A~%" content)))))
          (format t "~%")
          (when (ask-confirmation "Are you sure you want to delete these duplicate comments?")
            (backup "Before removing sequential duplicate comments")
            (let ((affected-boards nil))
              (dolist (entry all-duplicates)
                (destructuring-bind (board thread-id dups thread-path data) entry
                  (let* ((headline (lookup-def 'cl-bbs/models:headline data))
                         (posts (get-flat-posts (lookup-def 'cl-bbs/models:posts data)))
                         (dup-ids (mapcar #'car dups))
                         (new-posts (remove-if (lambda (p) (member (car p) dup-ids)) posts)))
                    (write-sexp-file thread-path `((cl-bbs/models:headline . ,headline)
                                                   (cl-bbs/models:posts ,new-posts)))
                    (pushnew board affected-boards :test #'string-equal)
                    (format t "Removed ~D duplicates from ~A/~A~%" (length dups) board thread-id))))
              (dolist (board affected-boards)
                (generate-index board)))))))))

(defun print-help ()
  (format t "Usage: cl-bbs-admin <command> [args...]~%~%")
  (format t "Commands:~%")
  (format t "  generate-index <board>                       Regenerate index and list files for a board~%")
  (format t "  list [board] [post-id]                       List boards, threads in a board, or comments in a thread~%")
  (format t "  remove-post <board> <post-id>                Remove an entire thread/post~%")
  (format t "  remove-duplicates                            Remove sequential duplicate comments across all boards~%")
  (format t "  remove-comment <board> <post-id> <comment-id> Remove a specific comment from a thread~%")
  (format t "  edit <board> <post-id> <comment-id>          Edit a specific comment using $EDITOR~%")
  (format t "  move <source-board> <post-id> <target-board> Move a thread to a different board~%")
  (format t "  backup [\"description msg\"]                   Backup the sexp directory to a tarball~%")
  (format t "  restore [archive.tar.gz]                     Restore or list backups~%")
  (format t "  set-timezone <int>                           Offset all posts timezone and recreate indices~%~%")
  (format t "Environment Variables:~%")
  (format t "  SBBS_DATADIR                                 Path to data directory (default: project data/)~%"))

(defun main (&rest argv)
  "Main entry point for cl-bbs-admin command line interface, parsing and dispatching command line arguments ARGV."
  (handler-case
      (if (null argv)
          (print-help)
          (let ((cmd (first argv)))
            (cond
              ((string= cmd "list")
               (list-all (second argv) (third argv)))
              ((string= cmd "generate-index")
               (if (>= (length argv) 2)
                   (generate-index (second argv))
                   (format t "Usage: cl-bbs-admin generate-index <board>~%")))
              ((string= cmd "remove-post")
               (if (>= (length argv) 3)
                   (remove-post (second argv) (third argv))
                   (format t "Usage: cl-bbs-admin remove-post <board> <post-id>~%")))
              ((string= cmd "remove-duplicates")
               (remove-duplicates-command))
              ((string= cmd "remove-comment")
               (if (>= (length argv) 4)
                   (remove-comment (second argv) (third argv) (fourth argv))
                   (format t "Usage: cl-bbs-admin remove-comment <board> <post-id> <comment-id>~%")))
              ((string= cmd "edit")
               (if (>= (length argv) 4)
                   (edit-comment (second argv) (third argv) (fourth argv))
                   (format t "Usage: cl-bbs-admin edit <board> <post-id> <comment-id>~%")))
              ((string= cmd "move")
               (if (>= (length argv) 4)
                   (move-post (second argv) (third argv) (fourth argv))
                   (format t "Usage: cl-bbs-admin move <source-board> <post-id> <target-board>~%")))
              ((string= cmd "backup")
               (if (>= (length argv) 2)
                   (backup (format nil "~{~A~^ ~}" (cdr argv)))
                   (backup)))
              ((string= cmd "restore")
               (if (>= (length argv) 2)
                   (restore (second argv))
                   (restore)))
              ((string= cmd "set-timezone")
               (if (>= (length argv) 2)
                   (let ((offset (parse-integer (second argv) :junk-allowed t)))
                     (if offset
                         (set-timezone offset)
                         (format t "Invalid timezone offset: ~A~%" (second argv))))
                   (format t "Usage: cl-bbs-admin set-timezone <int>~%")))
              (t
               (format t "Unknown command: ~A~%" cmd)
               (print-help)))))
    (#+sbcl sb-sys:interactive-interrupt
     #+ccl  ccl:interrupt-condition
     #+clisp system:simple-interrupt-condition
     #+ecl ext:interactive-interrupt
     #+allegro excl:interrupt-signal
     ()
     (progn
       (format *error-output* "~&Interrupted.~%")
       (uiop:quit 1)))))