Commit e25887f3ee529c34a45dea2b3fbfba2d96f4618d
2017-08-01T22:32:26
Better directory listing
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
diff --git a/thot.lisp b/thot.lisp
index 005386d..3670b91 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -346,20 +346,16 @@ The requested url ~S was not found on this server."
(defun url-encode (string)
(rol-uri:%-encode string))
-(defun directory-index (local remote)
- (let* ((request-dir (request-dir))
- (dir (if (< (length request-dir)
- (length remote))
- (subseq request-dir (length remote))
- request-dir)))
- (header "Content-Type: text/html")
- (content
- (with-output-to-string (o)
- (flet ((w (&rest parts)
- (dolist (p parts)
- (write-sequence o p))))
+(defun directory-index (local remote dir)
+ (header "Content-Type: text/html")
+ (content
+ (with-output-to-string (o)
+ (flet ((w (&rest parts)
+ (dolist (p parts)
+ (write-sequence o p))))
(w "<html>
<head>
+ <title>" (h dir) "</title>
</head>
<body>
<h1>" (h dir) "</h1>
@@ -371,19 +367,26 @@ The requested url ~S was not found on this server."
(let* ((name (dirent-name df))
(slash (if (= +dt-dir+ (dirent-type df)) "/" ""))
(url (str (unless (string= "/" remote)
- (str (url-encode remote) "/"))
+ (url-encode remote))
(unless (string= "/" dir)
- (url-encode dir)) "/"
+ (url-encode dir))
+ "/"
(url-encode name) slash)))
(w " <li><a href=\"" (h url) "\">" (h name) slash "</a></li>
"))))
(w " </ul>
</body>
</html>
-"))))))
+")))))
(defun directory-handler (local remote)
- `(directory-index ,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))))))
(defparameter *url-handlers*
'((directory-handler "/" "/")