A Handy Web Server in Emacs Lisp

As I mentioned in my last post I’m still using Emacs. One of the big reasons is that I do the vast majority of my work as a Data Scientist over a text based terminal.

This differs substantially from the workflow of many of my colleagues. I’m not sure I’d say my workflow is optimal (though the case could be made), but it is foisted upon me by circumstance: my wife is a farmer and we have very low quality internet. Barely broadband, in fact. Consequently, if I want to work remotely, I have to make an effort to use the lowest bandwidth tools available to me. For me that is mosh which maintains a persistent connection to my remote machines and papers over some of the latency and Emacs.

Screen Shot 2019-10-13 at 8.06.58 PM

How the internet gets to my house.

Its important for me that all my data scientific work is reproducible and so I do most of my development in a Docker environment. I also break it up into discrete pieces which I orchestrate with Make. If you are a data scientist or any kind of scientist, you might be wondering how I manage this, since most of our work consists of generating and pouring through lots of figures.

The answer is that I dump all my figures directly to disk and then I look at them over a basic web server. Up until recently, that was something like this:

python3 -m http.server 8080

As I generate figures, I just pull them up in my web browser. This workflow works surprisingly well with tools like plotly, though my usual practice is to generate a pdf, png and plotly version of every figure. When I’m on a low bandwidth connection, I’m usually looking at those PNGs.

Irritations

This works fine. However, I generate hundreds of figures. The python one liner above always lists the contents of a directory in alphabetical order, which can make it hard to find precisely the thing I’m looking for. In addition to that, I’ve noticed Python 3’s built in web server tends to choke on large HTML files without linebreaks (which is precisely what plotly generates).

After shopping around for a slightly nice solution without much luck (a bunch of low configuration web servers are faster or smarter than Python, but none let me sort by date, as far as I could tell) I just decided to write my own.

Requirements

The tool needs to show me the most recently modified files underneath a specific directory. Its always going to be running behind a firewall but it should present a pretty small security cross section. It should be minimal in terms of requirements.

I like to write Lisp whenever I can so I decided to write the tool in Emacs Lisp. The added benefit is that it can run directly in the environment I use to do my work.

I don’t talk often about this, but Emacs Lisp is one of my favorite programming languages and Lisp dialects.

Firs things first. M-x package-list-packages Then let’s install the web-server package, which is what everyone seems to be using these days (if anything). We’ll also be using my own shadchen ML-style pattern matching library (which is a bit amateurish but totally serviceable).

We’re going to try to follow good Emacs Lisp conventions. Shadchen doesn’t but I’ll try to rewrite it sometime soon.

;; -*- lexical-binding: t; -*-

Because we’re civilized, modern, people.

(require 'shadchen)
(require 'web-server)

We’re going to need to generate some basic HTML. Consider:

(require 'shadchen)

(defun fserver-el (tag attributes &rest args)
  (cons tag (cons attributes args)))

(defun fserver-render-html-worker (html buffer)
  (with-current-buffer buffer
    (let ((tag (car html))
          (attributes (cadr html))
          (args (cddr html)))
      (insert (format "<%s" tag))
      (if (> (length attributes) 0)
          (insert " "))
      (loop for (a . r) on attributes by #'cdr
            do 
            (match a
              ((p #'symbolp s)
               (insert (symbol-name s)))
              ((list (p #'symbolp s)
                     (p #'stringp str))
               (insert (format "%s=%S"
                               s
                               str)))
              ((list (p #'symbolp s)
                     (p #'numberp n))
               (insert (format "%s=%S"
                               s
                               (number-to-string n))))
              ((list (p #'symbolp s)
                     (p #'symbolp s2))
               (insert (format "%s=%S"
                               s
                               (symbol-name s2)))))
            (if r (insert " ")))
      (insert ">")
      (if (> (length args) 0)
          (insert (format "\n")))
      (loop for (a . r) on args by #'cdr do
            (cond
             ((stringp a) (insert a))
             ((listp a) (fserver-render-html-worker a buffer)))
            (insert (format "\n")))
      (insert (format "</%s>\n" tag)))))

(defun fserver-render-html-to-string (html)
  (with-temp-buffer
    (fserver-render-html-worker html (current-buffer))
    (html-mode)
    (indent-region (point-min) (point-max))
    (buffer-substring (point-min) (point-max))))

(defmacro fserver-html (&rest body)
  `(cl-flet ((e (&rest args) (apply #'fserver-el args)))
     (fserver-render-html-to-string ,@body)))

With this little friend we can write the following sorts of code:

(fserver-html 
 (e 'div '((class nice-list))
  (e 'ul nil
   (e 'li '(selected) "Element 1")
   (e 'li nil "Element 2"))))

And get back the following string:

"<div class=\"nice-list\">
  <ul>
    <li selected>
      Element 1
    </li>

    <li>
      Element 2
    </li>

  </ul>

</div>
"

Isn’t Lisp great?

That covers generating HTML. Surprisingly simple.

Servicing HTTP Requests

Now we need our server.

(defvar *fserver-server* nil)
(defvar *fserver-port* 8888)
(defvar *fserver-handlers* nil)

(defun fserver-add-handler (matcher handler)
  (setq *fserver-handlers* 
        (append *fserver-handlers* (list (cons matcher handler))))
  (fserver-restart)
  *fserver-handlers*)

(defun fserver-clear-handlers ()
  (setq *fserver-handlers* nil)
  (fserver-restart)
  *fserver-handlers*)

(defun fserver-restart ()
  (interactive)
  (if *fserver-server* (ws-stop *fserver-server*))
  (setq *fserver-server* 
        (ws-start *fserver-handlers* *fserver-port*)))

(fserver-clear-handlers)

Now we just M-x fileserver-restart. Of course our server doesn’t do anything.

Let’s add some handlers. First a “Hello World”.

(fserver-add-handler
 '(:GET . "/")
 (lambda (request)
   (with-slots (process headers) request
     (ws-response-header process 200 `("Content-type" . "text/html"))
     (process-send-string
      process 
      (fserver-html 
       (e 'html nil
          (e 'head nil
             (e 'title nil "Hello World"))
          (e 'body nil
             (e 'div nil "Hello World"))))))))

Try it out, if you’re following along. It works!

Design of the Service

Our server is going to let us do two things: list files associated with a project and then serve those files.

We don’t want to expose our entire hard drive or just a single sub-path to the internet. So the server side will configure a list of project names and their local directory head.

(defvar *fserver-projects* nil)
(defun fserver-add-project (project-name root-directory)
  (setq *fserver-projects* (cons `(,project-name . ,root-directory)
                                 *fserver-projects*)))

(defun fserver-clear-projects ()
  (setq *fserver-projects* nil))

(defun fserver-get-project-root (project-name)
  (cdr (assoc project-name *fserver-projects*)))

Now we can design our first resource: one that lists all the files in a project, ordered by date:

GET /project/<project-name>/<filter>

Should list all the files beneath the project root (except for some obvious stuff like git contents and temp files). Filter is a set of characters that has to appear in the filename or it isn’t shown. If filter is empty, then all files are listed.

For the sake of simplicity we’re going to limit project names and filters to alphanumeric characters including underscores. This is easy to match as a regular expression, which is what we need to provide to our handler as a first pass at matching:

Here is a first jab:

(defun fserver-project-p (project-name)
  (not (not (fserver-get-project-root project-name))))

(defun fserver-valid-project-path (path)
  (let* ((parts (split-string path "/" t)))
    (and
     (string= "project" (car parts))
     (fserver-project-p (cadr parts)))))

(defun fserver-parse-project-path (path)
  (if (fserver-valid-project-path path)
      (let* ((parts (cdr (split-string path "/" t)))
             (project (car parts))
             (root (fserver-get-project-root project))
             (pattern (cadr parts)))
        (list project root pattern))
    nil))

(defun fserver-handle-project (request)
  (with-slots ((process process)
               (headers headers))
      request
    (match (fserver-parse-project-path (cdr (assoc :GET headers)))
      ((list project root pattern)
       (ws-response-header process 200 '("Content-type" . "text/plain"))
       (let ((files (shell-command-to-string
                     (format "find %s -type f" root))))
              (process-send-string
               process 
               files))))))

Which we register like this:

(fserver-add-handler
 (cons :GET
        (rx (and line-start "/project/"
          (one-or-more (or alphanumeric
                           (char "_")))
          (or
           (and
            (char "/")
            (one-or-more (or alphanumeric
                             (char "_")))
            (zero-or-more (char "/")))
           (zero-or-more (char "/"))))))
 #'fserver-handle-project)

(We’re using Emacs’s excellent regular expression construction facilities.)

fserver-parse-project-path validates that we have a good project, parses out the name, retrieves the associated root location, and also extracts the pattern, if any.

Then we just use that information to invoke find and get a raw file list. We want this list to be filtered down by the pattern and to exclude a few other things and then to be sorted by date-time. Finally, after we figure that out, we’re going to convert it to HTML.

We can prune out the git stuff with

(format "find %s -type f | grep -v \\.git" root)

But what is the best way to sort by date?

Something like this is pretty portable:

(defun fserver-stat-command ()
  (match system-type
    ('darwin "gstat -c '%Y --- %n' ")
    ((or 'gnu 'gnu/linux)
     "stat -c '%Y --- %n' ")))

(defun fserver-handle-project (request)
  (with-slots ((process process)
               (headers headers))
      request
    (match (fserver-parse-project-path (cdr (assoc :GET headers)))
      ((list project root pattern)
       (ws-response-header process 200 '("Content-type" . "text/plain"))
       (let ((files (shell-command-to-string
                     (format "find %s -type f | xargs %s | grep -v \\.git | sort -r " root (fserver-stat-command)))))
              (process-send-string
               process 
               files))))))

I’m checking whether I’m on Darwin in order to call the appropriate version of stat there. We’ve also filtered out the git subdirectory. Now let’s construct links. We are going to want our files to be accessible via the server at

GET /files/<project>/<path>

Where path is relative to the project given. So we want to replace the path returned by our shell call with the appropriate material. And we may as well convert it to HTML while we’re at it. Its more efficient using a regular expression to do this than it is to write it out in Elisp:

(defun fserver-handle-project (request)
  (with-slots ((process process)
               (headers headers))
      request
    (message (format "%S" (cdr (assoc :GET headers))))
    (match (fserver-parse-project-path (cdr (assoc :GET headers)))
      ((list project root pattern)
       (ws-response-header process 200 '("Content-type" . "text/html"))
       (let* ((files (shell-command-to-string
                      (format "find %s -type f | xargs %s %s | grep -v \\.git | sort -r " root (fserver-stat-command)
                              (if pattern (format "| grep %s " pattern) ""))))
              (retargeted (replace-regexp-in-string (regexp-quote (file-truename root))
                                                    (format "/file/%s" project)
                                                    files))
              (linkified (replace-regexp-in-string
                          "\\([0-9]+\\) --- \\(.*\\)"
                          "<li><a href=\"\\2\">\\2</a></li>"
                          retargeted)))
              (process-send-string
               process 
               (fserver-html
                (e 'html nil
                   (e 'head nil
                      (e 'title nil (format "Project: %s" project)))
                   (e 'body nil
                      (e 'h1 nil (format "Project: %s" project))
                      (if pattern
                          (e 'h3 nil (format "Just those matching: %s" pattern))
                        "")
                      (e 'ol nil linkified))))))))))
                      

Now all we have to do is implement the file serving resource. This is enough to parse and validate the resource for a file request:

(defun fserver-parse-file-path (url)
  (let* ((parts (split-string url "/" t))
         (project (cadr parts))
         (rest-of-path (cdr (cdr parts)))
         (filename (file-truename
                    (replace-regexp-in-string (regexp-quote (format "/file/%s" project))
                                              (fserver-get-project-root project)
                                              url))))
    (if (and
         (file-exists-p filename)
         (fserver-project-p project))
        (list project (file-truename (fserver-get-project-root project))
              (file-truename
               (replace-regexp-in-string (regexp-quote (format "/file/%s" project))
                                         (fserver-get-project-root project)
                                         url)))
      nil)))
      

Our handler is then relatively straightforward:

(defun fserver-handle-file (request)
  (with-slots ((process process)
               (headers headers))
      request
    (match (fserver-parse-file-path (cdr (assoc :GET headers)))
      ((list project root file)
       (ws-send-file process file)))))
       

This does the job – but our browser just tries to download any file we grab this way. We need to specify the Mime-Type for at least a few types of files if we want to get the desired behaviors. For instance, for HTML and image types, we want the browser to open them.

This leads, finally, to:

(defun fserver-get-mime-type (file)
  (match (downcase (fserver-file-extension file))
    ((and (or "png" "jpg" "jpeg" "gif" "bmp")
          ext)
     (format "image/%s" ext))
    ((and (or "html" "htm")
          ext)
     "text/html")
    ((or "txt" "md" "Rmd" "text" "csv" "tsv")
     "text/plain")
    ("json"
     "application/json")
    ("js"
     "application/javascript")))

(defun fserver-handle-file (request)
  (with-slots ((process process)
               (headers headers))
      request
    (match (fserver-parse-file-path (cdr (assoc :GET headers)))
      ((list project root file)
       (ws-send-file process file (fserver-get-mime-type file))))))

(fserver-add-handler
 (cons :GET
        (rx (and line-start "/file/"
                 (one-or-more (or alphanumeric
                                  (char "_")))
                 (char "/")
                 (one-or-more anything))))
 #'fserver-handle-file)

And now we’re done, pretty much. A simple, useful, file server we can control from inside emacs.

Leave a Reply

Your email address will not be published. Required fields are marked *