diff options
| author | Peter Bex <peter@more-magic.net> | 2019-12-21 16:10:11 +0100 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2019-12-21 16:15:18 +0100 |
| commit | 8c3da92b9a103a36dc69d78518f3d22cdc116246 (patch) | |
| tree | d6261c67308cd95a07e9b51f8fd594bcd4d2e04b | |
| parent | d25b44f31f97edfadcb894d67872eecfa4eb91c5 (diff) | |
| download | spiffy-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.
| -rw-r--r-- | simple-directory-handler.scm | 53 |
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 () |