summaryrefslogtreecommitdiff
path: root/simple-directory-handler.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2019-12-21 16:10:11 +0100
committerPeter Bex <peter@more-magic.net>2019-12-21 16:15:18 +0100
commit8c3da92b9a103a36dc69d78518f3d22cdc116246 (patch)
treed6261c67308cd95a07e9b51f8fd594bcd4d2e04b /simple-directory-handler.scm
parentd25b44f31f97edfadcb894d67872eecfa4eb91c5 (diff)
downloadspiffy-8c3da92b9a103a36dc69d78518f3d22cdc116246.tar.gz
Properly encode paths in simple-directory-handler
The original simple-directory-handler would only html-encode paths to files. This is obviously completely bogus; the path strings need to get everything except slashes encoded. Without this change, paths containing spaces or brackets of any kind would result in links which caused the server to reject the request, because the resulting URI would be invalid. Browsers aren't always smart enough to properly encode all special characters (which makes sense, because they shouldn't mess with URIs, but they sometimes do, which means we never really noticed this). Also get rid of those ugly [] parenthesis synonyms and update copyright year.
Diffstat (limited to 'simple-directory-handler.scm')
-rw-r--r--simple-directory-handler.scm53
1 files changed, 29 insertions, 24 deletions
diff --git a/simple-directory-handler.scm b/simple-directory-handler.scm
index c232478..4d722c6 100644
--- a/simple-directory-handler.scm
+++ b/simple-directory-handler.scm
@@ -1,6 +1,6 @@
;;;; simple-directory-handler.scm
;
-; Copyright (c) 2007-2009, 2012, 2018, Peter Bex
+; Copyright (c) 2007-2009, 2012, 2018-2019, Peter Bex
; Copyright (c) 2000-2005, Felix L. Winkelmann
; All rights reserved.
;
@@ -37,7 +37,12 @@
(import scheme (chicken base) (chicken condition) (chicken time posix)
(chicken file posix) (chicken pathname) (chicken format)
(chicken file) (only srfi-1 fold) (only (chicken sort) sort)
- intarweb spiffy)
+ intarweb spiffy (only uri-common uri-encode-string char-set:uri-unreserved)
+ (only srfi-14 char-set-complement char-set-delete))
+
+(define (encode-path p)
+ (let ((cs (char-set-delete (char-set-complement char-set:uri-unreserved) #\/)))
+ (uri-encode-string p cs)))
(define simple-directory-dotfiles? (make-parameter #f))
(define simple-directory-display-file
@@ -48,16 +53,16 @@
<td>~a</td>
<td>~a</td>
</tr>\n"
- (htmlize remote-file)
+ (htmlize (encode-path remote-file))
(string-append (htmlize (pathname-strip-directory remote-file))
(if dir? "/" "")) ; a small hint that it's a dir
(file-size local-file)
(seconds->string (file-modification-time local-file))))))
(define (simple-directory-handler path)
- (let ([str
+ (let ((str
(sprintf
- "<!DOCTYPE html PUBLIC
+ "<!DOCTYPE html PUBLIC
\"-//W3C//DTD XHTML 1.0 Strict//EN\"
\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
@@ -79,26 +84,26 @@
</table>
</body>
</html>"
- path
- path
- (or (pathname-directory path) path)
- (let ([dir (sort (directory (make-pathname (root-path) path)
- (simple-directory-dotfiles?))
- string<?)])
- (fold
- (lambda (file str)
- (let* ((local-file (make-pathname (list (root-path) path)
- file))
- (remote-file (make-pathname path file))
- (dir? (directory? local-file)))
- (condition-case
- (string-append str ((simple-directory-display-file)
- remote-file local-file dir?))
- ;; Race condition: file might have been deleted or might be
- ;; otherwise inaccessible (#939; self-referential symlink)
+ path
+ path
+ (or (pathname-directory path) path)
+ (let ((dir (sort (directory (make-pathname (root-path) path)
+ (simple-directory-dotfiles?))
+ string<?)))
+ (fold
+ (lambda (file str)
+ (let* ((local-file (make-pathname (list (root-path) path)
+ file))
+ (remote-file (make-pathname path file))
+ (dir? (directory? local-file)))
+ (condition-case
+ (string-append str ((simple-directory-display-file)
+ remote-file local-file dir?))
+ ;; Race condition: file might have been deleted or might be
+ ;; otherwise inaccessible (#939; self-referential symlink)
((exn i/o file) str))))
- ""
- dir)))])
+ ""
+ dir)))))
(with-headers `((content-type text/html)
(content-length ,(string-length str)))
(lambda ()