Handle directories better (hopefully)

webshit.lisp

@@ -5,6 +5,24 @@
   (:use :common-lisp :bknr.datastore :woo :spinneret :split-sequence :bordeaux-threads :parenscript))
 (in-package :webshit2)
 
+(defparameter *project-directory* (asdf:system-source-directory :webshit2))
+
+(defun make-absolute (&rest paths)
+  (merge-pathnames
+   (reduce (lambda (s ss) (concatenate 'string s ss))
+	   (map 'list
+		(lambda (path)
+		  (if (char= (char path 0) #\/) (subseq path 1) path))
+		paths))
+   *project-directory*))
+
+(map 'list (lambda (dir) (ensure-directories-exist (make-absolute dir)))
+     (list
+      "bknr/"
+      "buckets/"
+      "static/"
+      ))
+
 ;;; HTTP stuff
 
 (defparameter *old-requests* ())
@@ -121,7 +139,7 @@
 ;; (defclass monero-bucket (bucket))
 
 (defun bucket-exists-p (name)
-  (probe-file (concatenate 'string "buckets/" name)))
+  (probe-file (make-absolute "buckets/" name)))
 
 (defun open-bucket-to (session bucket)
   (with-transaction ()
@@ -131,7 +149,7 @@
 
 (defun render-bucket (env path)
   (let* ((files (map 'list #'file-namestring
-		     (uiop:directory-files path))))
+		     (uiop:directory-files (make-absolute path)))))
     (list (with-html-string (:doctype)
 	    (:html
 	     (:head (:script ()))
@@ -185,7 +203,7 @@
   (let ((path (subseq (getf env :request-uri) 1)))
     (cond ((eq (getf env :request-method) :post)
 	   (send-bucket-cookie env))
-	  ((probe-file path)
+	  ((probe-file (make-absolute path))
 	   (if (string= path "buckets/")
 	       (list 200 '(:content-type "text/html") (render-bucket-index env))
 	       (list 200 '(:content-type "text/html") (render-bucket env path))))
@@ -199,7 +217,7 @@
   ;;;(print env)
   (push env *old-requests*)
   (if (string= (getf env :request-uri) "/favicon.ico")
-      '(200 (:content-type "image/vnd.microsoft.icon") #p"res/favicon.ico")
+      '(200 (:content-type "image/vnd.microsoft.icon") (make-absolute #p"res/favicon.ico"))
       (funcall (find-handler (getf env :request-uri)) env)))
 
 (let ((thread nil))