diff --git a/cl-bbs.asd b/cl-bbs.asd
index 19747eb..1e8d3bb 100644
--- a/cl-bbs.asd
+++ b/cl-bbs.asd
@@ -68,6 +68,7 @@
:depends-on ("package")
:components ((:file "models")
(:file "storage" :depends-on ("models"))
+ (:file "rss" :depends-on ("models" "storage"))
(:file "views" :depends-on ("models"))
(:file "handlers" :depends-on ("storage" "views"))
(:file "main" :depends-on ("handlers" "storage"))
@@ -97,6 +98,7 @@
:components ((:file "models")
(:file "storage")
(:file "views")
+ (:file "rss")
(:file "handlers")
(:file "admin")))
(:module "integration"
diff --git a/src/server/handlers.lisp b/src/server/handlers.lisp
index 037efbf..60b533e 100644
--- a/src/server/handlers.lisp
+++ b/src/server/handlers.lisp
@@ -4,11 +4,14 @@
#:*base-dir*
#:read-sexp-file
#:write-sexp-file
- #:ensure-board-dirs
- #:is-board-locked)
- (:import-from :cl-bbs/views
- #:render-moderation
- #:render-index
+ #: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
@@ -693,6 +696,25 @@ hyphens, and underscores. Otherwise returns nil to prevent injection/directory t
: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)
diff --git a/src/server/rss.lisp b/src/server/rss.lisp
new file mode 100644
index 0000000..a1c2506
--- /dev/null
+++ b/src/server/rss.lisp
@@ -0,0 +1,116 @@
+(defpackage #:cl-bbs/rss
+ (:use #:cl)
+ (:local-nicknames (#:models #:cl-bbs/models)
+ (#:storage #:cl-bbs/storage))
+ (:export #:generate-rss
+ #:get-all-boards-rss-threads))
+
+(in-package #:cl-bbs/rss)
+
+(defun get-url-scheme (env headers)
+ (if (string= "https" (gethash "x-forwarded-proto" headers))
+ "https"
+ (let ((url-scheme (getf env :url-scheme)))
+ (if url-scheme
+ (string-downcase (string url-scheme))
+ "http"))))
+
+(defun get-request-base-url (env)
+ "Construct the base URL from the request environment."
+ (let* ((headers (getf env :headers))
+ (scheme (get-url-scheme env headers))
+ (host (gethash "host" headers)))
+ (if host
+ (format nil "~a://~a" scheme host)
+ "")))
+
+(defun get-tz-offset-string ()
+ "Returns the basic timezone offset of the machine like '-0300' or '+0000'."
+ (multiple-value-bind (sec min hr date month year day-of-week dst-p tz)
+ (get-decoded-time)
+ (declare (ignore sec min hr date month year day-of-week dst-p))
+ (let* ((offset-hours (- tz))
+ (sign (if (>= offset-hours 0) #\+ #\-))
+ (abs-hours (abs offset-hours)))
+ (format nil "~c~2,'0d00" sign (truncate abs-hours)))))
+
+(defun convert-to-rfc822 (iso-8601-string)
+ "Convert simple ISO 8601 string to RFC1123/RFC822 retaining literal parsing and appending manual offset."
+ (let ((clean-string (cl-ppcre:regex-replace-all " " iso-8601-string "T")))
+ (handler-case
+ (let* ((parsed (local-time:parse-timestring clean-string))
+ (utc-str (local-time:format-rfc1123-timestring nil parsed :timezone local-time:+utc-zone+)))
+ (cl-ppcre:regex-replace "(?:GMT|\\+0000)$" utc-str (get-tz-offset-string)))
+ (error ()
+ (let ((now-utc (local-time:format-rfc1123-timestring nil (local-time:now) :timezone local-time:+utc-zone+)))
+ (cl-ppcre:regex-replace "(?:GMT|\\+0000)$" now-utc (get-tz-offset-string)))))))
+
+
+
+(defun get-all-boards-rss-threads (limit)
+ "Fetch latest threads from all boards combining them for RSS."
+ (let ((all-threads nil)
+ (sexp-base (merge-pathnames "sexp/" storage:*base-dir*)))
+ (when (probe-file sexp-base)
+ (loop for board-dir in (uiop:subdirectories sexp-base) do
+ (let ((board-name (car (last (pathname-directory board-dir))))
+ (list-path (merge-pathnames "list" board-dir)))
+ (when (probe-file list-path)
+ (let ((board-threads (storage:read-sexp-file list-path)))
+ (loop for thread in board-threads do
+ ;; thread is (ID (models:headline . "...") (models:date . "..."))
+ (push (cons (car thread) (cons `(models:board . ,board-name) (cdr thread))) all-threads)))))))
+ ;; Sort by date descending
+ (setf all-threads (sort all-threads
+ (lambda (a b)
+ (string> (cdr (assoc 'models:date (cdr a)))
+ (cdr (assoc 'models:date (cdr b)))))))
+ ;; Take top LIMIT
+ (if (> (length all-threads) limit)
+ (subseq all-threads 0 limit)
+ all-threads)))
+
+(defun generate-rss (board threads env)
+ "Generate an RSS feed for the given board and threads."
+ (let* ((now (local-time:now))
+ (utc-str (local-time:format-rfc1123-timestring nil now))
+ (rfc822-date utc-str)
+ (base-url (get-request-base-url env))
+ (request-url (format nil "~a~a" base-url (getf env :request-uri))))
+ (with-output-to-string (s)
+ (format s "~%")
+ (format s "~%")
+ (format s " ~%")
+ (if (string= board "all")
+ (progn
+ (format s " cl-bbs - all boards~%")
+ (format s " Latest threads from all boards on cl-bbs.~%"))
+ (progn
+ (format s " cl-bbs - /~a/~%" board)
+ (format s " Latest threads from /~a/.~%" board)))
+ (format s " ~a~%" request-url)
+ (format s " ~a~%" rfc822-date)
+ (format s " cl-bbs RSS generator~%")
+
+ (loop for t-entry in threads do
+ (let* ((id (car t-entry))
+ (thread-data (cdr t-entry))
+ (board-val (if (string= board "all")
+ (or (cdr (assoc 'models:board thread-data)) board)
+ board))
+ (headline (or (cdr (assoc 'models:headline thread-data)) "Untitled"))
+ (date (or (cdr (assoc 'models:date thread-data)) rfc822-date)) ; ISO 8601
+ (pub-date (if (string= date rfc822-date) rfc822-date (convert-to-rfc822 date)))
+ (thread-url (if (not (string= base-url ""))
+ (format nil "~a/~a/~a" base-url board-val id)
+ (format nil "/~a/~a" board-val id))))
+ (format s " - ~%")
+ (format s " <![CDATA[~a]]>~%" headline)
+ (format s " ~a~%" thread-url)
+ (format s " ~%" headline) ;; Fallback to headline
+ (format s " ~a~%" pub-date)
+ (format s " ~a~%" thread-url)
+ (format s "
~%")))
+
+ (format s " ~%")
+ (format s "~%"))))
diff --git a/src/server/views.lisp b/src/server/views.lisp
index 12ad5ef..f67e664 100644
--- a/src/server/views.lisp
+++ b/src/server/views.lisp
@@ -50,7 +50,7 @@
(error () nil))
"unknown"))))
-(defun render-footer-html ()
+(defun render-footer-html (&optional board)
"Renders the common footer HTML with cl-bbs version hash and a GitHub link."
(let ((hash (get-git-commit-hash)))
(cl-who:with-html-output-to-string (s nil :indent t)
@@ -58,7 +58,11 @@
"cl-bbs version:"
(:a :href (format nil "https://github.com/ryukinix/cl-bbs/commit/~a" hash)
:target "_blank"
- (cl-who:esc hash))))))
+ (cl-who:esc hash))
+ " - "
+ (:a :href (if board (format nil "/~a/rss" board) "/rss")
+ :target "_blank"
+ "RSS Feed")))))
(defun render-board-name (board)
(cl-who:with-html-output-to-string (s nil :indent t)
@@ -519,7 +523,7 @@ and the new thread form, using layout PREFS."
(unless (is-board-locked board)
(cl-who:htm (cl-who:str (render-thread-form board))))
(:hr)
- (cl-who:str (render-footer-html)))))
+ (cl-who:str (render-footer-html board)))))
(defun render-list (board threads &optional (prefs *preferences*))
"Renders the board thread-list HTML page, showing all THREADS in tabular format, using layout PREFS."
@@ -544,7 +548,7 @@ and the new thread form, using layout PREFS."
(:td (cl-who:str (format nil "~a" messages)))
(:td (:samp (cl-who:esc date)))))))))
(:hr)
- (cl-who:str (render-footer-html)))))
+ (cl-who:str (render-footer-html board)))))
(defun render-thread (board thread-id thread-data &optional range-string (prefs *preferences*))
"Renders a single thread page HTML for THREAD-ID under BOARD with THREAD-DATA (comments),
@@ -622,7 +626,7 @@ optionally filtered by RANGE-STRING, using layout PREFS."
(cl-who:str (format nil "~a" next-post-number))))
(:dd (cl-who:str (render-post-form board thread-id))))))
(:hr)
- (cl-who:str (render-footer-html))))))
+ (cl-who:str (render-footer-html board))))))
(defun render-preferences (board &optional (prefs *preferences*))
"Renders the board preferences HTML page, allowing users to choose a custom
diff --git a/src/static/index.html b/src/static/index.html
index bf3fed1..cf9a33f 100644
--- a/src/static/index.html
+++ b/src/static/index.html
@@ -59,6 +59,6 @@ Software Stack
-About cl-bbs
+About cl-bbs | RSS Feed