emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 93/119: helper function to serve directory listings


From: Eric Schulte
Subject: [elpa] 93/119: helper function to serve directory listings
Date: Mon, 10 Mar 2014 16:57:50 +0000

eschulte pushed a commit to branch master
in repository elpa.

commit 4aca1daf66b2926a16809500589e96201bb2a64b
Author: Eric Schulte <address@hidden>
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;
address@hidden is used to check if the requested path is
-within the document root, if so the file is served and
address@hidden is used to appropriately set the mime-type of the
-response based on the extension of the file, if not then
address@hidden is used to send a default ``File Not Found''
-response.
+directory in this example.  Four helper functions are used;
address@hidden 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
address@hidden (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
 
address@hidden
address@hidden ws-send-directory-list process directory &optional match
address@hidden 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.
address@hidden 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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]