;;;; simple-directory-handler.scm
;
; Copyright (c) 2007-2009, 2012, 2018-2019, Peter Bex
; Copyright (c) 2000-2005, Felix L. Winkelmann
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions
; are met:
;
; 1. Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
; 2. Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following disclaimer in the
; documentation and/or other materials provided with the distribution.
; 3. Neither the name of the author nor the names of its
; contributors may be used to endorse or promote products derived
; from this software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
; OF THE POSSIBILITY OF SUCH DAMAGE.
(module simple-directory-handler
(simple-directory-handler simple-directory-dotfiles?
simple-directory-display-file)
(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 (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
(make-parameter
(lambda (remote-file local-file dir?)
(sprintf "
| ~a |
~a |
~a |
\n"
(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
(sprintf
"
Index of ~a
Index of ~a:
Go to parent directory
| Name |
Size |
Last modified |
~a
"
path
path
(or (pathname-directory path) path)
(let ((dir (sort (directory (make-pathname (root-path) path)
(simple-directory-dotfiles?))
string