Skip to content


Subversion checkout URL

You can clone with
Download ZIP
tree: cd520dde53
Fetching contributors…

Cannot retrieve contributors at this time

735 lines (664 sloc) 26.32 kB
;;; elnode-client.el --- elnode HTTP client -*- lexical-binding: t -*-
;; Copyright (C) 2012 Nic Ferrier
;; Author: Nic Ferrier <>
;; Maintainer: Nic Ferrier <>
;; Created: 15th May 2012
;; Keywords: lisp, http, hypermedia
;; 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
;; 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 <>.
;;; Commentary:
;; This is an HTTP client and adapters for it's use with Elnode, the
;; Emacs HTTP server.
;;; Source code
;; elnode's code can be found here:
;;; Style note
;; This codes uses the Emacs style of:
;; elnode-client--private-function
;; for private functions.
;;; Code:
(require 'elnode)
(require 'cl))
(require 'fakir)
(defun elnode--http-client-header-parse (data)
"Parse an HTTP response header.
Each header line is stored in the hash with a symbol form of the
header name.
The status line is expected to be the first line of the data.
The status is stored in the header as well with the following
which are stored as symbols the same as the normal header keys."
(let* ((header-hash (make-hash-table :test 'equal))
(header-lines (split-string data "\r\n"))
(status-line (car header-lines)))
(when (string-match
"HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*"
(puthash 'status-version (match-string 1 status-line) header-hash)
(puthash 'status-code (match-string 2 status-line) header-hash)
(puthash 'status-string
(or (match-string 4 status-line) "")
(loop for line in (cdr header-lines)
if (string-match
"^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)"
(let ((name (intern (downcase (match-string 1 line))))
(value (match-string 2 line)))
(puthash name value header-hash)))
(ert-deftest elnode-client-header-parse ()
"Test HTTP header parsing."
(let ((hdrs (elnode--http-client-header-parse
"HTTP/1.0 200 Ok\r
Content-type: text/html\r
Content-length: 1000\r
(should (equal "1.0" (gethash 'status-version hdrs)))
(should (equal "200" (gethash 'status-code hdrs)))
(should (equal "Ok" (gethash 'status-string hdrs)))
(should (equal "text/html" (gethash 'content-type hdrs)))
(should (equal "1000" (gethash 'content-length hdrs))))
(let ((hdrs (elnode--http-client-header-parse
"HTTP/1.0 400\r
Content-type: text/html\r
Content-length: 1000\r
(should (equal "1.0" (gethash 'status-version hdrs)))
(should (equal "400" (gethash 'status-code hdrs)))
(should (equal "" (gethash 'status-string hdrs)))
(should (equal "text/html" (gethash 'content-type hdrs)))
(should (equal "1000" (gethash 'content-length hdrs)))))
(defun elnode-client--chunked-decode-stream (con data consumer)
"Decode the chunked encoding stream on the process CON.
DATA is a lump of data from the stream, as passed from a filter
function for example.
CONSUMER is a function that will be called with the resulting
data like:
the CON is the same as the CON in this call. The `chunk' is the
chunk that has been read. Only complete chunks are sent to the
When the chunked stream ends the CONSUMER is called with CHUNK
being `:done'. This can be used to do clean up. It is NOT
expected that the callback will have to clean up the CON, that
should be done by the caller.
CON is used to store state with the process property
`:chunked-encoding-buffer' being used as a buffer."
;; Make data the whole chunk
(setq data (let ((saved (process-get con :chunked-encoding-buffer)))
(if saved (concat saved data) data)))
(if (not (string-match "^\\([0-9A-Fa-f]+\\)\r\n" data))
(process-put con :chunked-encoding-buffer data)
;; We have identified a chunk
(let* ((chunk-num (match-string 1 data))
(chunk-size (string-to-number chunk-num 16))
(toread-pos (+ 2 (length chunk-num))) ; +2 == \r\n after chunk sz
(chunk-end (+ toread-pos chunk-size)))
(if (< (length data) (+ 2 chunk-end)) ; +2 == \r\n at end of chunk
(process-put con :chunked-encoding-buffer data)
(let ((toread (substring data toread-pos chunk-end))
(trailing (substring data chunk-end (+ chunk-end 2)))
(left (substring data (+ chunk-end 2))))
(if trailing
(assert (equal trailing "\r\n") t))
((equal 0 chunk-size)
;; Finished
(funcall consumer con :done)
((> chunk-size (length toread))
(process-put con :chunked-encoding-buffer data))
;; Eat the data
(funcall consumer con toread)
;; Clear the buffer
(process-put con :chunked-encoding-buffer "")
;; Go round again if we need to
(if left
con left consumer)))))))))
(ert-deftest elnode-client--chunked-decode-stream ()
"Test the chunked decoding."
;; Test incomplete chunk delivered (missing trailing crlf)
(let ((proc :fake)
(res ""))
(flet ((consumer (con data)
(unless (eq data :done)
(setq res (concat res data)))))
(fakir-mock-process :fake ()
proc "b\r\nhello world" 'consumer)))
(equal "b\r\nhello world"
(process-get proc :chunked-encoding-buffer)))
proc "\r\n0\r\n\r\n" 'consumer)))))))
;; Test incomplete chunk packet delivered
(let ((proc :fake)
(res ""))
(flet ((consumer (con data)
(unless (eq data :done)
(setq res (concat res data)))))
(fakir-mock-process :fake ()
proc "b\r\nhello wor" 'consumer)))
(equal "b\r\nhello wor"
(process-get proc :chunked-encoding-buffer)))))))
;; Test more than 1 complete chunk delivered
(let ((proc :fake)
(res ""))
(flet ((consumer (con data)
(unless (eq data :done)
(setq res (concat res data)))))
(fakir-mock-process :fake ()
(equal :done
"6\r\nhello!\r\nb\r\nhello world\r\n0\r\n\r\n"
(equal "hello!hello world" res))))))
;; Test one call handling one chunk and then the end
(let ((proc :fake)
(res ""))
(flet ((consumer (con data)
(unless (eq data :done)
(setq res (concat res data)))))
(fakir-mock-process :fake ()
(equal :done
proc "5\r\nhello\r\n0\r\n\r\n" 'consumer)))
(equal "hello" res)))))))
(defun elnode-client--http-post-filter (con data callback mode)
"Filter function for HTTP POST.
Not actually a filter function because it also receives the
CALLBACK and the MODE from the actual filter function, a lexical
closure inside `elnode-http-post'.
CALLBACK is a user supplied function handling the return from the
HTTP server.
MODE comes from the `elnode-http-post' call. This function
handles the MODE by either streaming the data to the CALLBACK or
by collecting it and then batching it to the CALLBACK."
(with-current-buffer (process-buffer con)
(let ((header (process-get con :http-header)))
(if (not header)
(goto-char (point-max))
(insert data)
;; Find the header if we don't have it
(if (and (not header)
(goto-char (point-min))
(re-search-forward "\r\n\r\n" nil t)))
(let ((hdr (elnode--http-client-header-parse
(buffer-substring (point-min) (point-max))))
;; From the point of the end of header to the end
;; is the data we need... this may be nothing.
(part-data (if (> (point-max) (point))
(buffer-substring (point) (point-max))
(process-put con :http-header-pos (point))
(process-put con :http-header hdr)
;; If we have more data call ourselves to process it
(when part-data
con part-data callback mode)))))
;; We have the header, read the body and call callback
((equal "chunked" (gethash 'transfer-encoding header))
con data
;; FIXME we still need the callback to know if this is completion
(lambda (con data)
((eq mode 'stream)
(funcall callback con header data)
(when (eq data :done)
(delete-process con)))
((and (eq mode 'batch)
(eq data :done))
(funcall callback con header
(process-get con :elnode-client-buffer))
(delete-process con))
con :elnode-client-buffer
(concat (or (process-get con :elnode-client-buffer) "")
;; We have a content-length header so just buffer that much data
((gethash 'content-length header)
(let ((so-far (process-get con :elnode-client-buffer)))
(if (< (string-to-number (gethash 'content-length header))
(length so-far))
con :elnode-client-buffer
(concat so-far data))
;; We have all the data, callback and then kill the process
(funcall callback con header so-far)
(delete-process con)))))))))
(ert-deftest elnode-client-http-post-filter ()
"Test the filter in streaming mode."
(let* (cb-hdr
(con :fake)
(callback (lambda (con hdr data)
(unless cb-hdr
(setq cb-hdr hdr))
(unless (eq data :done)
(setq cb-data data)))))
(fakir-mock-process :fake ((:buffer "HTTP/1.1 200\r
Host: hostname\r
Transfer-encoding: chunked\r\n"))
(should-not cb-hdr)
(elnode-client--http-post-filter con "\r\n" callback 'stream)
;; Because there is no data yet the header is not set
(should-not cb-hdr)
;; Now send a valid chunk through the stream api
con "b\r\nhello world\r\n" callback 'stream)
(should cb-hdr)
(should (equal cb-data "hello world"))
;; Some header tests
(equal "hostname" (gethash 'host cb-hdr)))
(equal "200" (gethash 'status-code cb-hdr)))
(equal "1.1" (gethash 'status-version cb-hdr)))
;; Now send the final one and catch deleted
(catch :mock-process-finished
(elnode-client--http-post-filter con "0\r\n\r\n" callback 'stream)
(should (equal cb-data "hello world"))))))))
(ert-deftest elnode-client-http-post-filter-batch-mode-content-length ()
"Test the filter in batch mode with fixed content-length."
(let* (cb-hdr
(con :fake)
(callback (lambda (con hdr data)
(setq cb-hdr hdr)
(setq cb-data data))))
(fakir-mock-process :fake ((:buffer "HTTP/1.1 200\r
Host: hostname\r
Content-length: 11\r\n"))
(should-not cb-hdr)
(elnode-client--http-post-filter con "\r\n" callback 'batch)
(should-not cb-hdr)
(catch :mock-process-finished
(elnode-client--http-post-filter con "hello world" callback 'batch)
(should cb-hdr))))
(equal "hostname"
(gethash 'host cb-hdr)))
(equal "200"
(gethash 'status-code cb-hdr)))
(equal "1.1"
(gethash 'status-version cb-hdr))))))
(ert-deftest elnode-client-http-post-filter-batch-mode-chunked ()
"Test the filter in batch mode with chunked encoding."
(let* (cb-hdr
(con :fake)
(callback (lambda (con hdr data)
(setq cb-hdr hdr)
(setq cb-data data))))
(fakir-mock-process :fake ((:buffer "HTTP/1.1 200\r
Transfer-encoding: chunked\r
Host: hostname\r\n"))
(should-not cb-hdr)
(elnode-client--http-post-filter con "\r\n" callback 'batch)
(should-not cb-hdr)
con "b\r\nhello world" callback 'batch)
(should-not cb-hdr)
(should-not cb-data)
(catch :mock-process-finished
con "\r\n0\r\n\r\n" callback 'batch)
(should cb-hdr)
(should (equal "hello world" cb-data)))))
(equal "hostname" (gethash 'host cb-hdr)))
(equal "200" (gethash 'status-code cb-hdr)))
(equal "1.1" (gethash 'status-version cb-hdr))))))
(defun elnode-client--key-value-encode (key value)
"Encode a KEY and VALUE for url encoding."
(numberp value)
(stringp value))
(url-hexify-string (format "%s" key))
(url-hexify-string (format "%s" value))))
(format "%s" (url-hexify-string (format "%s" key))))))
(defun elnode-client--to-query-string (object)
"Convert OBJECT to an HTTP query string.
If OBJECT is of type `hash-table' then the keys and values of the
hash are iterated into the string depending on their types.
Keys with `number' and `string' values are encoded as
\"key=value\" in the resulting query.
Keys with a boolean value (or any other value not already
described) are encoded just as \"key\"."
((hash-table-p object)
(let (result)
(lambda (key value)
(setq result
(elnode-client--key-value-encode key value)
(reverse result))
(ert-deftest elnode-client--to-query-string ()
"Test query string making."
(let ((t1 #s(hash-table size 5 data (a 1 b 2 c 3 d "str" e t))))
(equal "a=1&b=2&c=3&d=str&e"
(elnode-client--to-query-string t1)))))
(defun elnode-client--http-post-sentinel (con evt)
"Sentinel for the HTTP POST."
;; FIXME I'm sure this needs to be different - but how? it needs to
;; communicate to the filter function?
((equal evt "closed\n")
(message "http client post closed"))
((equal evt "deleted\n")
(delete-process con)
(message "http client post closed"))
((equal evt "connection broken by peer\n")
(message "http client went away"))
(message "some message %s" evt))))
(defun* elnode-client-http-post (callback
(host "localhost")
(port 80)
(mime-type 'application/form-www-url-encoded)
(mode 'batch))
"Make an HTTP POST to the HOST on PORT with PATH and send DATA.
PORT is 80 by default.
DATA is of MIME-TYPE. We try to interpret DATA and MIME-TYPE
If DATA is a `hash-table' or the MIME-TYPE is
`application/form-www-url-encoded' then
`elnode-client--to-query-string' is used to to format the POST
When the request comes back the CALLBACK is called.
MODE defines what it means for the request to cause the CALLBACK
to be fired. When MODE is `stream' then the CALLBACK is called
for every chunk of data received after the header has arrived.
This allows streaming data to somewhere else; hence `stream'
The default MODE is `batch' which collects all the data from the
response before calling CALLBACK with the header and all the
(let* ((mode (or mode 'batch))
(dest (format "%s:%s/%s" host port path))
(buf (generate-new-buffer dest))
(con (open-network-stream
(format "elnode-http-post-%s" dest)
(set-process-sentinel con 'elnode-client--http-post-sentinel)
(lambda (con data)
(let ((mode mode)
(cb callback))
(elnode-client--http-post-filter con data cb mode))))
;; Send the request
(let* ((to-send
((or (eq (if (symbolp mime-type)
(intern mime-type))
(hash-table-p data))
(elnode-client--to-query-string data))))
(submission (format "POST %s HTTP/1.1\r
Host: %s\r
Content-type: %s\r
%s" path host mime-type (length to-send) to-send)))
(process-send-string con submission))
(ert-deftest elnode-client-http-post-full ()
"Do a full test of the client using an elnode server.
This tests the parameter passing by having an elnode handler "
(let* (method
(port (elnode-find-free-service)))
;; Start a server on the port
(let ((init-data (make-hash-table
:test 'equal
:size 5)))
(puthash "a" 10 init-data)
(puthash "b" 20 init-data)
;; Start the server
(lambda (httpcon)
(setq method (elnode-http-method httpcon))
(setq path (elnode-http-pathinfo httpcon))
(setq params (elnode-http-params httpcon))
(message "the proc buffer is: %s" (process-buffer httpcon))
(elnode-http-start httpcon 200 '(Content-type . "text/plain"))
(elnode-http-return httpcon "hello world!"))
:port port)
;; POST some parameters to the server
(lambda (con header data)
(setq data-received data)
(message "data received is: %s" data-received)
(setq the-end t))
:port port
:data init-data)
;; Hang till the client callback finishes
(while (not the-end)
(sit-for 0.1)))
;; And when we're done with the server...
(elnode-stop port))
;; Now test the data that was POSTed and collected inside the
;; elnode handler
(should (equal "POST" method))
'(("a" . "10")("b" . "20"))
(sort params
(lambda (a b)
(string-lessp (car a) (car b))))))
;; And a quick check of the clients receipt of the data from the handler
(should (equal "hello world!" data-received))))
(defun elnode-client--load-path-ize (lisp)
"Wrap LISP in the current load-path."
;; There is a very strange thing with sending lisp to
;; (read) over a piped stream... (read) can't cope with
;; multiple lines; so we encode newline here.
;; "\n"
;; "\\\\n"
(format "(progn (setq load-path (quote %S)) %s)"
(append (list default-directory) load-path)
(require 'loadhist)
(defvar elnode-client--remote-handlers
(make-hash-table :test 'equal)
"A hash table of established child Emacs' running handlers.")
(defun elnode-client--remote-handlers-kill ()
"Empty the remote handlers list."
(setq elnode-client--remote-handlers (make-hash-table :test 'equal)))
(defun elnode-client--handler-mapper-client (con hdr data httpcon)
"HTTP client callback helper for the mapper."
(unless (process-get httpcon :header-sent)
(elnode-http-start httpcon
(gethash 'status-code hdr))
(process-put httpcon :header-sent t))
(if (not (eq data :done))
(elnode-http-send-string httpcon data)
;; Else we return and delete the con coz we finished
(elnode-http-return httpcon)
(delete-process con)))
(defun elnode-client--handler-mapper (httpcon port)
"Elnode handler helper to call the HTTP server on PORT."
(lambda (con hdr data)
(elnode-client--handler-mapper-client con hdr data httpcon))
:host "localhost"
:data ""
:type "application/x-elnode"
:mode 'stream))
(defun elnode-client--handler-lisp (handler to-require)
"Return a file with Lisp to start HANDLER.
Used by `elnode-client-handler' to construct the lisp to send.
You're unlikely to need to override this at all, the function is
just here to make the implementation easier to debug.
TO-REQUIRE is a list of things to require, currently only 1 is
(let ((temp-file
(format "elnodeclient-%s" (symbol-name handler)))))
(with-temp-file temp-file
(format "(progn
(setq elnode-do-init nil)
(setq elnode--do-error-logging nil)
(require (quote %s))
(let ((port (elnode-find-free-service)))
(elnode-start (quote %s) :port port)
(print (format \"\\nelnode-port=%%d\\n\" port)))
(while t (sleep-for 60)))"
(symbol-name handler)))))
(defun elnode-client-handler (handler)
"Map access to an elnode HANDLER in a child emacs.
Spawn a child Emacs with Lisp code to load the file for the
specified handler and start it being served by an Elnode server.
Returns a function which will call the handler over HTTP."
(let* ((handler-file (symbol-file handler))
(handler-provide '(elnode-client)) ; (file-provides handler-file))
(format "* %s *" (symbol-name handler))))
"emacs -q -batch -l %s"
(car handler-provide))))
(start-process-shell-command "elnode-client" proc-buffer emacsrun)))
;; Store the new server
(puthash handler proc elnode-client--remote-handlers)
;; Put a filter on to capture the port we're starting on
(lambda (proc data)
(with-current-buffer (process-buffer proc)
(goto-char (point-max))
(insert data)
(when (re-search-backward "^elnode-port=\\([0-9]+\\)$" nil t)
(process-put proc :port (match-string 1)))))))
;; Make a handler to call the server
proc :handler
(lambda (httpcon)
(while (not (process-get proc :port))
(message "child server not allocated port yet")
(sit-for 1))
(let ((ephemeral-port (process-get proc :port)))
(elnode-client--handler-mapper httpcon ephemeral-port))))
(process-get proc :handler)))
(defun elnode-client-make-handler (handler)
"Make an elnode handler that is a proxy for HANDLER.
HANDLER runs in a child emacs, listening to HTTP on some port.
The handler returned from here makes an HTTP client connection to
the child Elnode's port and maps the resulting HTTP response."
(let ((handler (elnode-client-handler handler)))
(lambda (httpcon)
(funcall handler httpcon))))
(defun elnode-client-test-handler (httpcon)
"Test handler for running in child emacs."
(elnode-http-start httpcon "200" '("Content-type" . "text/html"))
(elnode-http-return httpcon "hello world"))
(defun elnode-start-proxy (handler port)
"Start a proxy server for HANDLER hosted on localhost:PORT.
Starts HANDLER on a child."
(let ((handler (completing-read "Handler function: "
obarray 'fboundp t nil nil))
(port (read-number "Port: " 9001)))
(list (intern handler) port)))
(elnode-start (elnode-client-make-handler handler) :port port))
(provide 'elnode-client)
;;; elnode-client.el ends here
Jump to Line
Something went wrong with that request. Please try again.