eschulte pushed a commit to branch master
in repository elpa.
commit 4aca1daf66b2926a16809500589e96201bb2a64b
Author: Eric Schulte <schulte.e...@gmail.com>
Date: Sat Jan 11 17:17:28 2014 -0700
helper function to serve directory listings
and updated the file-server example to use this helper function
---
doc/web-server.texi | 23 ++++++++++++++++-------
examples/003-file-server.el | 16 +++++++++-------
web-server.el | 22 ++++++++++++++++++----
3 files changed, 43 insertions(+), 18 deletions(-)
diff --git a/doc/web-server.texi b/doc/web-server.texi
index 06f2982..0e2c8e0 100644
--- a/doc/web-server.texi
+++ b/doc/web-server.texi
@@ -226,13 +226,13 @@ response instead of a simple @code{text/plain} response.
The following example implements a file server which will serve files
from the @code{docroot} document root set to the current working
-directory in this example. Three helper functions are used;
-@code{ws-subdirectoryp} is used to check if the requested path is
-within the document root, if so the file is served and
-@code{ws-send-file} is used to appropriately set the mime-type of the
-response based on the extension of the file, if not then
-@code{ws-send-404} is used to send a default ``File Not Found''
-response.
+directory in this example. Four helper functions are used;
+@code{ws-in-directory-p} is used to check if the requested path is
+within the document root. If not then @code{ws-send-404} is used to
+send a default ``File Not Found''. If so then the file is served with
+@code{ws-send-file} (which appropriately sets the mime-type of the
+response based on the extension of the file) if it is a file or is
+served with @code{ws-send-directory-list} if it is a directory.
@verbatiminclude ../examples/003-file-server.el
@@ -442,6 +442,15 @@ mime-type is determined by calling
@code{mm-default-file-encoding} on
can be determined.
@end defun
+@anchor{ws-send-directory-list}
+@defun ws-send-directory-list process directory &optional match
+@code{ws-send-directory-list} sends the a listing of the files located
+in @code{directory} to @code{process}. The list is sent as an HTML
+list of links to the files. Optional argument @code{match} may be set
+to a regular expression, in which case only those files that match are
+listed.
+@end defun
+
@anchor{ws-in-directory-p}
@defun ws-in-directory-p parent path
Check if @code{path} is under the @code{parent} directory.
diff --git a/examples/003-file-server.el b/examples/003-file-server.el
index e56a023..394d368 100644
--- a/examples/003-file-server.el
+++ b/examples/003-file-server.el
@@ -1,11 +1,13 @@
;;; file-server.el --- serve any files using Emacs Web Server
(lexical-let ((docroot default-directory))
(ws-start
- (list (cons (cons :GET ".*")
- (lambda (request)
- (with-slots (process headers) request
- (let ((path (substring (cdr (assoc :GET headers)) 1)))
- (if (ws-in-directory-p docroot path)
- (ws-send-file process (expand-file-name path docroot))
- (ws-send-404 process)))))))
+ (lambda (request)
+ (with-slots (process headers) request
+ (let ((path (substring (cdr (assoc :GET headers)) 1)))
+ (if (ws-in-directory-p docroot path)
+ (if (file-directory-p path)
+ (ws-send-directory-list process
+ (expand-file-name path docroot) "^[^\.]")
+ (ws-send-file process (expand-file-name path docroot)))
+ (ws-send-404 process)))))
9003))
diff --git a/web-server.el b/web-server.el
index f9187ae..9bc5772 100644
--- a/web-server.el
+++ b/web-server.el
@@ -548,13 +548,27 @@ Optionally explicitly set MIME-TYPE, otherwise it is
guessed by
(insert-file-contents-literally path)
(buffer-string)))))
+(defun ws-send-directory-list (proc directory &optional match)
+ "Send a listing of files in DIRECTORY to PROC.
+Optional argument MATCH is passed to `directory-files' and may be
+used to limit the files sent."
+ (ws-response-header proc 200 (cons "Content-type" "text/html"))
+ (process-send-string proc
+ (concat "<ul>"
+ (mapconcat (lambda (f) (format "<li><a href=%S>%s</li>" f f))
+ (directory-files directory nil match)
+ "\n")
+ "</ul>")))
+
(defun ws-in-directory-p (parent path)
"Check if PATH is under the PARENT directory.
If so return PATH, if not return nil."
- (let ((expanded (expand-file-name path parent)))
- (and (>= (length expanded) (length parent))
- (string= parent (substring expanded 0 (length parent)))
- expanded)))
+ (if (zerop (length path))
+ parent
+ (let ((expanded (expand-file-name path parent)))
+ (and (>= (length expanded) (length parent))
+ (string= parent (substring expanded 0 (length parent)))
+ expanded))))
(defun ws-with-authentication (handler credentials
&optional realm unauth invalid)
