diff options
Diffstat (limited to 'server/admin.lisp')
| -rw-r--r-- | server/admin.lisp | 574 |
1 files changed, 574 insertions, 0 deletions
diff --git a/server/admin.lisp b/server/admin.lisp new file mode 100644 index 0000000..3864fad --- /dev/null +++ b/server/admin.lisp @@ -0,0 +1,574 @@ +(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))))) |