code.delx.au - gnu-emacs-elpa/blob - emacs-web-server.el

   1 ;;; emacs-web-server.el --- Emacs Web Server
   2
   3 ;; Copyright (C) 2013 Eric Schulte <schulte.eric@gmail.com>
   4
   5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
   6 ;; Keywords: elnode html sprunge paste
   7 ;; License: GPLV3 (see the COPYING file in this directory)
   8
   9 ;;; Code:
  10 (require 'eieio)
  11 (require 'cl-lib)
  12
  13 (defclass ews-server ()
  14   ((handler :initarg :handler :accessor handler :initform nil)
  15    (process :initarg :process :accessor process :initform nil)
  16    (port    :initarg :port    :accessor port    :initform nil)
  17    (clients :initarg :clients :accessor clients :initform nil)))
  18
  19 (defvar ews-servers nil
  20   "List holding all ews servers.")
  21
  22 (defvar ews-time-format "%Y.%m.%d.%H.%M.%S.%N"
  23   "Logging time format passed to `format-time-string'.")
  24
  25 (defun ews-start (handler port &optional log-buffer host)
  26   "Start a server using HANDLER and return the server object.
  27
  28 HANDLER should be a list of cons of the form (MATCH . ACTION),
  29 where MATCH is either a function (in which case it is called on
  30 the request object) or a cons cell of the form (KEYWORD . STRING)
  31 in which case STRING is matched against the value of the header
  32 specified by KEYWORD.  In either case when MATCH returns non-nil,
  33 then the function ACTION is called with two arguments, the
  34 process and the request object.
  35
  36 For example, the following starts a simple hello-world server on
  37 port 8080.
  38
  39   (ews-start
  40    '(((:GET . \".*\") .
  41       (lambda (proc request)
  42         (process-send-string proc
  43          \"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n\r\nhello world\r\n\")
  44         t)))
  45    8080)
  46
  47 "
  48   (let ((server (make-instance 'ews-server :handler handler :port port)))
  49     (setf (process server)
  50           (make-network-process
  51            :name "ews-server"
  52            :service (port server)
  53            :filter 'ews-filter
  54            :server 't
  55            :nowait 't
  56            :family 'ipv4
  57            :host host
  58            :plist (list :server server)
  59            :log (when log-buffer
  60                   (lexical-let ((buf log-buffer))
  61                     (lambda (server client message)
  62                       (let ((c (process-contact client)))
  63                         (with-current-buffer buf
  64                           (goto-char (point-max))
  65                           (insert (format "%s\t%s\t%s\t%s"
  66                                           (format-time-string ews-time-format)
  67                                           (first c) (second c) message)))))))))
  68     (push server ews-servers)
  69     server))
  70
  71 (defun ews-stop (server)
  72   "Stop SERVER."
  73   (setq ews-servers (remove server ews-servers))
  74   (mapc #'delete-process (append (mapcar #'car (clients server))
  75                                  (list (process server)))))
  76
  77 (defun ews-parse (string)
  78   (cond
  79    ((string-match "^GET \\([^[:space:]]+\\) \\([^[:space:]]+\\)$" string)
  80     (list (cons :GET (match-string 1 string))
  81           (cons :TYPE (match-string 2 string))))
  82    ((string-match "^\\([^[:space:]]+\\): \\(.*\\)$" string)
  83     (list (cons (intern (concat ":" (upcase (match-string 1 string))))
  84                 (match-string 2 string))))
  85    (:otherwise (message "[ews] bad header: %S" string) nil)))
  86
  87 (defun ews-filter (proc string)
  88   (with-slots (handler clients) (plist-get (process-plist proc) :server)
  89     ;; register new client
  90     (unless (assoc proc clients) (push (list proc "") clients))
  91     (let* ((client (assoc proc clients)) ; clients are (proc pending headers)
  92            (pending (concat (cadr client) string))
  93            (last-index 0) index)
  94       (catch 'finished-parsing-headers
  95         ;; parse headers and append to client
  96         (while (setq index (string-match "\r\n" pending last-index))
  97           (when (= last-index index) ; double \r\n, done headers, call handler
  98             (throw 'finished-parsing-headers
  99                    (when (ews-call-handler proc (cddr client) handler)
 100                      (setq clients (assq-delete-all proc clients))
 101                      (delete-process proc))))
 102           (setcdr (last client)
 103                   (ews-parse (substring pending last-index index)))
 104           (setq last-index (+ index 2)))
 105         (setcar (cdr client) (substring pending last-index))))))
 106
 107 (defun ews-call-handler (proc request handler)
 108   (catch 'matched-handler
 109     (mapc (lambda (handler)
 110             (let ((match (car handler))
 111                   (function (cdr handler)))
 112               (when (or (and (consp match)
 113                              (assoc (car match) request)
 114                              (string-match (cdr match)
 115                                            (cdr (assoc (car match) request))))
 116                         (and (functionp match) (funcall match request)))
 117                 (throw 'matched-handler (funcall function proc request)))))
 118           handler)
 119     (error "[ews] no handler matched request:%S" request)))
 120
 121 (provide 'emacs-web-server)
 122 ;;; emacs-web-server.el ends here