#!/bin/sh
# -*- scheme -*-
case $ZSH_VERSION in ?*) alias -g '${1+"$@"}="$@"';; *) :;; esac &&
exec "${GUILE-guile}" -e main -s "$0" ${1+"$@"}
!#
(read-enable 'positions)
(debug-enable 'backtrace)
(debug-enable 'debug)
(use-modules ((srfi srfi-13) :select (string-pad)))
(use-modules ((ice-9 ftw) :select (directory-files)))
(load "/package/prog/prjlibs/scheme/load.scm")
(/package/prog/prjlibs/load
"/package/prog/prjlibs/scheme/string.scm"
'(s+ drop-suffix))
(/package/prog/prjlibs/load
"/package/prog/prjlibs/scheme/files.scm"
'(open:create-flags))
(/package/prog/prjlibs/load
"/package/prog/prjlibs/scheme/errors.scm"
'(exit-for-system-error system-error-case))
(/package/prog/prjlibs/load
"/package/prog/prjlibs/scheme/syntax.scm"
'(when values&forms))
(define syscase system-error-case)
(define v&f values&forms)
(define index- "index.html")
(define index-new- (s+ index- "{new}"))
(define html '((#\& . "&")
(#\< . "<")
(#\> . ">")
(#\" . """)))
(define (html-escape str)
(apply s+ (map
(lambda (char)
(or (assq-ref html char) (string char)))
(string->list str))))
(define (main args)
(define (do-it)
(for-each
(lambda (dir)
(set! dir (or (drop-suffix "/" dir) dir))
(let* ((index (s+ dir "/" index-))
(index-new (s+ dir "/" index-new-))
(files (sort (directory-files dir) string
Listing: " title "
Listing: " title "
Parent directory
Last modified Size File
") fh)
(for-each
(lambda (file)
(when (not (member file `(,index- ,index-new- ":.")))
(let ((escfile (html-escape file))
(st (catch
'system-error
(lambda () (stat (s+ dir "/" file)))
(lambda ex (lstat (s+ dir "/" file))))))
(if (eq? 'directory (stat:type st))
(set! escfile (s+ escfile "/")))
(display
(s+ (strftime "%Y-%m-%d %H:%M:%S " (gmtime (stat:mtime st)))
(string-pad (number->string (stat:size st)) 10)
" bytes "
escfile "\n")
fh))))
files)
(display "
\n\n\n" fh)
(force-output fh)
(fsync fh)
(close-port fh)
(rename-file index-new index)))
(cdr args)))
(exit-for-system-error "indexhtml" do-it))