Every now and then I find myself needing to serve a directory over HTTP - for instance, to quickly transfer files to another machine in the same LAN (especially when that machine turns out to be a phone).
To accomplish that, I used to run Python's SimpleHTTPServer directly from Fish shell, wrapped in a helper function:
function serve_this; python -m SimpleHTTPServer; end
I'm in process of migrating more and more of my workflow to Emacs - including file management and shell operations - so I naturally started to wonder, how to implement that particular utility in my favorite operating system.
Serving files from Emacs
Emacs is (obviously) perfectly capable of running a HTTP server, and someone (obviously) wrote a package for it - named, appropriately, web-server.
Since it's available on ELPA (the default Emacs package repository), it was a good choice to base the implementation on.
The following is the code for basic implementation of the utility, ready to be copied into your config. Further on, I discuss it in more details, and follow up with aesthetic improvements and eshell integration. The complete code with all the improvements can be assembled from pieces posted here, or taken from this gist.
(Note that the code depends on web-server - ensure it's installed and loaded before evaluating this source block. Myself, I just
put it in the :config section of use-package invocation.)
(defvar my/file-server nil "Is the file server running? Holds an instance if so.")
(defalias 'my/send-directory-list 'ws-send-directory-list)
(defun my/ws-start (handlers port &optional log-buffer &rest network-args)
"Like `ws-start', but unbroken for Emacs 25+."
(let ((server (make-instance 'ws-server :handlers handlers :port port))
(log (when log-buffer (get-buffer-create log-buffer))))
(setf (process server)
(apply
#'make-network-process
:name "ws-server"
:service (port server)
:filter 'ws-filter
:server t
:nowait nil
:family 'ipv4
:coding 'no-conversion
:plist (append (list :server server)
(when log (list :log-buffer log)))
:log (when log
(lambda (proc request message)
(let ((c (process-contact request))
(buf (plist-get (process-plist proc) :log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(insert (format "%s\t%s\t%s\t%s"
(format-time-string ws-log-time-format)
(first c) (second c) message))))))
network-args))
(push server ws-servers)
server))
(defun my/serve-directory (directory port)
(interactive "DDirectory: \nnPort: ")
;; Based on http://eschulte.github.io/emacs-web-server/File-Server.html#File-Server.
(if my/file-server
(message "File server is already running!")
(progn
(setf my/file-server
(lexical-let ((docroot directory))
(my/ws-start
(lambda (request)
(with-slots (process headers) request
(let* ((path (substring (cdr (assoc :GET headers)) 1))
(expanded (ws-in-directory-p docroot path)))
(if (and expanded
(file-exists-p expanded))
(if (file-directory-p expanded)
(my/send-directory-list process expanded)
(ws-send-file process (expand-file-name path docroot)))
(ws-send-404 process)))))
port
nil ;no log buffer
:host "0.0.0.0")))
(message "Serving directory %s on port %d" directory port))))
(defun my/stop-server ()
"Stop the file server if running."
(interactive)
(if my/file-server
(progn
(ws-stop my/file-server)
(setf my/file-server nil)
(message "Stopped the file server."))
(message "No file server is running.")))
Evaluating the above code is enough to get the basic functionality, as presented below:
Serving directories is as simple as running M-x my/serve-directory, and specifying directory
and server port. Stopping the server can be accomplished with M-x my/stop-server.
my/ws-start workaround
The web-server package doesn't work correctly by default under Emacs 26 (and possibly 25). This is due to apparent
bug in handling of calls to make-network-process (see here, here). The simplest way to patch it was to copy the original
ws-start function and modify the make-network-process call to use nil as the value of :nowait option.
If you're using Emacs 25 and :nowait nil works for you, consider removing the my/ws-start function and using
the ws-start function instead.
(Note that if only ws-start prepended its network-args list in the apply call instead of putting it at the end,
I would be able to override the :nowait value by just passing it as an argument. Alas, I had to fix the entire
function.)
Sending the directory listing
The HTTP handler passed as an argument to my/ws-start uses the path passed in the request to determine whether
the target resource is a file or directory. To send a directory, the code above uses another function from the web-server
package - ws-send-directory-list (through the alias my/send-directory-list). Let's look at that function's signature:
(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."
...)
The docstring tells us about the match argument being passed to directory-files Emacs function. From documentation:
If MATCH is non-nil, mention only file names that match the regexp MATCH.
This argument can be used to filter out files and directories from the returned listing. For instance,
the example file server implementation I'm building on uses "^[^\.]" to filter out the ".", ".." pseudo-directories
and (possibly unintentionally) dotfiles. In my implementation I left it out, however, to allow the improved
directory listing code (below) to filter out "." and ".." manually.
Prettifying the file list
Let's compare that with the default output of Python's SimpleHTTPServer:
Pythons is definitely prettier. Fortunately, it's simple to improve on the code above, and also add some extra useful information - like sizes and last modification dates for each entry. This requires writing a custom implementation for outputting directory listing.
Replace (defalias 'my/send-directory-list 'ws-send-directory-list) with
the following function:
(defun my/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
;; header
"<!DOCTYPE html>\n"
"<html><head><title>Directory listing for "
directory
"</title></head><body>"
"<h2>Directory listing for <tt>"
directory
"</tt></h2>"
"<table>"
;; "Up one level" link
"<tr><td></td><td></td><td><a href='../'>Up one level</a></td></tr>"
;; Actual directory listing
(mapconcat (lambda (f-and-attr)
(let* ((name (first f-and-attr))
(attr (rest f-and-attr))
(full (expand-file-name name directory))
(end (if (file-directory-p full) "/" ""))
(url (url-encode-url (concat name end)))
(modtime (format-time-string "%Y-%m-%d %T %z" (file-attribute-modification-time attr)))
(size (file-attribute-size attr)))
(format "<tr><td><small>%s</small></td><td><small>%s</small></td><td><a href='%s'>%s%s</a></td></tr>" modtime size url name end)))
(remove-if (lambda (entry)
(or (string= (car entry) ".")
(string= (car entry) "..")))
(directory-files-and-attributes directory nil match))
"\n")
;; Footer
"</table></body></html>")))
Much better!
Previously, I mentioned that web-server's implementation uses directory-files function to list files. The improved code
uses its sibling - directory-files-and-attributes - which returns entries in the form of (name . attributes). Compare:
(directory-files "/tmp/test-directory")
;; ->
("." ".." ".emacs" ".gitconfig" "a-subdirectory")
(directory-files-and-attributes "/tmp/test-directory")
;; ->
(("." t 3 1000 1000 (23305 35088 307349 257000) (23305 35068 419401 610000) (23305 35068 419401 610000) 4096 "drwxrwxr-x" t 5636571 2065)
(".." t 25 0 0 (23305 34969 731662 280000) (23305 35020 155528 902000) (23305 35020 155528 902000) 12288 "drwxrwxrwt" t 5636097 2065)
(".emacs" "/home/temporal/repos/conffiles/emacs25/.emacs" 1 1000 1000 (23305 35053 639440 555000) (23305 35053 635440 565000) (23305 35053 635440 565000) 45 "lrwxrwxrwx" t 5636573 2065)
(".gitconfig" nil 1 1000 1000 (23304 15357 454324 784000) (23151 13649 999692 371000) (23305 35068 419401 610000) 277 "-rw-r--r--" t 5636575 2065)
("a-subdirectory" t 2 1000 1000 (23305 35025 19516 58000) (23305 35025 19516 58000) (23305 35025 19516 58000) 4096 "drwxrwxr-x" t 5636572 2065))
directory-files-and-attributes returns plenty of useful attributes - including access/modification/status change times,
permission strings in format like ls -l, and an indication whether an entry is a file, directory, or a symbolic link. Emacs also defines
helper functions for convenient access to returned attributes - see M-x apropos file-attribute-* for a list.
Convenience and integrating with eshell
Ultimately, I wanted to replicate the convenience of typing serve_this in the shell. Nowadays, I do most of my shell work in
eshell, which has a very convenient feature - any elisp function with a name starting with eshell/ (e.g. eshell/foo) is available in eshell
as a command (e.g. foo). The code below uses this to implement serving current directory and stopping the server as eshell
commands - serve-this and stop-server, respectively. serve-this can accept an optional number, if you want to pick the port on
which to serve files.
The code also implements a M-x serve-this interactive command for easy access from anywhere within Emacs.
(defun my/serve-this (port)
"Start a file server on a `PORT', serving the content of directory
associated with the current buffer's file."
(interactive "nPort: ")
(my/serve-directory (if (buffer-file-name)
(file-name-directory (buffer-file-name))
(expand-file-name default-directory))
port))
;; Eshell utilities.
(defconst my/default-directory-server-port 8123)
(defun eshell/serve-this (&optional port)
(my/serve-this (or port my/default-directory-server-port)))
(defalias 'eshell/stop-server 'my/stop-server)
That's it! A complete and relatively nice-looking solution for serving directories and files over HTTP, written entirely within Emacs!
Further considerations
The above solution is pretty much complete, and it's enough for my typical usage patterns. I have, however, some potential ideas for improvements.
Logging
The functions ws-start and my/ws-start both accept an optional log-buffer argument. It can be used to make the server
process use (or create) a new buffer, in which it'll log requests. I don't need it, but it's trivial to modify my/serve-directory
to make use of it. The argument can be a buffer object, or a string - if that string doesn't name an existing buffer, a new
buffer will be created. This buffer probably doesn't need undo functionality, so you may want to consider passing a string
starting with space - per documentation of get-buffer-create, a new buffer with such name will not keep undo information.
Multiple servers
Yet another feature that I personally don't need, but if you wanted, you could make my/serve-directory and my/stop-server work
on a list or hash table of server instances, keyed by port number, instead of sharing the my/file-server global variable.