diff hunchentoot-0.6.1/hunchentoot.asd hunchentoot/hunchentoot.asd
47a48
> :cl-fad
diff hunchentoot-0.6.1/misc.lisp hunchentoot/misc.lisp
140,141c140,142
< (unless (or (pathname-name path)
< (pathname-type path))
---
> (unless (and path
> (or (pathname-name path)
> (pathname-type path)))
179a181,300
> (defun file-size (file)
> "Returns filesize in bytes, or NIL if it is a directory."
> (cl:ignore-errors
> (with-open-file (in file :direction :input)
> (file-length in))))
>
> (defstruct file-details name date size (desc "" :type string))
>
> (defun file-date-string (file-details)
> "Returns a descriptive string like \"15-Feb-2007\"."
> (multiple-value-bind
> (second minute hour date month year)
> (decode-universal-time (file-details-date file-details))
> (declare (ignore second minute hour))
> (let ((month-names
> '("Jan" "Feb" "Mar" "Apr" "May" "Jun"
> "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))
> (format nil "~2,'0d-~A-~D"
> date (nth (1- month) month-names) year))))
>
> (defun file-size-string (file-details)
> "Returns a descriptive string like \"1.3K\" or \"8M\"."
> (let ((size (file-details-size file-details)))
> (cond ((not (numberp size)) "- ")
> ((< size 1024) (format nil "~D " size))
> ((< size (* 1024 1024)) (format nil "~,1FK" (/ size 1024)))
> (t (format nil "~,1FM" (/ size (* 1024 1024)))))))
>
> (defun maybe-integer-lessp (a b)
> "If both a & b are numbers, then it's just like #'<
> Otherwise, non number goes first."
> (cond ((and (numberp a) (numberp b))
> (< a b))
> ((numberp b) t)
> (t nil)))
>
> (defun sort-file-details (list &optional (sort-column "N") (sort-order "A"))
> "Sort file-details based on sort column and order."
> (let* ((sort-column (intern sort-column :keyword))
> (compare-func
> (ecase sort-column
> ((:M :S) #'maybe-integer-lessp)
> ((:N :D) #'string-lessp)))
> (selector
> (ecase sort-column
> (:N #'file-details-name)
> (:M #'file-details-date)
> (:S #'file-details-size)
> (:D #'file-details-desc)))
> (results (sort list compare-func :key selector)))
> (if (string-equal sort-order "D")
> (nreverse results)
> results)))
>
> (defun redirect-if-malformed-pathspec ()
> "Directory listing request should end in a forward slash like
> \"http://localhost/hunchentoot/code/\". Fix it if it is not the
> case."
> (let* ((script-name (script-name))
> (length (length script-name)))
> (unless (and (> length 0)
> (char= (aref script-name (1- length)) #\/))
> ;; stripping the query string is OK
> (redirect (concatenate 'string script-name "/")))))
>
> (defun folder-index-page (pathname)
> "Returns a html page with a directory listing like those generated
> by Apache."
> (redirect-if-malformed-pathspec)
> (let* ((contents (cl-fad:list-directory (namestring pathname)))
> (title (format nil "Index of ~A" (script-name)))
> (sort-column (get-parameter "C"))
> (sort-order (get-parameter "O")))
> (flet ((file-details (file)
> (make-file-details :name (enough-namestring file pathname)
> :date (file-write-date file)
> :size (file-size file))))
> ;; taint get-parameters
> (unless (member sort-column '("N" "M" "S" "D") :test #'string-equal)
> (setq sort-column "N"))
> (unless (member sort-order '("A" "D") :test #'string-equal)
> (setq sort-order "A"))
> ;; page-out
> (with-output-to-string (out)
> (format out "~A
> ~A
" title title)
> ;; column headers
> (loop for (query-char desc) in
> '(("N" "Name")
> ("M" "Last modified")
> ("S" "Size")
> ("D" "Description")) do
> (format out "| ~A | "
> query-char
> (or (when (string-equal query-char sort-column)
> (if (string-equal sort-order "D") "A" "D"))
> "A")
> desc))
> (format out "
|
> | Parent Directory |
> | | |
")
> (dolist (d (sort-file-details
> (mapcar #'file-details contents)
> sort-column sort-order))
> (format out "| ~A | "
> (file-details-name d) (file-details-name d))
> (format out "~A | ~A | ~A |
"
> (file-date-string d)
> (file-size-string d)
> (file-details-desc d)))
> (format out "
|
> ~A
" (address-string))))))
>
206c327,330
< (handle-static-file (merge-pathnames script-path base-path) content-type))))
---
> (let ((pathname (probe-file (merge-pathnames script-path base-path))))
> (if (and pathname (cl-fad:directory-pathname-p pathname))
> (folder-index-page pathname)
> (handle-static-file pathname content-type))))))
diff hunchentoot-0.6.1/test/test.lisp hunchentoot/test/test.lisp
503a504,505
> (:tr (:td (:a :href "/hunchentoot/code/"
> "Listing of the code directory")))
diff hunchentoot-0.6.1/doc/index.html hunchentoot/doc/index.html
128c128
< and my own Chunga, CL-PPCRE, and URL-REWRITE (plus CL-WHO for the example code).
---
> and my own Chunga, CL-PPCRE, CL-FAD, and URL-REWRITE (plus CL-WHO for the example code).