diff --git a/src/main/utility.cl b/src/main/utility.cl index 0910120..8294d9b 100644 --- a/src/main/utility.cl +++ b/src/main/utility.cl @@ -26,11 +26,22 @@ file-entity." :entity (make-instance 'file-entity :content-type type :pathname file)))) -(defun export-directory (server type-map base directory &optional recursive-p) - "Export the contents of a directory." +(defun export-directory + (server type-map base directory + &key (entity-class 'file-entity) recursive-p index-redir-p) + "Export the contents of a directory(-tree)." (flet ((lookup-type (type) (or (cdr (assoc type type-map :test #'equal)) (cdr (assoc t type-map :test #'equal))))) + (when index-redir-p + (export-resource server base 'redirector-resource + :destination + (merge-urls + (if (eq index-redir-p t) + (make-instance 'url-http :scheme nil + :name "index.html") + index-redir-p) + base))) (dolist (file (directory directory)) (if (null (pathname-name file)) (when recursive-p @@ -38,21 +49,22 @@ file-entity." server type-map (merge-urls (make-instance - 'url-http + 'url-http :scheme nil :directory (list* :relative (last (pathname-directory file)))) base) file - recursive-p)) + :entity-class entity-class :index-redir-p index-redir-p + :recursive-p t)) (export-resource server (merge-urls - (make-instance 'url-http :name + (make-instance 'url-http :scheme nil :name (concatenate 'string (pathname-name file) "." (pathname-type file))) base) 'static-resource :entity - (make-instance 'file-entity + (make-instance entity-class :content-type (lookup-type (pathname-type file)) :pathname file))))))