Commit 2084505434318c437eee819e1e0e7be2c48f61c2
2018-06-01T19:03:52
fix directory index
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
diff --git a/thot.lisp b/thot.lisp
index 5ea5d7a..02c861b 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -117,8 +117,8 @@
(slot-value request 'host))
(defun uri-dir (uri)
- (let ((dir-end (position #\/ uri :from-end t :start 1)))
- (subseq uri 0 dir-end)))
+ (let ((dir-end (position #\/ uri :from-end t)))
+ (subseq uri 0 (or dir-end 0))))
(defun request-dir (&optional (request *request*))
(declare (type request request))
@@ -351,6 +351,31 @@ The requested url ~S was not found on this server."
(defun url-encode (string)
(rol-uri:%-encode string))
+(defun path-directory-p (path)
+ (declare (type string path))
+ (let ((len (length path)))
+ (when (< 0 len)
+ (char= #\/ (char path (1- len))))))
+
+;;(path-directory-p "/")
+
+(defun path-as-directory (path)
+ (if (path-directory-p path)
+ path
+ (str path "/")))
+
+;;(path-as-directory "/")
+
+(defun probe-directory (path)
+ (let ((dirp (ignore-errors (dirent:opendir path))))
+ (when dirp
+ (dirent:closedir dirp)
+ (path-as-directory path))))
+
+(defun prefix-p (pre str)
+ (and (<= (length pre) (length str))
+ (string= pre str :end2 (length pre))))
+
(defun directory-index (local remote dir)
(header "Content-Type: text/html")
(content
@@ -370,11 +395,9 @@ The requested url ~S was not found on this server."
(do-dir (df localdir)
(let* ((name (dirent-name df))
(slash (if (= +dt-dir+ (dirent-type df)) "/" ""))
- (url (str (unless (string= "/" remote)
- remote)
- "/" dir
- "/"
- (url-encode name) slash)))
+ (url (str remote dir (url-encode name) slash)))
+ (format t "remote ~S dir ~S name ~S slash ~S~%"
+ remote dir name slash)
(w " <li><a href=\"" (h url) "\">" (h name) slash "</a></li>
"))))
(w " </ul>
@@ -383,13 +406,13 @@ The requested url ~S was not found on this server."
")))))
(defun directory-handler (local remote)
- (let ((request-dir (request-dir)))
- (format t "request-dir ~S~%" request-dir)
- (unless (or (< (length request-dir) (length remote))
- (not (string= remote request-dir :end2 (length remote))))
- (let ((dir (subseq request-dir (length remote))))
- (unless (pathname-name (probe-file (str local dir)))
- `(directory-index ,local ,remote ,dir))))))
+ (let ((dir (path-as-directory (request-uri))))
+ (format t "dir ~S local ~S remote ~S~%" dir local remote)
+ (when (prefix-p remote dir)
+ (let ((subdir (subseq dir (length remote))))
+ (format t "subdir ~S~%" subdir)
+ (when (probe-directory (str local subdir))
+ `(directory-index ,local ,remote ,subdir))))))
(defparameter *url-handlers*
'((directory-handler "/" "/")