blog: Handle site requests using hunchentoot

This is probably too heavyweight, maybe we should define a custom dispatch
mechanism for the blog, since we have a lot of redundant URLs (e.g. /, /index,
/index.html).

This however requires some work, e.g. in handling static directories with a lot
of data.

diff --git a/blog.lisp b/blog.lisp
index 32ce8b9..c3a5046 100644 (file)
--- a/blog.lisp
+++ b/blog.lisp
@@ -43,7 +43,7 @@
 (defvar *drafts* nil) ; list of draft post blists
 (defvar *pages* nil)
 (defvar *tags* nil)
-(defvar *busybox-process* nil)
+(defvar *acceptor* nil)
 
 ;; Load template definitions
 (load (concatenate 'string *lbs-base* "templates/default.lisp"))
@@ -311,26 +311,55 @@
                             *lbs-rsync-dest*)
                     :output *standard-output*))
 
-(defun tlbs-run-site (&key kill (port 8000))
-  (cond
-    ((and (not *busybox-process*) (not kill))
-     (setq *busybox-process*
-           (sb-ext:run-program "/bin/busybox"
-                               (list "httpd" "-f"
-                                     "-p" (write-to-string port :base 10)
-                                     "-c" (concatenate 'string
-                                                       *lbs-base*
-                                                       "httpd.conf")
-                                     "-h" *lbs-site*)
-                               :wait nil)))
-    ((and (not *busybox-process*) kill)
-     (format t "Busybox process does not exist."))
-    ((and *busybox-process* (not kill))
-     (format t "Busybox process already exists."))
-    ((and *busybox-process* kill)
-     (sb-ext:process-kill *busybox-process* 2 :pid)
-     (sb-ext:process-wait *busybox-process*)
-     (sb-ext:process-close *busybox-process*)
-     (let ((code (sb-ext:process-exit-code *busybox-process*)))
-       (setq *busybox-process* nil)
-       code))))
+(defun tlbs-start-site (&key (port 8000))
+  ;; Check whether we're already starterd
+  (when *acceptor*
+    (format t "Site instance is already started at ~s~%" *acceptor*)
+    (return-from tlbs-start-site *acceptor*))
+  ;; Start site
+  (let* ((access-log (concatenate 'string *lbs-logs* "tlbs-access.log"))
+        (error-log (concatenate 'string *lbs-logs* "tlbs-error.log"))
+        (acceptor (make-instance 'hunchentoot:easy-acceptor
+                                 :name "tlbs-acceptor"
+                                 :port port
+                                 :message-log-destination error-log
+                                 :access-log-destination access-log
+                                 :error-template-directory *lbs-site*)))
+    ;; We're running, now we need to set some dispatchers/handlers
+    (let* ((static-files '("403.html" "404.html" "about.html" "archive.html"
+                          "drafts.html" "index.html" "rss.xml"
+                          ("/" . "index.html") ("/about" . "about.html")
+                          ("/archive" . "archive.html")
+                          ("/index" . "index.html") ("/feed" . "rss.xml")))
+          (static-dirs '("css/" "drafts/" "posts/" "tags/" "uploads/")))
+      (loop for file in static-files do
+          (push (hunchentoot:create-static-file-dispatcher-and-handler
+                 (cond
+                   ((consp file) (car file))
+                   ((stringp file) (concatenate 'string "/" file))
+                   (t (error "Unknown file representation.")))
+                 (cond
+                   ((consp file) (concatenate 'string *lbs-site* (cdr file)))
+                   ((stringp file)  (concatenate 'string *lbs-site* file))
+                   (t (error "Unknown file representation"))))
+                hunchentoot:*dispatch-table*))
+      (loop for dir in static-dirs do
+          (push (hunchentoot:create-folder-dispatcher-and-handler
+                 (concatenate 'string "/" dir)
+                 (concatenate 'string *lbs-site* dir))
+                hunchentoot:*dispatch-table*))
+      (hunchentoot:start acceptor)
+      (setq *acceptor* acceptor))))
+
+(defun tlbs-stop-site ()
+  ;; Is there something to stop?
+  (when (not *acceptor*)
+    (format t "No acceptor was found.")
+    (return-from tlbs-stop-site))
+
+  ;; Clear the dispatch table; yes, this means you can't run multiple
+  ;; sites in your Lisp process, but what do I care.
+  (setq hunchentoot:*dispatch-table* nil)
+  ;; Stop the acceptor and let the GC take care of it.
+  (hunchentoot:stop *acceptor*)
+  (setq *acceptor* nil))