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 (defun ews-start (handler port &optional log-buffer host)
  20   "Start a server using HANDLER and return the server object.
  21
  22 HANDLER should be a list of cons of the form (MATCH . DO), where
  23 MATCH is either a function call on the URI or a regular
  24 expression which attempts to match the URI.  In either case when
  25 MATCH returns non-nil, then DO is called on two arguments, the
  26 URI and any post data."
  27   (let ((server (make-instance 'ews-server :handler handler :port port)))
  28     (setf (process server)
  29           (make-network-process :name "ews-server"
  30                                 :service (port server)
  31                                 :buffer log-buffer
  32                                 :filter 'ews-filter
  33                                 :server 't
  34                                 :nowait 't
  35                                 :family 'ipv4
  36                                 :host host
  37                                 :plist (list :server server)))
  38     server))
  39
  40 (defun ews-stop (server)
  41   "Stop SERVER."
  42   (mapc #'delete-process (append (mapcar #'car (clients server))
  43                                  (list (process server)))))
  44
  45 (defun ews-filter (proc string)
  46   (cl-flet ((log (string buffer)
  47                  (when buffer
  48                    (with-current-buffer buffer
  49                      (goto-char (point-max))
  50                      (insert (format "%s %s" (current-time-string) string))))))
  51     (with-slots (handler clients) (plist-get (process-plist proc) :server)
  52       ;; register new client
  53       (unless (assoc proc clients) (push (cons proc "") clients))
  54       (let* ((pending (assoc proc clients))
  55              (message (concat (cdr pending) string))
  56              index)
  57         ;; read whole strings
  58         (while (setq index (string-match "\n" message))
  59           (setq index (1+ index))
  60           (process-send-string proc (substring message 0 index))
  61           (log (substring message 0 index) (process-buffer proc))
  62           (setq message (substring message index)))
  63         (setcdr pending message)))))
  64
  65 (provide 'emacs-web-server)
  66 ;;; emacs-web-server.el ends here