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-time-format "%Y.%m.%d.%H.%M.%S.%N"
  20   "Logging time format passed to `format-time-string'.")
  21
  22 (defun ews-start (handler port &optional log-buffer host)
  23   "Start a server using HANDLER and return the server object.
  24
  25 HANDLER should be a list of cons of the form (MATCH . DO), where
  26 MATCH is either a function call on the URI or a regular
  27 expression which attempts to match the URI.  In either case when
  28 MATCH returns non-nil, then DO is called on two arguments, the
  29 URI and any post data."
  30   (let ((server (make-instance 'ews-server :handler handler :port port)))
  31     (setf (process server)
  32           (make-network-process
  33            :name "ews-server"
  34            :service (port server)
  35            :filter 'ews-filter
  36            :server 't
  37            :nowait 't
  38            :family 'ipv4
  39            :host host
  40            :plist (list :server server)
  41            :log (when log-buffer
  42                   (lexical-let ((buf log-buffer))
  43                     (lambda (server client message)
  44                       (let ((c (process-contact client)))
  45                         (with-current-buffer buf
  46                           (goto-char (point-max))
  47                           (insert (format "%s\t%s\t%s\t%s"
  48                                           (format-time-string ews-time-format)
  49                                           (first c) (second c) message)))))))))
  50     server))
  51
  52 (defun ews-stop (server)
  53   "Stop SERVER."
  54   (mapc #'delete-process (append (mapcar #'car (clients server))
  55                                  (list (process server)))))
  56
  57 (defun ews-parse (string)
  58   (cond
  59    ((string-match "^GET \\([^[:space:]]+\\) \\([^[:space:]]+\\)$" string)
  60     (list (cons :GET (match-string 1 string))
  61           (cons :TYPE (match-string 2 string))))
  62    ((string-match "^\\([^[:space:]]+\\): \\(.*\\)$" string)
  63     (list (cons (intern (concat ":" (upcase (match-string 1 string))))
  64                 (match-string 2 string))))
  65    (:otherwise (message "[ews] bad header: %S" string) nil)))
  66
  67 (defun ews-filter (proc string)
  68   (with-slots (handler clients) (plist-get (process-plist proc) :server)
  69     ;; register new client
  70     (unless (assoc proc clients) (push (list proc "") clients))
  71     (let* ((client (assoc proc clients)) ; clients are (proc pending headers)
  72            (pending (concat (cadr client) string))
  73            (last-index 0) index)
  74       ;; parse headers and append to client
  75       (while (setq index (string-match "\r\n" pending last-index))
  76         ;; double newline indicates no more headers
  77         (unless (= last-index index)
  78           (setcdr (last client)
  79                   (ews-parse (substring pending last-index index))))
  80         (setq last-index (+ index 2)))
  81       (setcar (cdr client) (substring pending last-index)))))
  82
  83 (provide 'emacs-web-server)
  84 ;;; emacs-web-server.el ends here