cl-rw

commit 6be18fd8a742c248248813b3b6dd425e5282e987
parent a2a8a2ee6fdcd1c70dcb076452c5083cbbac3858
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 13 Dec 2015 12:20:31 +0100

refactoring

Diffstat:
M
demo-webserver.lisp
 | 
32
+++++++++++++++++++++-----------

1 file changed, 21 insertions(+), 11 deletions(-)
diff --git a/demo-webserver.lisp b/demo-webserver.lisp
@@ -25,6 +25,11 @@
 
 (in-package :rw.demo.webserver)
 
+;; TODO vhosting
+;; TODO redirect, e.g. www, picowiki
+;; TODO proxy, e.g. ondoc, zappel, counter
+;; TODO logging?
+
 (defparameter *root* #p"/nix/store/l549rl2lmyk7dvsrv4mrrwgwbswf8q6l-logand-website/share/logandWebsite/data/")
 
 (defun part-reader (query)
@@ -37,20 +42,28 @@
                      :nothing))
           (rw:skip r '(#\/)))))))
 
-(defun query-pathname (query)
+(defun query-pathname (query default-name default-type)
   (let* ((tail (rw:till (rw:peek-reader (part-reader query))))
          (head (pop tail)))
     (merge-pathnames
      (make-pathname :directory (cons :relative (nreverse tail))
                     :name (if (eq :nothing head)
-                              "index"
+                              default-name
                               (pathname-name head))
                     :type (if (eq :nothing head)
-                              "html"
+                              default-type
                               (pathname-type head)))
      *root*)))
 
-(defun query-file (query)
+(defun readable-file-p (pathname)
+  (let ((f (probe-file pathname)))
+    (when f
+      (ignore-errors
+        (with-open-file (s f :if-does-not-exist nil)
+          (listen s) ;; dir throws
+          f)))))
+
+(defun query-file (query default-name default-type)
   (let ((q (rw:till (rw:peek-reader (rw:reader query)) '(#\?))))
     (when (every (lambda (c)
                    (or (char<= #\A c #\Z)
@@ -58,12 +71,7 @@
                        (char<= #\0 c #\9)
                        (member c '(#\/ #\. #\- #\_))))
                  q)
-      (let ((f (probe-file (query-pathname q))))
-        (when f
-          (ignore-errors
-            (with-open-file (s f :if-does-not-exist nil)
-              (listen s) ;; dir throws
-              f)))))))
+      (readable-file-p (query-pathname q default-name default-type)))))
 
 (defun content-type (pathname)
   (or (cdr (assoc (pathname-type pathname) rw.http:*mime-types* :test #'equalp))
@@ -75,7 +83,9 @@
     ;;(:read (rw:till (rw:peek-reader stream)))
     (:write
      (or (when (member method '(:get :head))
-           (let ((f (query-file query)))
+           (let ((f (or (query-file query "index" "html")
+                        #+nil(query-file query "index" "htm")
+                        #+nil(query-file query "README" nil))))
              (when f
                `(:http-1.0
                  :code 200