eschulte pushed a commit to branch master
in repository elpa.
commit cd51d386dae9365305e099503e1b16a5714d84c1
Author: Eric Schulte <schulte.e...@gmail.com>
Date: Tue Dec 31 13:08:31 2013 -0700
changed prefix: ews -> ws
---
NOTES | 2 +-
doc/.gitignore | 2 +-
doc/Makefile | 6 +-
doc/web-server.texi | 98 ++++++++++++++++----------------
examples/0-hello-world.el | 4 +-
examples/1-hello-world-utf8.el | 4 +-
examples/2-hello-world-html.el | 4 +-
examples/3-file-server.el | 8 +-
examples/4-url-param-echo.el | 4 +-
examples/5-post-echo.el | 6 +-
web-server-status-codes.el | 8 +-
web-server-test.el | 110 ++++++++++++++++++------------------
web-server.el | 120 ++++++++++++++++++++--------------------
13 files changed, 188 insertions(+), 188 deletions(-)
diff --git a/NOTES b/NOTES
index 8fed7ab..4339d30 100644
--- a/NOTES
+++ b/NOTES
@@ -28,7 +28,7 @@ Notes to touch upon
1. read standard for POST data
2. parse multi-line headers with boundaries
-For now keep this all incremental and in ews-filter.
+For now keep this all incremental and in ws-filter.
** DONE Makefile
- byte-compile
diff --git a/doc/.gitignore b/doc/.gitignore
index 6283b01..d1e15f2 100644
--- a/doc/.gitignore
+++ b/doc/.gitignore
@@ -1,2 +1,2 @@
-emacs-web-server/
+web-server/
*.info
diff --git a/doc/Makefile b/doc/Makefile
index a4b75ad..f89b034 100644
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -1,11 +1,11 @@
all: info html
-info: emacs-web-server.texi
+info: web-server.texi
makeinfo $<
-html: emacs-web-server.texi
+html: web-server.texi
makeinfo --html $<
clean:
rm -f *.info;
- rm -rf emacs-web-server/
+ rm -rf web-server/
diff --git a/doc/web-server.texi b/doc/web-server.texi
index 4649474..ca67211 100644
--- a/doc/web-server.texi
+++ b/doc/web-server.texi
@@ -1,10 +1,10 @@
\input texinfo
@c @setfilename emacs-web-server.info
@documentencoding utf-8
-@settitle Emacs Web Server (ews) User Manual
+@settitle Emacs Web Server (ws) User Manual
@copying
-This file documents the Emacs Web Server (ews)
+This file documents the Emacs Web Server (ws)
Copyright (C) 2013 Eric Schulte <schulte.eric@@gmail.com>
@@ -20,11 +20,11 @@ A copy of the license is included in the section entitled
@dircategory Emacs misc features
@direntry
-* Emacs Web Server: (ews). Web Server for Emacs.
+* Emacs Web Server: (ws). Web Server for Emacs.
@end direntry
@titlepage
-@title Emacs Web Server (ews) User Manual
+@title Emacs Web Server (ws) User Manual
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -80,7 +80,7 @@ listed (@pxref{Function Index}).
@chapter Handlers
@cindex handlers
-The function @code{ews-start} takes takes two arguments
+The function @code{ws-start} takes takes two arguments
@code{handlers} and @code{port}. It starts a server listening on
@code{port} responding to requests with @code{handlers}, an
association list composed of pairs of matchers and handler functions.
@@ -136,8 +136,8 @@ the handler function returns the keyword @code{:keep-alive}.
@chapter Requests
@cindex requests
-Each HTTP requests is represented using an @code{ews-request} object
-(@pxref{ews-request}). The request object is used to decide which
+Each HTTP requests is represented using an @code{ws-request} object
+(@pxref{ws-request}). The request object is used to decide which
handler to call, and is passed as an argument to the called handler.
The request object holds the network process, all HTTP headers, and
any parameters.
@@ -194,11 +194,11 @@ response instead of a simple @code{text/plain} response.
The following example implements a file server which will serve files
from the @code{docroot} document root set to the current working
directory in this example. Three helper functions are used;
-@code{ews-subdirectoryp} is used to check if the requested path is
+@code{ws-subdirectoryp} is used to check if the requested path is
within the document root, if so the file is served and
-@code{ews-send-file} is used to appropriately set the mime-type of the
+@code{ws-send-file} is used to appropriately set the mime-type of the
response based on the extension of the file, if not then
-@code{ews-send-404} is used to send a default ``File Not Found''
+@code{ws-send-404} is used to send a default ``File Not Found''
response.
@verbatiminclude ../examples/3-file-server.el
@@ -235,49 +235,49 @@ The following functions implement the Emacs Web Server
public API.
@section Objects
The following objects represent web servers and requests.
-@anchor{ews-server}
-@deftp Class ews-server handlers process port requests
-Every Emacs web server is an instance of the @code{ews-server} class.
+@anchor{ws-server}
+@deftp Class ws-server handlers process port requests
+Every Emacs web server is an instance of the @code{ws-server} class.
Each instance includes the @code{handlers} association list and
-@code{port} passed to @code{ews-start}, as well as the server network
+@code{port} passed to @code{ws-start}, as well as the server network
@code{process} and a list of all active @code{requests}.
@end deftp
-@anchor{ews-request}
-@deftp Class ews-request process pending context boundary headers
-The @code{ews-request} class represents an active web request. The
+@anchor{ws-request}
+@deftp Class ws-request process pending context boundary headers
+The @code{ws-request} class represents an active web request. The
@code{process} field holds the network process of the client machine
and may be used by handlers to respond to requests. The
@code{headers} field holds an alist of information on the request for
use by handlers. The remaining @code{pending}, @code{context} and
@code{boundary} fields are used to maintain header parsing information
-across calls to the @code{ews-filter} function.
+across calls to the @code{ws-filter} function.
@end deftp
@section Starting and Stopping Servers
@cindex start and stop
The following functions start and stop Emacs web servers. The
-@code{ews-servers} list holds all running servers.
+@code{ws-servers} list holds all running servers.
-@anchor{ews-start}
-@defun ews-start handlers port &optional log-buffer &rest network-args
-@code{ews-start} starts a server listening on @code{port} using
+@anchor{ws-start}
+@defun ws-start handlers port &optional log-buffer &rest network-args
+@code{ws-start} starts a server listening on @code{port} using
@code{handlers} (@pxref{Handlers}) to match and respond to requests.
-An instance of the @code{ews-server} class is returned.
+An instance of the @code{ws-server} class is returned.
@end defun
-@anchor{ews-servers}
-@defvar ews-servers
-The @code{ews-servers} list holds all active Emacs web servers.
+@anchor{ws-servers}
+@defvar ws-servers
+The @code{ws-servers} list holds all active Emacs web servers.
@end defvar
-@anchor{ews-stop}
-@defun ews-stop server
-@code{ews-stop} stops @code{server} deletes all related processes, and
+@anchor{ws-stop}
+@defun ws-stop server
+@code{ws-stop} stops @code{server} deletes all related processes, and
frees the server's port. Evaluate the following to stop all emacs web
servers.
@example
-(mapc #'ews-stop ews-servers)
+(mapc #'ws-stop ws-servers)
@end example
@end defun
@@ -285,61 +285,61 @@ servers.
The following convenience functions automate many common tasks
associated with responding to HTTP requests.
-@anchor{ews-response-header}
+@anchor{ws-response-header}
@cindex content type
-@defun ews-response-header process code &rest header
+@defun ws-response-header process code &rest header
Send the headers required to start an HTTP response to @code{process}.
-@code{process} should be a @code{ews-request} @code{process} of an
+@code{process} should be a @code{ws-request} @code{process} of an
active request. For example start a standard 200 ``OK'' HTML response
with the following.
@example
-(ews-response-header process 200 '("Content-type" . "text/html"))
+(ws-response-header process 200 '("Content-type" . "text/html"))
@end example
The encoding may optionally be set in the HTTP header. Send a UTF8
encoded response with the following.
@example
-(ews-response-header process 200
+(ws-response-header process 200
'("Content-type" . "text/plain; charset=utf-8"))
@end example
@end defun
-@anchor{ews-send-500}
-@defun ews-send-500 process &rest msg-and-args
-@code{ews-send-500} sends a default 500 ``Internal Server Error''
+@anchor{ws-send-500}
+@defun ws-send-500 process &rest msg-and-args
+@code{ws-send-500} sends a default 500 ``Internal Server Error''
response to @code{process}.
@end defun
-@anchor{ews-send-404}
-@defun ews-send-404 process &rest msg-and-args
-@code{ews-send-500} sends a default 404 ``File Not Found'' response to
+@anchor{ws-send-404}
+@defun ws-send-404 process &rest msg-and-args
+@code{ws-send-500} sends a default 404 ``File Not Found'' response to
@code{process}.
@end defun
-@anchor{ews-send-file}
-@defun ews-send-file process path &optional mime-type
-@code{ews-send-file} sends the file located at @code{path} to
+@anchor{ws-send-file}
+@defun ws-send-file process path &optional mime-type
+@code{ws-send-file} sends the file located at @code{path} to
@code{process}. If the optional @code{mime-type} is not set, then the
mime-type is determined by calling @code{mm-default-file-encoding} on
@code{path} or is set to ``application/octet-stream'' if no mime-type
can be determined.
@end defun
-@anchor{ews-in-directory-p}
-@defun ews-in-directory-p parent path
+@anchor{ws-in-directory-p}
+@defun ws-in-directory-p parent path
Check if @code{path} is under the @code{parent} directory.
@example
-(ews-in-directory-p "/tmp/" "pics")
+(ws-in-directory-p "/tmp/" "pics")
@result{} "/tmp/pics"
-(ews-in-directory-p "/tmp/" "..")
+(ws-in-directory-p "/tmp/" "..")
@result{} nil
-(ews-in-directory-p "/tmp/" "~/pics")
+(ws-in-directory-p "/tmp/" "~/pics")
@result{} nil
@end example
@end defun
diff --git a/examples/0-hello-world.el b/examples/0-hello-world.el
index 91e819a..b2b8e82 100644
--- a/examples/0-hello-world.el
+++ b/examples/0-hello-world.el
@@ -1,8 +1,8 @@
;;; hello-world.el --- simple hello world server using Emacs Web Server
-(ews-start
+(ws-start
'(((lambda (_) t) .
(lambda (request)
(with-slots (process headers) request
- (ews-response-header process 200 '("Content-type" . "text/plain"))
+ (ws-response-header process 200 '("Content-type" . "text/plain"))
(process-send-string process "hello world")))))
9000)
diff --git a/examples/1-hello-world-utf8.el b/examples/1-hello-world-utf8.el
index 0e00362..e92e626 100644
--- a/examples/1-hello-world-utf8.el
+++ b/examples/1-hello-world-utf8.el
@@ -1,5 +1,5 @@
;;; hello-world-utf8.el --- utf8 hello world server using Emacs Web Server
-(ews-start
+(ws-start
'(((lambda (_) t) .
(lambda (request)
(with-slots (process headers) request
@@ -14,7 +14,7 @@
"გამარჯობა"
"नमस्ते"
"你好")))
- (ews-response-header process 200
+ (ws-response-header process 200
'("Content-type" . "text/plain; charset=utf-8"))
(process-send-string process
(concat (nth (random (length hellos)) hellos) " world")))))))
diff --git a/examples/2-hello-world-html.el b/examples/2-hello-world-html.el
index 5f2587a..b73073f 100644
--- a/examples/2-hello-world-html.el
+++ b/examples/2-hello-world-html.el
@@ -1,9 +1,9 @@
;;; hello-world-html.el --- html hello world server using Emacs Web Server
-(ews-start
+(ws-start
'(((lambda (_) t) .
(lambda (request)
(with-slots (process headers) request
- (ews-response-header process 200 '("Content-type" . "text/html"))
+ (ws-response-header process 200 '("Content-type" . "text/html"))
(process-send-string process "<html>
<head>
<title>Hello World</title>
diff --git a/examples/3-file-server.el b/examples/3-file-server.el
index ba7cfb1..5177178 100644
--- a/examples/3-file-server.el
+++ b/examples/3-file-server.el
@@ -1,11 +1,11 @@
;;; file-server.el --- serve any files using Emacs Web Server
(lexical-let ((docroot default-directory))
- (ews-start
+ (ws-start
(list (cons (cons :GET ".*")
(lambda (request)
(with-slots (process headers) request
(let ((path (substring (cdr (assoc :GET headers)) 1)))
- (if (ews-subdirectoryp docroot path)
- (ews-send-file process (expand-file-name path
docroot))
- (ews-send-404 process)))))))
+ (if (ws-subdirectoryp docroot path)
+ (ws-send-file process (expand-file-name path docroot))
+ (ws-send-404 process)))))))
9004))
diff --git a/examples/4-url-param-echo.el b/examples/4-url-param-echo.el
index 2277b4d..6df9d8a 100644
--- a/examples/4-url-param-echo.el
+++ b/examples/4-url-param-echo.el
@@ -1,9 +1,9 @@
;;; url-param-echo.el --- echo back url-paramed message using Emacs Web Server
-(ews-start
+(ws-start
'(((:GET . ".*") .
(lambda (request)
(with-slots (process headers) request
- (ews-response-header process 200 '("Content-type" . "text/html"))
+ (ws-response-header process 200 '("Content-type" . "text/html"))
(process-send-string process
(concat "URL Parameters:</br><table><tr>"
(mapconcat (lambda (pair)
diff --git a/examples/5-post-echo.el b/examples/5-post-echo.el
index b7cd78d..97421de 100644
--- a/examples/5-post-echo.el
+++ b/examples/5-post-echo.el
@@ -1,10 +1,10 @@
;;; post-echo.el --- echo back posted message using Emacs Web Server
-(ews-start
+(ws-start
'(((:POST . ".*") .
(lambda (request)
(with-slots (process headers) request
(let ((message (cdr (assoc "message" headers))))
- (ews-response-header process 200 '("Content-type" . "text/plain"))
+ (ws-response-header process 200 '("Content-type" . "text/plain"))
(process-send-string process
(if message
(format "you said %S\n" message)
@@ -12,7 +12,7 @@
((:GET . ".*") .
(lambda (request)
(with-slots (process) request
- (ews-response-header process 200 '("Content-type" . "text/plain"))
+ (ws-response-header process 200 '("Content-type" . "text/plain"))
(process-send-string process
"This is a GET request not a POST request.\n")))))
9003)
diff --git a/web-server-status-codes.el b/web-server-status-codes.el
index b2cf2dc..bf0e4ca 100644
--- a/web-server-status-codes.el
+++ b/web-server-status-codes.el
@@ -1,7 +1,7 @@
-;;; emacs-web-server-status-codes.el --- Emacs Web Server HTML status codes
+;;; web-server-status-codes.el --- Emacs Web Server HTML status codes
;;; Code:
-(defvar ews-status-codes
+(defvar ws-status-codes
'((100 . "Continue")
(101 . "Switching Protocols")
(102 . "Processing")
@@ -87,5 +87,5 @@
"Possible HTML status codes with names.
From http://en.wikipedia.org/wiki/List_of_HTTP_status_codes.";)
-(provide 'emacs-web-server-status-codes)
-;;; emacs-web-server-status-codes.el ends here
+(provide 'web-server-status-codes)
+;;; web-server-status-codes.el ends here
diff --git a/web-server-test.el b/web-server-test.el
index 6255ee6..5dd4082 100644
--- a/web-server-test.el
+++ b/web-server-test.el
@@ -1,4 +1,4 @@
-;;; emacs-web-server-test.el --- Test the Emacs Web Server
+;;; web-server-test.el --- Test the Emacs Web Server
;; Copyright (C) 2013 Eric Schulte <schulte.e...@gmail.com>
@@ -6,14 +6,14 @@
;; License: GPLV3 (see the COPYING file in this directory)
;;; Code:
-(require 'emacs-web-server)
+(require 'web-server)
(require 'cl-lib)
(eval-when-compile (require 'cl))
(require 'ert)
-(defvar ews-test-port 8999)
+(defvar ws-test-port 8999)
-(defun ews-test-curl-to-string (url &optional get-params post-params)
+(defun ws-test-curl-to-string (url &optional get-params post-params)
"Curl URL with optional parameters."
(async-shell-command
(format "curl -m 4 %s %s localhost:%s/%s"
@@ -25,7 +25,7 @@
(mapconcat (lambda (p) (format "-s -F '%s=%s'" (car p) (cdr p)))
post-params " ")
"")
- ews-test-port url))
+ ws-test-port url))
(unwind-protect
(with-current-buffer "*Async Shell Command*"
(while (get-buffer-process (current-buffer)) (sit-for 0.1))
@@ -33,47 +33,47 @@
(buffer-string))
(kill-buffer "*Async Shell Command*")))
-(defmacro ews-test-with (handler &rest body)
+(defmacro ws-test-with (handler &rest body)
(declare (indent 1))
(let ((srv (cl-gensym)))
- `(let* ((,srv (ews-start ,handler ews-test-port)))
- (unwind-protect (progn ,@body) (ews-stop ,srv)))))
-(def-edebug-spec ews-test-with (form body))
+ `(let* ((,srv (ws-start ,handler ws-test-port)))
+ (unwind-protect (progn ,@body) (ws-stop ,srv)))))
+(def-edebug-spec ws-test-with (form body))
-(ert-deftest ews/keyword-style-handler ()
+(ert-deftest ws/keyword-style-handler ()
"Ensure that a simple keyword-style handler matches correctly."
- (ews-test-with (mapcar (lambda (letter)
+ (ws-test-with (mapcar (lambda (letter)
`((:GET . ,letter) .
(lambda (request)
- (ews-response-header (process request) 200
+ (ws-response-header (process request) 200
'("Content-type" . "text/plain"))
(process-send-string (process request)
(concat "returned:" ,letter)))))
'("a" "b"))
- (should (string= "returned:a" (ews-test-curl-to-string "a")))
- (should (string= "returned:b" (ews-test-curl-to-string "b")))))
+ (should (string= "returned:a" (ws-test-curl-to-string "a")))
+ (should (string= "returned:b" (ws-test-curl-to-string "b")))))
-(ert-deftest ews/function-style-handler ()
+(ert-deftest ws/function-style-handler ()
"Test that a simple hello-world server responds."
- (ews-test-with
+ (ws-test-with
'(((lambda (_) t) .
(lambda (request)
- (ews-response-header (process request) 200
+ (ws-response-header (process request) 200
'("Content-type" . "text/plain"))
(process-send-string (process request) "hello world"))))
- (should (string= (ews-test-curl-to-string "") "hello world"))))
+ (should (string= (ws-test-curl-to-string "") "hello world"))))
-(ert-deftest ews/removed-from-ews-servers-after-stop ()
- (let ((start-length (length ews-servers)))
- (let ((server (ews-start nil ews-test-port)))
- (should (= (length ews-servers) (+ 1 start-length)))
- (ews-stop server)
- (should (= (length ews-servers) start-length)))))
+(ert-deftest ws/removed-from-ws-servers-after-stop ()
+ (let ((start-length (length ws-servers)))
+ (let ((server (ws-start nil ws-test-port)))
+ (should (= (length ws-servers) (+ 1 start-length)))
+ (ws-stop server)
+ (should (= (length ws-servers) start-length)))))
-(ert-deftest ews/parse-many-headers ()
+(ert-deftest ws/parse-many-headers ()
"Test that a number of headers parse successfully."
- (let ((server (ews-start nil ews-test-port))
- (request (make-instance 'ews-request))
+ (let ((server (ws-start nil ws-test-port))
+ (request (make-instance 'ws-request))
(header-string "GET / HTTP/1.1
Host: localhost:7777
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101
Firefox/26.0
@@ -87,17 +87,17 @@ Connection: keep-alive
"))
(unwind-protect
(progn
- (ews-parse-request request header-string)
+ (ws-parse-request request header-string)
(let ((headers (cdr (headers request))))
(should (string= (cdr (assoc :ACCEPT-ENCODING headers))
"gzip, deflate"))
(should (string= (cdr (assoc :GET headers)) "/"))
(should (string= (cdr (assoc :CONNECTION headers)) "keep-alive"))))
- (ews-stop server))))
+ (ws-stop server))))
-(ert-deftest ews/parse-post-data ()
- (let ((server (ews-start nil ews-test-port))
- (request (make-instance 'ews-request))
+(ert-deftest ws/parse-post-data ()
+ (let ((server (ws-start nil ws-test-port))
+ (request (make-instance 'ws-request))
(header-string "POST / HTTP/1.1
User-Agent: curl/7.33.0
Host: localhost:8080
@@ -119,18 +119,18 @@ Content-Disposition: form-data; name=\"name\"
"))
(unwind-protect
(progn
- (ews-parse-request request header-string)
+ (ws-parse-request request header-string)
(let ((headers (cdr (headers request))))
(should (string= (cdr (assoc "name" headers))
"\"schulte\""))
(should (string= (cdr (assoc "date" headers))
"Wed Dec 18 00:55:39 MST 2013"))))
- (ews-stop server))))
+ (ws-stop server))))
-(ert-deftest ews/parse-another-post-data ()
+(ert-deftest ws/parse-another-post-data ()
"This one from an AJAX request."
- (let ((server (ews-start nil ews-test-port))
- (request (make-instance 'ews-request))
+ (let ((server (ws-start nil ws-test-port))
+ (request (make-instance 'ws-request))
(header-string "POST /complex.org HTTP/1.1
Host: localhost:4444
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101
Firefox/26.0
@@ -150,7 +150,7 @@ Cache-Control: no-cache
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org"))
(unwind-protect
(progn
- (ews-parse-request request header-string)
+ (ws-parse-request request header-string)
(let ((headers (cdr (headers request))))
(message "headers:%S" headers)
(should (string= (cdr (assoc "path" headers)) "/complex.org"))
@@ -163,31 +163,31 @@
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
- four
"))))
- (ews-stop server))))
+ (ws-stop server))))
-(ert-deftest ews/simple-post ()
+(ert-deftest ws/simple-post ()
"Test a simple POST server."
- (ews-test-with
+ (ws-test-with
'(((:POST . ".*") .
(lambda (request)
(with-slots (process headers) request
(let ((message (cdr (assoc "message" headers))))
- (ews-response-header process 200
+ (ws-response-header process 200
'("Content-type" . "text/plain"))
(process-send-string process
(format "you said %S\n" message)))))))
- (should (string= (ews-test-curl-to-string "" nil '(("message" . "foo")))
+ (should (string= (ws-test-curl-to-string "" nil '(("message" . "foo")))
"you said \"foo\"\n"))))
-(ert-deftest ews/in-directory-p ()
- (should-not (ews-in-directory-p "/tmp/" "foo/bar/../../../"))
- (should (ews-in-directory-p "/tmp/" "foo/bar/../../../tmp/baz"))
- (should (ews-in-directory-p "/tmp/" "./"))
- (should-not (ews-in-directory-p "/tmp/" "/~/pics"))
- (should-not (ews-in-directory-p "/tmp/" "~/pics"))
- (should-not (ews-in-directory-p "/tmp/" "/pics"))
- (should-not (ews-in-directory-p "/tmp/" "../pics"))
- (should (ews-in-directory-p "/tmp/" "pics"))
- (should-not (ews-in-directory-p "/tmp/" "..")))
-
-(provide 'emacs-web-server-test)
+(ert-deftest ws/in-directory-p ()
+ (should-not (ws-in-directory-p "/tmp/" "foo/bar/../../../"))
+ (should (ws-in-directory-p "/tmp/" "foo/bar/../../../tmp/baz"))
+ (should (ws-in-directory-p "/tmp/" "./"))
+ (should-not (ws-in-directory-p "/tmp/" "/~/pics"))
+ (should-not (ws-in-directory-p "/tmp/" "~/pics"))
+ (should-not (ws-in-directory-p "/tmp/" "/pics"))
+ (should-not (ws-in-directory-p "/tmp/" "../pics"))
+ (should (ws-in-directory-p "/tmp/" "pics"))
+ (should-not (ws-in-directory-p "/tmp/" "..")))
+
+(provide 'web-server-test)
diff --git a/web-server.el b/web-server.el
index 41d87fe..88af45b 100644
--- a/web-server.el
+++ b/web-server.el
@@ -1,4 +1,4 @@
-;;; emacs-web-server.el --- Emacs Web Server
+;;; web-server.el --- Emacs Web Server
;; Copyright (C) 2013 Eric Schulte <schulte.e...@gmail.com>
@@ -7,7 +7,7 @@
;; License: GPLV3 (see the COPYING file in this directory)
;;; Code:
-(require 'emacs-web-server-status-codes)
+(require 'web-server-status-codes)
(require 'mail-parse) ; to parse multipart data in headers
(require 'mm-encode) ; to look-up mime types for files
(require 'url-util) ; to decode url-encoded params
@@ -15,26 +15,26 @@
(eval-when-compile (require 'cl))
(require 'cl-lib)
-(defclass ews-server ()
+(defclass ws-server ()
((handlers :initarg :handlers :accessor handlers :initform nil)
(process :initarg :process :accessor process :initform nil)
(port :initarg :port :accessor port :initform nil)
(requests :initarg :requests :accessor requests :initform nil)))
-(defclass ews-request ()
+(defclass ws-request ()
((process :initarg :process :accessor process :initform nil)
(pending :initarg :pending :accessor pending :initform "")
(context :initarg :context :accessor context :initform nil)
(boundary :initarg :boundary :accessor boundary :initform nil)
(headers :initarg :headers :accessor headers :initform (list nil))))
-(defvar ews-servers nil
- "List holding all ews servers.")
+(defvar ws-servers nil
+ "List holding all web servers.")
-(defvar ews-log-time-format "%Y.%m.%d.%H.%M.%S.%N"
+(defvar ws-log-time-format "%Y.%m.%d.%H.%M.%S.%N"
"Logging time format passed to `format-time-string'.")
-(defun ews-start (handlers port &optional log-buffer &rest network-args)
+(defun ws-start (handlers port &optional log-buffer &rest network-args)
"Start a server using HANDLERS and return the server object.
HANDLERS should be a list of cons of the form (MATCH . ACTION),
@@ -51,7 +51,7 @@ Any supplied NETWORK-ARGS are assumed to be keyword arguments
for
For example, the following starts a simple hello-world server on
port 8080.
- (ews-start
+ (ws-start
'(((:GET . \".*\") .
(lambda (proc request)
(process-send-string proc
@@ -60,26 +60,26 @@ port 8080.
8080)
Equivalently, the following starts an identical server using a
-function MATCH and the `ews-response-header' convenience
+function MATCH and the `ws-response-header' convenience
function.
- (ews-start
+ (ws-start
'(((lambda (_) t) .
(lambda (proc request)
- (ews-response-header proc 200 '(\"Content-type\" . \"text/plain\"))
+ (ws-response-header proc 200 '(\"Content-type\" . \"text/plain\"))
(process-send-string proc \"hello world\")
t)))
8080)
"
- (let ((server (make-instance 'ews-server :handlers handlers :port port))
+ (let ((server (make-instance 'ws-server :handlers handlers :port port))
(log (when log-buffer (get-buffer-create log-buffer))))
(setf (process server)
(apply
#'make-network-process
- :name "ews-server"
+ :name "ws-server"
:service (port server)
- :filter 'ews-filter
+ :filter 'ws-filter
:server t
:nowait t
:family 'ipv4
@@ -92,46 +92,46 @@ function.
(with-current-buffer buf
(goto-char (point-max))
(insert (format "%s\t%s\t%s\t%s"
- (format-time-string
ews-log-time-format)
+ (format-time-string ws-log-time-format)
(first c) (second c) message))))))
network-args))
- (push server ews-servers)
+ (push server ws-servers)
server))
-(defun ews-stop (server)
+(defun ws-stop (server)
"Stop SERVER."
- (setq ews-servers (remove server ews-servers))
+ (setq ws-servers (remove server ws-servers))
(mapc #'delete-process (append (mapcar #'car (requests server))
(list (process server)))))
-(defvar ews-http-common-methods '(GET HEAD POST PUT DELETE TRACE)
+(defvar ws-http-common-methods '(GET HEAD POST PUT DELETE TRACE)
"HTTP methods from http://www.w3.org/Protocols/rfc2616/rfc2616-sec9.html.";)
-(defvar ews-http-method-rx
+(defvar ws-http-method-rx
(format "^\\(%s\\) \\([^[:space:]]+\\) \\([^[:space:]]+\\)$"
- (mapconcat #'symbol-name ews-http-common-methods "\\|")))
+ (mapconcat #'symbol-name ws-http-common-methods "\\|")))
-(defun ews-parse-query-string (string)
+(defun ws-parse-query-string (string)
"Thin wrapper around `url-parse-query-string'."
(mapcar (lambda (pair) (cons (first pair) (second pair)))
(url-parse-query-string string nil 'allow-newlines)))
-(defun ews-parse (proc string)
+(defun ws-parse (proc string)
(cl-flet ((to-keyword (s) (intern (concat ":" (upcase (match-string 1 s))))))
(cond
- ((string-match ews-http-method-rx string)
+ ((string-match ws-http-method-rx string)
(let ((method (to-keyword (match-string 1 string)))
(url (match-string 2 string)))
(if (string-match "?" url)
(cons (cons method (substring url 0 (match-beginning 0)))
- (ews-parse-query-string
+ (ws-parse-query-string
(url-unhex-string (substring url (match-end 0)))))
(list (cons method url)))))
((string-match "^\\([^[:space:]]+\\): \\(.*\\)$" string)
(list (cons (to-keyword string) (match-string 2 string))))
- (:otherwise (ews-error proc "bad header: %S" string) nil))))
+ (:otherwise (ws-error proc "bad header: %S" string) nil))))
-(defun ews-trim (string)
+(defun ws-trim (string)
(while (and (> (length string) 0)
(or (and (string-match "[\r\n]" (substring string -1))
(setq string (substring string 0 -1)))
@@ -139,28 +139,28 @@ function.
(setq string (substring string 1))))))
string)
-(defun ews-parse-multipart/form (string)
+(defun ws-parse-multipart/form (string)
;; ignore empty and non-content blocks
(when (string-match "Content-Disposition:[[:space:]]*\\(.*\\)\r\n" string)
(let ((dp (mail-header-parse-content-disposition (match-string 1 string))))
(cons (cdr (assoc 'name (cdr dp)))
- (ews-trim (substring string (match-end 0)))))))
+ (ws-trim (substring string (match-end 0)))))))
-(defun ews-filter (proc string)
+(defun ws-filter (proc string)
(with-slots (handlers requests) (plist-get (process-plist proc) :server)
(unless (cl-find-if (lambda (c) (equal proc (process c))) requests)
- (push (make-instance 'ews-request :process proc) requests))
+ (push (make-instance 'ws-request :process proc) requests))
(let ((request (cl-find-if (lambda (c) (equal proc (process c)))
requests)))
(with-slots (pending) request (setq pending (concat pending string)))
(when (not (eq (catch 'close-connection
- (if (ews-parse-request request string)
- (ews-call-handler request handlers)
+ (if (ws-parse-request request string)
+ (ws-call-handler request handlers)
:keep-open))
:keep-open))
(setq requests (cl-remove-if (lambda (r) (eql proc (process r)))
requests))
(delete-process proc)))))
-(defun ews-parse-request (request string)
+(defun ws-parse-request (request string)
"Parse request STRING from REQUEST with process PROC.
Return non-nil only when parsing is complete."
(with-slots (process pending context boundary headers) request
@@ -179,10 +179,10 @@ Return non-nil only when parsing is complete."
;; http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4
(application/x-www-form-urlencoded
(mapc (lambda (pair) (setcdr (last headers) (list pair)))
- (ews-parse-query-string
+ (ws-parse-query-string
(replace-regexp-in-string
"\\+" " "
- (ews-trim (substring pending last-index)))))
+ (ws-trim (substring pending last-index)))))
(throw 'finished-parsing-headers t))
;; Set custom delimiter for multipart form data.
(multipart/form-data
@@ -192,15 +192,15 @@ Return non-nil only when parsing is complete."
(if (eql context 'multipart/form-data)
(progn
(setcdr (last headers)
- (list (ews-parse-multipart/form
- (ews-trim
+ (list (ws-parse-multipart/form
+ (ws-trim
(substring pending last-index index)))))
;; Boundary suffixed by "--" indicates end of the headers.
(when (and (> (length pending) (+ tmp 2))
(string= (substring pending tmp (+ tmp 2))
"--"))
(throw 'finished-parsing-headers t)))
;; Standard header parsing.
- (let ((header (ews-parse process (substring pending
+ (let ((header (ws-parse process (substring pending
last-index
index))))
;; Content-Type indicates that the next double \r\n
;; will be followed by a special type of content which
@@ -215,10 +215,10 @@ Return non-nil only when parsing is complete."
;; All other headers are collected directly.
(setcdr (last headers) header)))))
(setq last-index tmp)))
- (setq pending (ews-trim (substring pending last-index)))
+ (setq pending (ws-trim (substring pending last-index)))
nil))))
- (defun ews-call-handler (request handlers)
+ (defun ws-call-handler (request handlers)
(catch 'matched-handler
(mapc (lambda (handler)
(let ((match (car handler))
@@ -231,69 +231,69 @@ Return non-nil only when parsing is complete."
(and (functionp match) (funcall match request)))
(throw 'matched-handler
(condition-case e (funcall function request)
- (error (ews-error (process request)
+ (error (ws-error (process request)
"Caught Error: %S" e)))))))
handlers)
- (ews-error (process request) "no handler matched request: %S"
+ (ws-error (process request) "no handler matched request: %S"
(headers request))))
-(defun ews-error (proc msg &rest args)
+(defun ws-error (proc msg &rest args)
(let ((buf (plist-get (process-plist proc) :log-buffer))
(c (process-contact proc)))
(when buf
(with-current-buffer buf
(goto-char (point-max))
- (insert (format "%s\t%s\t%s\tEWS-ERROR: %s"
- (format-time-string ews-log-time-format)
+ (insert (format "%s\t%s\t%s\tWS-ERROR: %s"
+ (format-time-string ws-log-time-format)
(first c) (second c)
(apply #'format msg args)))))
- (apply #'ews-send-500 proc msg args)))
+ (apply #'ws-send-500 proc msg args)))
;;; Convenience functions to write responses
-(defun ews-response-header (proc code &rest header)
+(defun ws-response-header (proc code &rest header)
"Send the headers for an HTTP response to PROC.
Currently CODE should be an HTTP status code, see
-`ews-status-codes' for a list of known codes."
+`ws-status-codes' for a list of known codes."
(let ((headers
(cons
- (format "HTTP/1.1 %d %s" code (cdr (assoc code ews-status-codes)))
+ (format "HTTP/1.1 %d %s" code (cdr (assoc code ws-status-codes)))
(mapcar (lambda (h) (format "%s: %s" (car h) (cdr h))) header))))
(setcdr (last headers) (list "" ""))
(process-send-string proc (mapconcat #'identity headers "\r\n"))))
-(defun ews-send-500 (proc &rest msg-and-args)
+(defun ws-send-500 (proc &rest msg-and-args)
"Send 500 \"Internal Server Error\" to PROC with an optional message."
- (ews-response-header proc 500
+ (ws-response-header proc 500
'("Content-type" . "text/plain"))
(process-send-string proc (if msg-and-args
(apply #'format msg-and-args)
"500 Internal Server Error"))
(throw 'close-connection nil))
-(defun ews-send-404 (proc &rest msg-and-args)
+(defun ws-send-404 (proc &rest msg-and-args)
"Send 404 \"Not Found\" to PROC with an optional message."
- (ews-response-header proc 404
+ (ws-response-header proc 404
'("Content-type" . "text/plain"))
(process-send-string proc (if msg-and-args
(apply #'format msg-and-args)
"404 Not Found"))
(throw 'close-connection nil))
-(defun ews-send-file (proc path &optional mime-type)
+(defun ws-send-file (proc path &optional mime-type)
"Send PATH to PROC.
Optionally explicitly set MIME-TYPE, otherwise it is guessed by
`mm-default-file-encoding'."
(let ((mime (or mime-type
(mm-default-file-encoding path)
"application/octet-stream")))
- (ews-response-header proc 200 (cons "Content-type" mime))
+ (ws-response-header proc 200 (cons "Content-type" mime))
(process-send-string proc
(with-temp-buffer
(insert-file-contents-literally path)
(buffer-string)))))
-(defun ews-in-directory-p (parent path)
+(defun ws-in-directory-p (parent path)
"Check if PATH is under the PARENT directory.
If so return PATH, if not return nil."
(let ((expanded (expand-file-name path parent)))
@@ -301,5 +301,5 @@ If so return PATH, if not return nil."
(string= parent (substring expanded 0 (length parent)))
expanded)))
-(provide 'emacs-web-server)
-;;; emacs-web-server.el ends here
+(provide 'web-server)
+;;; web-server.el ends here
