From: Lucian Mogosanu <lucian.mogosanu@gmail.com>
Date: Sun, 23 Apr 2017 14:32:17 +0000 (+0300)
Subject: Add an example server serving static TLBS
X-Git-Url: https://git.mogosanu.ro/?a=commitdiff_plain;h=4bce8afb55ca81410341500feeb8153eb6d0d046;p=thetarpit.git

Add an example server serving static TLBS
---

diff --git a/http.lisp b/http.lisp
new file mode 100644
index 0000000..e6e0578
--- /dev/null
+++ b/http.lisp
@@ -0,0 +1,73 @@
+;; Tarpit Lisp Blog Waitress
+;;
+;; A customized HTTP server
+
+(eval-when (:compile-toplevel :execute :load-toplevel)
+  (defparameter *lbs-stolen* (concatenate 'string *lbs-base* "stolen/"))
+  (defparameter *lbw-path* nil)
+
+  ;; Add phat LBW dependencies
+  (defparameter paths
+    (list "alexandria" "cl-fad" "split-sequence" "trivial-gray-streams"
+          "usocket" "bordeaux-threads" "anaphora" "my-util" "trivial-shell"
+          "flexi-streams" "rfc2388-binary" "cl-http-server"))
+  (dolist (path paths)
+    (push (concatenate 'string *lbs-stolen* path "/") *lbw-path*))
+  (makunbound 'paths)
+
+  ; Set paths and change dir (SBCL-specific)
+  (dolist (path *lbw-path*)
+    (if (not (member path asdf:*central-registry*))
+        (push path asdf:*central-registry*)))
+  (sb-posix:chdir *lbs-base*)
+  (setq *default-pathname-defaults* (pathname *lbs-base*))
+
+  ;; Load libraries
+  (require 'asdf)
+  (asdf:load-system :cl-http-server))
+
+(defvar *tlbw-server* nil)
+
+(defun tlbw-start-server ()
+  ;; Check whether the server is running
+  (when *tlbw-server*
+    (format t "TLBW server is already running:~%~s~%"
+            *tlbw-server*)
+    (return-from tlbw-start-server))
+
+  ;; Alles gutes
+  (setq *tlbw-server*
+        (cl-http-server:start-server
+         (cl-http-server:make-server :public-dir *lbs-site*
+                                     :port 8000))))
+
+(defun tlbw-stop-server ()
+  ;; Check whether the server is running
+  (when (not *tlbw-server*)
+    (format t "TLBW server not running.")
+    (return-from tlbw-stop-server))
+
+  (cl-http-server:stop-server *tlbw-server*)
+  (setq *tlbw-server* nil))
+
+;; A demo. First off, we load lib:
+;;
+;; (asdf:load-system :cl-http-server)
+;;
+;; Then off, we spawn a server:
+;;
+;; (setq *tlbw-acceptor* (cl-http-server:start-server (cl-http-server:make-server :public-dir *lbs-site* :port 8000)))
+;;
+;; Then off, we set a default page:
+;;
+;; (defvar *my-lispy-var* 0)
+;; (cl-http-server:set-page 'default #'(lambda () (cl-http-server:html :body  (progn (incf *my-lispy-var*) (format nil "URL suffix: ~s, lispy var: ~s" (cl-http-server:uri-path 2) *my-lispy-var*)))))
+;;
+;; Note that we don't need to use the HTML function provided by these
+;; guys, since we have CL-WHO to aid us.
+;;
+;; We test.
+;;
+;; Finally, we kill the server:
+;;
+;; (cl-http-server:stop-server *tlbw-acceptor*)