From 430be18cddf1a176381dfb4970118668f3a78d6a Mon Sep 17 00:00:00 2001 From: Lucian Mogosanu Date: Thu, 15 Aug 2019 15:35:11 +0300 Subject: [PATCH] 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. --- blog.lisp | 77 ++++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 24 deletions(-) diff --git a/blog.lisp b/blog.lisp index 32ce8b9..c3a5046 100644 --- 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)) -- 1.7.10.4