Skip to content
Browse files

Initial commit.

  • Loading branch information...
0 parents commit b81612548081d285fb78a6ba73b2340470e56ed4 @technomancy committed Oct 20, 2011
Showing with 1,277 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +1 −0 Procfile
  3. +5 −0 README.md
  4. +11 −0 bin/compile
  5. +8 −0 bin/detect
  6. +5 −0 bin/release
  7. +1,229 −0 elnode.el
  8. +16 −0 init.el
2 .gitignore
@@ -0,0 +1,2 @@
+/emacs/
+/emacs.tar.gz
1 Procfile
@@ -0,0 +1 @@
+web: tar xzf emacs.tar.gz && ln -s $PWD/emacs /tmp/emacs; emacs/bin/emacs --daemon --load init.el
5 README.md
@@ -0,0 +1,5 @@
+# Commodore Night Vision
+
+Because it's possible. Not because it's a good idea.
+
+![Commodore Night Vision](http://m.assetbar.com/uuafSWx5l.gif)
11 bin/compile
@@ -0,0 +1,11 @@
+#!/bin/sh
+
+indent() {
+ sed -u 's/^/ /'
+}
+
+echo "-----> Found an init.el file."
+
+echo "Downloading Emacs 24 pretest from http://p.hagelb.org/emacs.tar.gz..." | indent
+curl -s -o $1/emacs.tar.gz http://p.hagelb.org/emacs.tar.gz
+echo "...done" | indent
8 bin/detect
@@ -0,0 +1,8 @@
+#!/bin/sh
+
+if [ -f $1/init.el ]; then
+ echo "EmacsLisp"
+ exit 0
+else
+ exit 1
+fi
5 bin/release
@@ -0,0 +1,5 @@
+#!/bin/sh
+
+cat << EOF
+--- {}
+EOF
1,229 elnode.el
@@ -0,0 +1,1229 @@
+;;; elnode.el --- a simple emacs async HTTP server -*- lexical-binding: t -*-
+
+;; Copyright (C) 2010 Nic Ferrier
+
+;; Author: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Maintainer: Nic Ferrier <nferrier@ferrier.me.uk>
+;; Created: 5th October 2010
+;; Version: 0.7
+;; Keywords: lisp, http
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This is an elisp version of the popular node.js asynchronous
+;; webserver toolkit.
+;;
+;; You can define HTTP request handlers and start an HTTP server
+;; attached to the handler. Many HTTP servers can be started, each
+;; must have it's own TCP port. Handlers can defer processing with a
+;; signal (which allows comet style resource management)
+;;
+;; See elnode-start for how to start an HTTP server.
+
+;;; Source code
+;;
+;; elnode's code can be found here:
+;; http://github.com/nicferrier/elnode
+
+;;; Style note
+;;
+;; This codes uses the Emacs style of:
+;;
+;; elnode--private-function
+;;
+;; for private functions.
+
+
+;;; Code:
+
+(require 'mm-encode)
+(require 'mailcap)
+(require 'url-util)
+(require 'ert)
+
+(eval-when-compile (require 'cl))
+
+(defgroup elnode nil
+ "An extensible asynchronous web server for Emacs."
+ :group 'applications
+ )
+
+(defvar elnode-server-socket nil
+ "Where we store the server sockets.
+
+This is an alist of proc->server-process:
+
+ (port . process)")
+
+(defvar elnode-server-error-log "*elnode-server-error*"
+ "The buffer where error log messages are sent.")
+
+
+;; Useful macros for testing
+
+(defmacro elnode--mock-process (process-bindings &rest body)
+ "Allow easier elnode testing by mocking the process functions.
+
+For example:
+
+ (elnode--mock-process (:elnode-http-params
+ (:elnode-http-method \"GET\")
+ (:elnode-http-query \"a=10\"))
+ (should (equal 10 (elnode-http-param 't \"a\")))
+ )
+
+Causes:
+
+ (process-get anything :elnode-http-method)
+
+to always return \"GET\".
+
+'process-put' is also remapped, currently to swallow any setting.
+
+'process-buffer' is also remapped, to deliver a fake (empty)
+buffer. This is probably not necessary and might go in the
+future.
+
+This is a work in progress - not sure what we'll return yet."
+ (declare (indent defun))
+ (let ((pvvar (make-symbol "pv")))
+ `(let
+ ;; Turn the list of bindings into an alist
+ ((,pvvar (list ,@(loop for f in process-bindings
+ collect
+ (if (listp f)
+ (list 'cons `(quote ,(car f)) (cadr f))
+ (list 'cons `,f nil))))))
+ (flet ((process-get
+ (proc key)
+ (let ((pair (assoc key ,pvvar)))
+ (if pair
+ (cdr pair))))
+ (process-put
+ ;; FIXME This should probably update ,pvvar with the new value?
+ (proc key value))
+ ;; We shouldn't actually need this because you should
+ ;; arrange things so the buffer isn't read
+ (process-buffer
+ (proc)
+ (get-buffer-create "* dummy proc buffer *")))
+ ,@body
+ ))))
+
+
+;; Error log handling
+
+(defun elnode-error (msg &rest args)
+ "Log MSG with ARGS as an error.
+
+This function is available for handlers to call. It is also used
+by elnode iteslf.
+
+There is only one error log, in the future there may be more."
+ (with-current-buffer (get-buffer-create elnode-server-error-log)
+ (goto-char (point-max))
+ (insert (format "elnode-%s: %s\n"
+ (format-time-string "%Y%m%d%H%M%S")
+ (if (car-safe args)
+ (apply 'format `(,msg ,@args))
+ msg)))))
+
+(ert-deftest elnode-test-error-log ()
+ (let ((err-message "whoops!! something went wrong! %s" )
+ (err-include '("some included value")))
+ (if (get-buffer elnode-server-error-log)
+ (kill-buffer elnode-server-error-log))
+ (apply 'elnode-error `(,err-message ,@err-include))
+ (should (string-match
+ (format "^elnode-.*: %s\n$" (apply 'format `(,err-message ,@err-include)))
+ (with-current-buffer (get-buffer elnode-server-error-log)
+ (buffer-substring (point-min) (point-max)))))))
+
+
+
+;; Defer stuff
+
+(put 'elnode-defer 'error-conditions '(elnode-defer)) ;; the elnode defer signal
+
+(defvar elnode--deferred
+ '()
+ "list of deferred pairs: (socket . handler)")
+
+(defun elnode-defer-now (handler)
+ "The function you call to defer processing of the current socket.
+
+Pass in the current HANDLER.
+
+FIXME: We could capture the current handler somehow? I think the
+point is that whatever signals elnode-defer should be getting
+control back when the deferred is re-processed."
+ (signal 'elnode-defer handler)
+ )
+
+(defmacro elnode-defer-or-do (guard &rest body)
+ "Test the GUARD and defer if it suceeds and BODY if it doesn't."
+ `(if ,guard
+ (elnode-defer-now (lambda (httpcon) ,@body))
+ (progn
+ ,@body))
+ )
+
+(defun elnode--deferred-add (httpcon handler)
+ "Add the specified HTTPCON HANDLER pair to the list to be processed later.
+
+Basically, add the HTTPCON connection and the HANDLER that is
+dealing with it to enable comet like behaviour."
+ ;; Update the elnode--deferred list directly.
+ ;; Remember, there are no concurrency issues here.
+ (if elnode--deferred
+ (setcdr
+ (last elnode--deferred)
+ (cons `(,httpcon . ,handler) nil))
+ (setq elnode--deferred (cons `(,httpcon . ,handler) nil))
+ )
+ )
+
+(defun elnode--deferred-processor ()
+ "Called by an idle timer to process any deferred socket/handler pairs.
+
+It's this that gives elnode the ability to be a COMET server."
+ (let* ((lst 'elnode--deferred))
+ (while (eval lst)
+ (let* ((pair (car (eval lst)))
+ (httpcon (car pair))
+ (handler (cdr pair)))
+ ;; This could benefit from a try/catch/else type form
+ (catch 'next
+ (condition-case signal-value
+ ;; Defer handling - for comet style operations
+ (funcall handler httpcon)
+ ('elnode-defer
+ ;; We need to continue to defer this
+ ;; basically it means not removing it from the list
+ (throw 'next 't)))
+ ;; We completed without a defer signal so we need to remove the pair
+ (set lst (cdr (eval lst)))
+ )
+ )
+ )
+ )
+ )
+
+(defvar elnode--defer-timer nil
+ "The timer used by the elnode defer processing.
+
+This is initialized by `elnode--init-deferring'."
+ )
+
+(defun elnode--init-deferring ()
+ "Initialize elnode defer processing. Necessary for running comet apps."
+ (setq elnode--defer-timer
+ (run-with-idle-timer 0.1 't 'elnode--deferred-processor))
+ )
+
+
+;; Main control functions
+
+(defun elnode--sentinel (process status)
+ "Sentinel function for the main server and for the client sockets."
+ (cond
+ ;; Server status
+ ((and
+ (assoc (process-contact process :service) elnode-server-socket)
+ (equal status "deleted\n"))
+ (kill-buffer (process-buffer process))
+ (elnode-error "Elnode server stopped"))
+
+ ;; Client socket status
+ ((equal status "connection broken by remote peer\n")
+ (if (process-buffer process)
+ (progn
+ (kill-buffer (process-buffer process))
+ (elnode-error "Elnode connection dropped")))
+ )
+
+ ((equal status "open\n") ;; this says "open from ..."
+ (elnode-error "Elnode opened new connection"))
+
+ ;; Default
+ (t
+ (elnode-error "Elnode status: %s %s" process status))
+ ))
+
+(defun elnode--filter (process data)
+ "Filter for the clients.
+
+This does the work of finding and calling the user http
+connection handler for a request.
+
+A buffer for the http connection is created, uniquified by the
+port number of the connection."
+ (let ((buf (or
+ (process-buffer process)
+ ;; Set the process buffer (because the server doesn't automatically allocate them)
+ ;; the name of the buffer has the client port in it
+ ;; the space in the name ensures that emacs does not list it
+ (let* ((port (cadr (process-contact process))))
+ (set-process-buffer
+ process
+ (get-buffer-create (format " *elnode-request-%s*" port)))
+ (process-buffer process)))))
+ (with-current-buffer buf
+ (insert data)
+ ;; We need to check the buffer for \r\n\r\n which marks the end of HTTP header
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "\r\n\r\n" nil 't)
+ (let ((server (process-get process :server)))
+ ;; This is where we call the user handler
+ ;; TODO: this needs error protection so we can return an error?
+ (condition-case signal-value
+ ;; Defer handling - for comet style operations
+ (funcall (process-get server :elnode-http-handler) process)
+ ('elnode-defer
+ ;; The handler's processing of the socket should be deferred
+ ;; - the value of the signal is the current handler (see elnode-defer-now)
+ (elnode--deferred-add process (cdr signal-value)))
+ ('t
+ ;; Try and send a 500 error response
+ ;; FIXME: we need some sort of check to see if the header has been written
+ (process-send-string
+ process
+ "HTTP/1.1 500 Server-Error\r\n<h1>Server Error</h1>\r\n")))))))))
+
+
+(defun elnode--log-fn (server con msg)
+ "Log function for elnode.
+
+Serves only to connect the server process to the client processes"
+ (process-put con :server server)
+ )
+
+(defvar elnode-handler-history '()
+ "The history of handlers bound to servers.")
+
+(defvar elnode-port-history '()
+ "The history of ports that servers are started on.")
+
+(defvar elnode-host-history '()
+ "The history of hosts that servers are started on.")
+
+;;;###autoload
+(defun elnode-start (request-handler port host)
+ "Start the elnode server so that REQUEST-HANDLER handles requests on PORT on HOST.
+
+Most of the work done by the server is actually done by
+functions, the sentinel function, the log function and a filter
+function.
+
+request-handler is a function which is called with the
+request. The function is called with one argument, the
+http-connection.
+
+You can use functions such as elnode-http-start and
+elnode-http-send-body to send the http response.
+
+Example:
+
+ (defun nic-server (httpcon)
+ (elnode-http-start 200 '((\"Content-Type\": \"text/html\")))
+ (elnode-http-return \"<html><b>BIG!</b></html>\")
+ )
+ (elnode-start 'nic-server 8000)
+ ;; End
+
+You must also specify the port to start the server on.
+
+You can optionally specify the hostname to start the server on,
+this must be bound to a local IP. Some names are special:
+
+ localhost means 127.0.0.1
+ * means 0.0.0.0
+
+specifying an IP is also possible.
+
+Note that although host can be specified, elnode does not
+disambiguate on running servers by host. So you cannot start 2
+different elnode servers on the same port on different hosts."
+ (interactive
+ (let ((handler (completing-read "Handler function: "
+ obarray 'fboundp t nil nil))
+ (port (read-number "Port: " nil))
+ (host (read-string "Host: " "localhost" 'elnode-host-history)))
+ (list (intern handler) port host)))
+ (if (not (assoc port elnode-server-socket))
+ ;; Add a new server socket to the list
+ (setq elnode-server-socket
+ (cons
+ (cons port
+ (let ((buf (get-buffer-create "*elnode-webserver*")))
+ (make-network-process
+ :name "*elnode-webserver-proc*"
+ :buffer buf
+ :server t
+ :nowait 't
+ :host (cond
+ ((equal host "localhost")
+ 'local)
+ ((equal host "*")
+ nil)
+ (t
+ host))
+ :service port
+ :coding '(raw-text-unix . raw-text-unix)
+ :family 'ipv4
+ :filter 'elnode--filter
+ :sentinel 'elnode--sentinel
+ :log 'elnode--log-fn
+ :plist `(:elnode-http-handler ,request-handler))))
+ elnode-server-socket))))
+
+;; TODO: make this take an argument for the
+(defun elnode-stop (port)
+ "Stop the elnode server attached to PORT."
+ (interactive "nPort: ")
+ (let ((server (assoc port elnode-server-socket)))
+ (if server
+ (progn
+ (delete-process (cdr server))
+ (setq elnode-server-socket
+ ;; remove-if
+ (let ((test (lambda (elem)
+ (= (car elem) port)))
+ (l elnode-server-socket)
+ result)
+ (while (car l)
+ (let ((p (pop l))
+ (r (cdr l)))
+ (if (not (funcall test p))
+ (setq result (cons p result)))))
+ result))))))
+
+(defun elnode-list-buffers ()
+ "List the current buffers being managed by elnode."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*elnode-buffers*")
+ (erase-buffer)
+ (mapc
+ (lambda (b)
+ (save-excursion
+ (if (string-match " \\*elnode-.*" (buffer-name b))
+ (insert (format "%s\n" b)))
+ ))
+ (sort (buffer-list)
+ (lambda (a b)
+ (string-lessp (buffer-name b) (buffer-name a))))))
+ (display-buffer (get-buffer "*elnode-buffers*")))
+
+;; HTTP API methods
+
+(defun elnode--http-parse (httpcon)
+ "Parse the HTTP header for the process.
+
+Returns a cons of the status line and the header association-list:
+
+ (http-status . http-header-alist)"
+ (with-current-buffer (process-buffer httpcon)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((hdrend (re-search-forward "\r\n\r\n" nil 't)))
+ ;; It's an error if we can't find the end of header because
+ ;; elnode--filter should not have called the user handler
+ ;; until the header has ended
+ (if (not hdrend)
+ (error "Elnode: the header was not found by the HTTP parsing routines"))
+ ;; Split the lines from the beginning of the buffer to the
+ ;; header end, use the first as the status line and the rest as the header
+ ;; FIXME: we don't handle continuation lines of anything like that
+ (let* ((lines (split-string (buffer-substring (point-min) hdrend) "\r\n" 't))
+ (status (car lines))
+ (header (cdr lines)))
+ (process-put httpcon :elnode-header-end hdrend)
+ (process-put httpcon :elnode-http-status status)
+ (process-put
+ httpcon
+ :elnode-http-header
+ (mapcar
+ (lambda (hdrline)
+ (if (string-match "\\([A-Za-z0-9_-]+\\): \\(.*\\)" hdrline)
+ (cons (match-string 1 hdrline) (match-string 2 hdrline))))
+ header))))
+ (cons
+ (process-get httpcon :elnode-http-status)
+ (process-get httpcon :elnode-http-header)))))
+
+(defun elnode-http-header (httpcon name)
+ "Get the header specified by name from the header."
+ (let ((hdr (or
+ (process-get httpcon :elnode-http-header)
+ (cdr (elnode--http-parse httpcon)))))
+ (cdr (assoc name hdr))))
+
+(defun elnode-http-cookie (httpcon name)
+ "Get the cookie value specified by the name."
+ (let ((cookie-list (or
+ (process-get httpcon :elnode-http-coookie-list)
+ ;; Split out the cookies
+ (let* ((cookie-hdr (elnode-http-header httpcon "Cookie"))
+ (parts (split-string cookie-hdr ";")))
+ (let ((lst (mapcar (lambda (s)
+ (url-parse-args
+ (if (string-match "[ \t]*\\(.*\\)[ \t]*$" s)
+ (replace-match "\\1" nil nil s)
+ s)))
+ parts)))
+ (process-put httpcon :elnode-http-cookie-list lst)
+ lst)))))
+ (loop for cookie in cookie-list
+ do (if (assoc-string name cookie)
+ (return cookie)))
+ )
+ )
+
+(ert-deftest elnode-test-cookie ()
+ "Test the cookie retrieval"
+ (flet (;; Define this so that the cookie list is not retrieved
+ (process-get (proc key)
+ nil
+ )
+ ;; Just define it to do nothing
+ (process-put (proc key data)
+ )
+ ;; Get an example cookie header
+ (elnode-http-header (httpcon name)
+ "csrf=213u21321321412nsfnwlv; username=nicferrier"
+ )
+ )
+ (let ((con ""))
+ (should (equal
+ (pp-to-string (elnode-http-cookie con "username"))
+ "((\"username\" . \"nicferrier\"))\n"))
+ (should (equal
+ (cdr (assoc-string "username" (elnode-http-cookie con "username")))
+ "nicferrier"))
+ )
+ )
+ )
+
+(defun elnode--http-parse-status (httpcon &optional property)
+ "Parse the status line.
+
+Property if specified is the property to return."
+ (let ((http-line (or
+ (process-get httpcon :elnode-http-status)
+ (car (elnode--http-parse httpcon)))))
+ (string-match
+ "\\(GET\\|POST\\|HEAD\\) \\(.*\\) HTTP/\\(1.[01]\\)"
+ http-line)
+ (process-put httpcon :elnode-http-method (match-string 1 http-line))
+ (process-put httpcon :elnode-http-resource (match-string 2 http-line))
+ (process-put httpcon :elnode-http-version (match-string 3 http-line))
+ (if property
+ (process-get httpcon property))))
+
+(defun elnode--http-parse-resource (httpcon &optional property)
+ "Convert the specified resource to a path and a query."
+ (save-match-data
+ (let ((resource
+ (or
+ (process-get httpcon :elnode-http-resource)
+ (elnode--http-parse-status httpcon :elnode-http-resource))))
+ (or
+ ;; root pattern
+ (string-match "^\\(/\\)\\(\\?.*\\)*$" resource)
+ ;; /somepath or /somepath/somepath
+ (string-match "^\\(/[A-Za-z0-9_/.-]+\\)\\(\\?.*\\)*$" resource))
+ (let ((path (match-string 1 resource)))
+ (process-put httpcon :elnode-http-pathinfo path))
+ (if (match-string 2 resource)
+ (let ((query (match-string 2 resource)))
+ (string-match "\\?\\(.+\\)" query)
+ (if (match-string 1 query)
+ (process-put httpcon :elnode-http-query (match-string 1 query)))))))
+ (if property
+ (process-get httpcon property)))
+
+(defun elnode-http-pathinfo (httpcon)
+ "Get the PATHINFO of the request."
+ (or
+ (process-get httpcon :elnode-http-pathinfo)
+ (elnode--http-parse-resource httpcon :elnode-http-pathinfo)))
+
+(defun elnode-http-query (httpcon)
+ "Get the QUERY of the request."
+ (or
+ (process-get httpcon :elnode-http-query)
+ (elnode--http-parse-resource httpcon :elnode-http-query)))
+
+(defun elnode--http-param-part-decode (param-thing)
+ "Decode an HTTP URL parameter part.
+
+For example in:
+
+ http://nic.ferrier.me.uk/blog/elnode/?p=10&a+c=20&d=x+y&z=this%20is%09me+and%20this
+
+The following are param parts and the decoding that this function
+will do:
+
+ \"p\" -> \"p\"
+
+ \"10\" -> \"10\"
+
+ \"a+c\" -> \"a c\" - an example of + encoding
+
+ \"d\" -> \"d\"
+
+ \"x+y\" -> \"x y\" - another example of + encoding, in a parameter name
+
+ \"z\" -> \"z\"
+
+ \"this%20is%09me+and%20this\" -> \"this is\tme and this\" -
+ percent encoding and plus encoding"
+ (url-unhex-string (replace-regexp-in-string "\\+" " " param-thing) 't)
+ )
+
+(defun elnode--http-query-to-alist (query)
+ "Crap parser for HTTP QUERY data.
+
+Returns an association list."
+ (let ((alist (mapcar
+ (lambda (nv)
+ (string-match "\\([^=]+\\)\\(=\\(.*\\)\\)*" nv)
+ (cons
+ (elnode--http-param-part-decode (match-string 1 nv))
+ (if (match-string 2 nv)
+ (elnode--http-param-part-decode (match-string 3 nv))
+ nil)))
+ (split-string query "&"))
+ ))
+ alist))
+
+(defun elnode--alist-merge (a b &optional operator)
+ "Merge two association lists non-destructively.
+
+A is considered the priority (it's elements go in first)."
+ (if (not operator)
+ (setq operator 'assq))
+ (let* ((res '()))
+ (let ((lst (append a b)))
+ (while lst
+ (let ((item (car-safe lst)))
+ (setq lst (cdr-safe lst))
+ (let* ((key (car item))
+ (aval (funcall operator key a))
+ (bval (funcall operator key b)))
+ (if (not (funcall operator key res))
+ (setq res (cons
+ (if (and aval bval)
+ ;; the item is in both lists
+ (cons (car item)
+ (list (cdr aval) (cdr bval)))
+ item)
+ res))))))
+ res)))
+
+(defun elnode--http-post-to-alist (httpcon)
+ "Parse the POST body.
+
+This is not a strong parser. Replace with something better."
+ (let ((postdata
+ (with-current-buffer (process-buffer httpcon)
+ (buffer-substring
+ ;; we might have to add 2 to this because of trailing \r\n
+ (process-get httpcon :elnode-header-end)
+ (point-max)))))
+ (elnode--http-query-to-alist postdata)))
+
+(defun elnode-http-params (httpcon)
+ "Get an alist of the parameters in the request.
+
+If the method is a GET then the parameters are from the url. If
+the method is a POST then the parameters may come from either the
+url or the POST body or both:
+
+ POST /path?a=b&x=y
+ a=c
+
+would result in:
+
+ '(('a' 'b' 'c')('x' . 'y'))"
+ (or
+ (process-get httpcon :elnode-http-params)
+ (let ((query (elnode-http-query httpcon)))
+ (let ((alist (if query
+ (elnode--http-query-to-alist query)
+ '())))
+ ;; If we're a POST we have to merge the params
+ (if (equal "POST" (elnode-http-method httpcon))
+ (progn
+ (setq alist (elnode--alist-merge
+ alist
+ (elnode--http-post-to-alist httpcon)
+ 'assoc))
+ (process-put httpcon :elnode-http-params alist)
+ alist)
+ ;; Else just return the query params
+ (process-put httpcon :elnode-http-params alist)
+ alist)))))
+
+
+(defun elnode-http-param (httpcon name)
+ "Get the named parameter from the request."
+ (let* ((params (elnode-http-params httpcon))
+ (param-pair (assoc name params)))
+ (if param-pair
+ (cdr param-pair))
+ ;; Should we signal when we don't have a param?
+ ))
+
+(ert-deftest elnode-test-http-params ()
+ "Test that the params are ok if they are on the process.
+
+Sets ':elnode-http-params' to nil to trigger 'elnode-http-params'
+parsing. That checks the ':elnode-http-method':
+
+- for GET it returns the parsed ':elnode-http-query'
+
+- for POST it returns the merger of the parsed POST body and
+ ':elnode-http-query'.
+
+*** WARNING:: This test so far only handles GET ***"
+ (elnode--mock-process (:elnode-http-params
+ (:elnode-http-method "GET")
+ (:elnode-http-query "a=10"))
+ (should (equal "10" (elnode-http-param 't "a")))
+ )
+ ;; Test some more complex params
+ (elnode--mock-process (:elnode-http-params
+ (:elnode-http-method "GET")
+ (:elnode-http-query "a=10&b=lah+dee+dah&c+a=blah+blah"))
+ (should (equal "lah dee dah" (elnode-http-param 't "b")))
+ (should (equal "blah blah" (elnode-http-param 't "c a")))
+ )
+ )
+
+
+(defun elnode-http-method (httpcon)
+ "Get the PATHINFO of the request."
+ (or
+ (process-get httpcon :elnode-http-method)
+ (elnode--http-parse-status httpcon :elnode-http-method)))
+
+(defun elnode-http-version (httpcon)
+ "Get the PATHINFO of the request."
+ (or
+ (process-get httpcon :elnode-http-version)
+ (elnode--http-parse-status httpcon :elnode-http-version)))
+
+(defun elnode-http-send-string (httpcon str)
+ "Send the string to the HTTP connection.
+
+This is really only a placeholder function for doing transfer-encoding."
+ ;; We should check that we are actually doing chunked encoding...
+ ;; ... but for now we just presume we're doing it.
+ (let ((len (length str)))
+ (process-send-string httpcon (format "%x\r\n%s\r\n" len (or str "")))
+ )
+ )
+
+(defun elnode-http-start (httpcon status &rest header)
+ "Start the http response on the specified http connection.
+
+httpcon is the HTTP connection being handled.
+status is the HTTP status, eg: 200 or 404
+header is a sequence of (header-name . value) pairs.
+
+For example:
+
+ (elnode-http-start httpcon \"200\" '(\"Content-type\" . \"text/html\"))"
+ (if (process-get httpcon :elnode-http-started)
+ (elnode-error "Http already started")
+ (let ((http-codes-strings '(("200" . "Ok") (200 . "Ok")
+ ("302" . "Redirect") (302 . "Redirect")
+ ("400" . "Bad Request") (400 . "Bad Request")
+ ("401" . "Authenticate") (401 . "Authenticate")
+ ("404" . "Not Found") (404 . "Not Found")
+ ("500" . "Server Error") (500 . "Server Error")
+ )))
+ ;; Send the header
+ (let ((header-alist (cons '("Transfer-encoding" . "chunked") header)))
+ (process-send-string
+ httpcon
+ (format
+ "HTTP/1.1 %s %s\r\n%s\r\n\r\n"
+ status
+ ;; The status text
+ (cdr (assoc status http-codes-strings))
+ ;; The header
+ (or
+ (mapconcat
+ (lambda (p)
+ (format "%s: %s" (car p) (cdr p)))
+ header-alist
+ "\r\n")
+ "\r\n")))
+ (process-put httpcon :elnode-http-started 't)))))
+
+(defun elnode--http-end (httpcon)
+ "We need a special end function to do the emacs clear up."
+ (process-send-eof httpcon)
+ (delete-process httpcon)
+ (kill-buffer (process-buffer httpcon))
+ )
+
+(defun elnode-http-return (httpcon &optional data)
+ "End the response on HTTPCON optionally sending DATA first.
+
+HTTPCON is the http connection which must have had the headers
+sent with 'elnode-http-start'
+
+DATA must be a string, it's just passed to 'elnode-http-send'."
+ (if (not (process-get httpcon :elnode-http-started))
+ (elnode-error "Http not started")
+ (progn
+ (if data
+ (elnode-http-send-string httpcon data))
+ ;; Need to close the chunked encoding here
+ (elnode-http-send-string httpcon "")
+ (process-send-string httpcon "\r\n")
+ (elnode--http-end httpcon))))
+
+
+(defun elnode--mapper-find (path url-mapping-table)
+ "Try and find the 'PATH' inside the 'URL-MAPPING-TABLE'.
+
+This function exposes it's `match-data' on the 'path' variable so
+that yolou can access that in your handler with something like:
+
+ (match-string 1 (elnode-http-pathinfo httpcon))"
+ (elnode-error "Elnode--mapper-find path: %s" path)
+ ;; Implement a simple escaping find function
+ (loop for mapping in url-mapping-table
+ until (let ((mapping-re (format "^/%s" (car mapping))))
+ (string-match mapping-re path))
+ finally return mapping))
+
+
+(defun elnode-send-404 (httpcon)
+ "A generic 404 handler."
+ (elnode-http-start httpcon 404 '("Content-type" . "text/html"))
+ (elnode-http-return httpcon "<h1>Not Found</h1>\r\n"))
+
+(defun elnode-send-400 (httpcon)
+ "A generic 400 handler."
+ (elnode-http-start httpcon 400 '("Content-type" . "text/html"))
+ (elnode-http-return httpcon "<h1>Bad request</h1>\r\n"))
+
+(defun elnode-send-redirect (httpcon location)
+ "Sends a redirect to the specified location."
+ (elnode-http-start httpcon 302 `("Location" . ,location))
+ (elnode-http-return httpcon (format "<h1>redirecting you to %s</h1>\r\n" location)))
+
+(defun elnode-normalize-path (httpcon handler)
+ "A decorator for HANDLER that normalizes paths to have a trailing slash.
+
+This checks the HTTPCON path for a trailing slash and sends a 302
+to the slash trailed url if there is none.
+
+Otherwise it calls HANDLER."
+ (if (not (save-match-data
+ (string-match ".*\\(/\\|.*\\.[^/]*\\)$" (elnode-http-pathinfo httpcon))))
+ (elnode-send-redirect httpcon (format "%s/" (elnode-http-pathinfo httpcon)))
+ (funcall handler httpcon)))
+
+
+(defun elnode--dispatch-proc (httpcon url-mapping-table &optional function-404)
+ "Does the actual dispatch work."
+ (let* ((pi (elnode-http-pathinfo httpcon))
+ (m (elnode--mapper-find pi url-mapping-table)))
+ (if (and m
+ (or (functionp (cdr m))
+ (functionp (and (symbolp (cdr m))
+ (symbol-value (cdr m))))))
+ (cond
+ ;; Check if it's a function or a variable with a function
+ ((functionp (cdr m))
+ (funcall (cdr m) httpcon))
+ ((functionp (symbol-value (cdr m)))
+ (funcall (symbol-value (cdr m)) httpcon)))
+ ;; We didn't match so fire a 404... possibly a custom 404
+ (if (functionp function-404)
+ (funcall function-404 httpcon)
+ ;; We don't have a custom 404 so send our own
+ (elnode-send-404 httpcon)))))
+
+(defun elnode-dispatcher (httpcon url-mapping-table &optional function-404)
+ "Dispatch the HTTPCON to the correct function based on the URL-MAPPING-TABLE.
+
+URL-MAPPING-TABLE is an alist of:
+
+ (url-regex . function-to-dispatch)
+
+To map the root url you should use:
+
+ $
+
+'elnode-dispatcher' uses 'elnode-normalize-path' to ensure paths
+end in / so to map another url you should use:
+
+ path/$
+
+or:
+
+ path/subpath/$"
+ (elnode-normalize-path
+ httpcon
+ (lambda (httpcon)
+ (elnode--dispatch-proc httpcon url-mapping-table function-404))))
+
+(defun elnode--hostpath-dispatch-proc (httpcon hostpath-mapping-table &optional function-404)
+ "Does the actual hostpath dispatch work."
+ ;; TODO - find a way to abstract this and elnode--dispatch-proc
+ (let* ((hostpath (format "%s%s"
+ (let ((host (elnode-http-header httpcon "Host")))
+ (save-match-data
+ (string-match "\\([^:]+\\)\\(:[0-9]+.*\\)" host)
+ (match-string 1 host)))
+ (elnode-http-pathinfo httpcon)))
+ (m (catch 'found
+ (mapcar
+ (lambda (mapping)
+ (let ((mapping-re (car mapping)))
+ (if (string-match mapping-re hostpath)
+ (throw 'found mapping))))
+ hostpath-mapping-table))))
+ (if (and m (functionp (cdr m)))
+ (funcall (cdr m) httpcon)
+ ;; We didn't match so fire a 404... possibly a custom 404
+ (if (functionp function-404)
+ (funcall function-404 httpcon)
+ ;; We don't have a custom 404 so send our own
+ (elnode-send-404 httpcon)))))
+
+(defun elnode-hostpath-dispatcher (httpcon hostpath-mapping-table &optional function-404)
+ "Dispatch the HTTPCON to the correct handler based on the HOSTPATH-MAPPING-TABLE.
+
+HOSTPATH-MAPPING-TABLE has a regex of the host and the path slash separated, thus:
+
+ (\"^localhost/pastebin.*\" . pastebin-handler)"
+ (elnode-normalize-path
+ httpcon
+ (lambda (httpcon)
+ (elnode--hostpath-dispatch-proc httpcon hostpath-mapping-table function-404))))
+
+;;;###autoload
+(defcustom elnode-hostpath-default-table
+ '(("[^/]+/.*" . elnode-webserver))
+ "Customizable variable defining hostpath mappings for 'elnode-hostpath-default-handler'.
+
+This is the default mapping table for elnode, out of the box. If
+you customize this then elnode will serve these hostpath mappings
+by just loading elnode.
+
+By default the table maps everything to
+'elnode-webserver'. Unless you're happy with the default you
+should probably get rid of the everything path because it will
+interfere with any other mappings you add."
+ :group 'elnode)
+
+(defun elnode-hostpath-default-handler (httpcon)
+ "A hostpath handler using the 'elnode-hostpath-default-table' for the match table.
+
+This simply calls 'elnode-hostpath-dispatcher' with 'elnode-hostpath-default-table'."
+ (elnode-hostpath-dispatcher httpcon elnode-hostpath-default-table))
+
+
+;; elnode child process functions
+
+;; TODO: handle errors better than messaging
+(defun elnode--child-process-sentinel (process status)
+ "A generic sentinel for elnode child processes.
+
+elnode child processes are just emacs asynchronous processes that
+send their output to an elnode http connection.
+
+The main job of this sentinel is to send the end of the http
+stream when the child process finishes."
+ (cond
+ ((equal status "finished\n")
+ (let ((httpcon (process-get process :elnode-httpcon)))
+ (elnode-error "Status @ finished: %s -> %s" (process-status httpcon) (process-status process))
+ (if (not (eq 'closed (process-status httpcon)))
+ (progn
+ (elnode-http-send-string httpcon "")
+ (process-send-string httpcon "\r\n")
+ (elnode--http-end httpcon)))))
+ ((string-match "exited abnormally with code \\([0-9]+\\)\n" status)
+ (let ((httpcon (process-get process :elnode-httpcon)))
+ (if (not (eq 'closed (process-status httpcon)))
+ (progn
+ (elnode-http-send-string httpcon "")
+ (process-send-string httpcon "\r\n")
+ (elnode--http-end httpcon)))
+ (delete-process process)
+ (kill-buffer (process-buffer process))
+ (elnode-error "Elnode-child-process-sentinel: %s" status)))
+ (t
+ (elnode-error "Elnode-chlild-process-sentinel: %s" status))))
+
+(defun elnode--child-process-filter (process data)
+ "A generic filter function for elnode child processes.
+
+elnode child processes are just emacs asynchronous processes that
+send their output to an elnode http connection.
+
+This filter function does the job of taking the output from the
+async process and finding the associated elnode http connection
+and sending the data there."
+ (let ((httpcon (process-get process :elnode-httpcon)))
+ (elnode-error "Elnode-child-process-filter http state: %s data length: %s"
+ (process-status httpcon)
+ (length data)
+ )
+ (if (not (equal "closed" (process-status httpcon)))
+ (elnode-http-send-string httpcon data))))
+
+(defun elnode-child-process (httpcon program &rest args)
+ "Run the specified process asynchronously and send it's output to the http connection.
+
+program is the program to run.
+args is a list of arguments to pass to the program.
+
+It is NOT POSSIBLE to run more than one process at a time
+directed at the same http connection."
+ (let* ((args `(,(format "%s-%s" (process-name httpcon) program)
+ ,(format " %s-%s" (process-name httpcon) program)
+ ,program
+ ,@args
+ ))
+ (p (let ((process-connection-type nil))
+ (apply 'start-process args))))
+ (set-process-coding-system p 'raw-text-unix)
+ ;; Bind the http connection to the process
+ (process-put p :elnode-httpcon httpcon)
+ ;; Bind the process to the http connection
+ ;; WARNING: this means you can only have 1 child process at a time
+ (process-put httpcon :elnode-child-process p)
+ ;; Setup the filter and the sentinel to do the right thing with incomming data and signals
+ (set-process-filter p 'elnode--child-process-filter)
+ (set-process-sentinel p 'elnode--child-process-sentinel)))
+
+;; Webserver stuff
+
+(defcustom elnode-webserver-docroot "~/public_html"
+ "The document root of the webserver.
+
+Webserver functions are free to use this or not. The
+'elnode-webserver' function does use it."
+ :group 'elnode)
+
+(defcustom elnode-webserver-extra-mimetypes '(("text/plain" . "creole")
+ ("text/plain" . "el"))
+ "this is just a way of hacking the mime type discovery so we
+can add more file mappings more easily than editing
+/etc/mime.types"
+ :group 'elnode)
+
+
+(defun elnode--webserver-index (docroot targetfile pathinfo)
+ "Constructs index documents for the DOCROOT and TARGETFILE pointing to a dir."
+ ;; TODO make this usable by people generally
+ (let ((dirlist (directory-files-and-attributes targetfile)))
+ ;; TODO make some templating here so people can change this
+ (format
+ "<html><head><title>%s</title></head><body><h1>%s</h1><div>%s</div></body></html>\n"
+ pathinfo
+ pathinfo
+ (mapconcat
+ (lambda (dir-entry)
+ (let ((entry (format
+ "%s%s"
+ (if (equal pathinfo "/") "" pathinfo)
+ (car dir-entry))))
+ (format
+ "<a href='%s'>%s</a><br/>\r\n"
+ entry
+ (car dir-entry))))
+ dirlist
+ "\n"))))
+
+(defun elnode-test-path (httpcon docroot handler &optional 404-handler)
+ "Check that the path requested is above the docroot specified.
+
+Call 404-handler (or default 404 handler) on failure and handler
+on success.
+
+handler is called: httpcon docroot targetfile
+
+This is used by 'elnode--webserver-handler-proc' in the webservers
+that it creates... but it's also meant to be generally useful for
+other handler writers."
+ (let* ((pathinfo (elnode-http-pathinfo httpcon))
+ ;; Let webserver users prefix the webserver path in a dispatcher regex
+ ;; use a regex like this:
+ ;; "prefix/\\(.*\\)$"
+ ;; and we'll be able to prefix the path properl
+ (path (or (match-string 1 pathinfo) pathinfo))
+ (targetfile (format "%s%s"
+ (expand-file-name docroot)
+ (format "/%s" (if (equal path "/") "" path)))))
+ (if (or
+ (file-exists-p targetfile)
+ ;; Test the targetfile is under the docroot
+ (let ((docrootlen (length docroot)))
+ (compare-strings
+ docroot 0 docrootlen
+ (file-truename targetfile) 0 docrootlen)))
+ (funcall handler httpcon docroot targetfile)
+ ;; Call the 404 handler
+ (if (functionp 404-handler)
+ (funcall 404-handler httpcon)
+ (elnode-send-404 httpcon)))))
+
+
+;;;###autoload
+(defun elnode--webserver-handler-proc (httpcon docroot mime-types)
+ "Actual webserver implementation.
+
+This is not a real handler (because it takes more than the
+httpcon) but it is called directly by the real webserver
+handlers."
+ (elnode-test-path
+ httpcon docroot
+ (lambda (httpcon docroot targetfile)
+ ;; The file exists and is legal
+ (let ((pathinfo (elnode-http-pathinfo httpcon)))
+ (if (file-directory-p targetfile)
+ (let ((index (elnode--webserver-index docroot targetfile pathinfo)))
+ ;; What's the best way to do simple directory indexes?
+ (elnode-http-start httpcon 200 '("Content-type" . "text/html"))
+ (elnode-http-return httpcon index))
+ ;; It's a file... use 'cat' to send it to the user
+ (if (file-exists-p targetfile)
+ (progn
+ (mailcap-parse-mimetypes)
+ (let ((mimetype (or (car (rassoc
+ (cadr (split-string targetfile "\\."))
+ mime-types))
+ (mm-default-file-encoding targetfile)
+ "application/octet-stream")))
+ (elnode-http-start httpcon 200 `("Content-type" . ,mimetype))
+ (elnode-child-process httpcon "cat" targetfile)))
+ ;; FIXME: This needs improving so we can handle the 404
+ ;; This function should raise an exception?
+ (elnode-send-404 httpcon)))))))
+
+(defun elnode-webserver-handler-maker (&optional docroot extra-mime-types)
+ "Make a webserver handler possibly with the DOCROOT and EXTRA-MIME-TYPES.
+
+Returns a proc which is the handler. The handler serves files out
+of the docroot and marks them with the content types that Emacs
+knows about. You can add extra content types for the webserver
+just by supplying an alist of mime-types and extensions for
+EXTRA-MIME-TYPES.
+
+The webserver handler also creates file indexes.
+
+The webserver uses 'elnode-test-path' to make sure that the
+request does not go above the DOCROOT."
+ ;;; REQUIRES LEXICAL SCOPE
+ (let ((my-docroot (or docroot elnode-webserver-docroot))
+ (my-mime-types (or extra-mime-types
+ elnode-webserver-extra-mimetypes)))
+ ;; Return the proc
+ (lambda (httpcon)
+ (elnode--webserver-handler-proc httpcon my-docroot my-mime-types))))
+
+;;;###autoload
+(defun elnode-webserver (httpcon)
+ "A simple webserver that serves documents out of `elnode-webserver-docroot'.
+
+This is just an example of an elnode webserver, but it may be all
+that is needed most of the time.
+
+See 'elnode-webserver-handler-maker' for more possibilities for
+making webserver functions.
+
+HTTPCON is the HTTP connection to the user agent."
+ (elnode--webserver-handler-proc
+ httpcon
+ elnode-webserver-docroot
+ elnode-webserver-extra-mimetypes))
+
+
+;;;###autoload
+(defcustom elnode-init-port 8000
+ "The port that 'elnode-init' starts the default server on."
+ :group 'elnode)
+
+(defcustom elnode-init-host "localhost"
+ "The host that 'elnode-init' starts the default server listening on."
+ :group 'elnode)
+
+;;;###autoload
+(defun elnode-init ()
+ "Bootstraps the elnode environment when the Lisp is loaded.
+
+It's useful to have elnode start automatically... on Lisp
+load. If the variable 'elnode-init-port' is set then this
+function will launch a server on it.
+
+The server is started with 'elnode-hostpath-default-handler' as
+the handler and listening on 'elnode-init-host'"
+ (interactive)
+ (if elnode-init-port
+ (condition-case nil
+ (elnode-start 'elnode-hostpath-default-handler elnode-init-port elnode-init-host)
+ (error (message
+ "elnode can't start because port %d has something attached already"
+ elnode-init-port))))
+ ;;(if (not elnode--defer-timer)
+ ;; (elnode--init-deferring))
+ )
+
+;;;###autoload
+(defcustom elnode-do-init nil
+ "Should elnode start a server on load?
+
+The server that is started is controlled by more elnode
+customizations.
+
+'elnode-hostpath-default-table' defines the mappings from
+hostpath regexs to handler functions. By default elnode ships
+with this customization setup to serve the document root defined
+in 'elnode-webserver-docroot', which by default is ~/public_html."
+ :group 'elnode
+ :type '(boolean)
+ )
+
+;;;###autoload
+(defvar elnode--inited nil
+ "Records when elnode is initialized.
+This is autoloading mechanics, see the eval-after-load for doing init.")
+
+;; Auto start elnode if we're ever loaded
+;;;###autoload
+(eval-after-load 'elnode
+ (if (and elnode-do-init (not elnode--inited))
+ (progn
+ (elnode-init)
+ (setq elnode--inited nil))))
+
+(provide 'elnode)
+
+;;; elnode.el ends here
16 init.el
@@ -0,0 +1,16 @@
+;; -*- lexical-binding: t -*-
+(add-to-list 'load-path
+ (file-name-directory (or load-file-name
+ (buffer-file-name (current-buffer)))))
+(require 'elnode)
+
+(defun handler (httpcon)
+ "Demonstration function"
+ (elnode-http-start httpcon "200" '("Content-type" . "text/html"))
+ (elnode-http-return httpcon
+ "<html><body><h1>what is this I don't even</h1></body></html>"))
+
+(elnode-start 'handler (string-to-number (or (getenv "PORT") "8080")) "0.0.0.0")
+
+(while t
+ (accept-process-output nil 1))

0 comments on commit b816125

Please sign in to comment.
Something went wrong with that request. Please try again.