[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master cbf5197 6/6: Merge commit 'b49ba259cc7e490e8acdecd28e66063
From: |
Stefan Monnier |
Subject: |
[elpa] master cbf5197 6/6: Merge commit 'b49ba259cc7e490e8acdecd28e66063f5ad1325e' |
Date: |
Mon, 30 Mar 2020 09:11:56 -0400 (EDT) |
branch: master
commit cbf5197b268e82cb0d99d4694148956f309139a0
Merge: b0d5113 b49ba25
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Merge commit 'b49ba259cc7e490e8acdecd28e66063f5ad1325e'
---
packages/web-server/.github/workflows/test.yml | 20 ++++++
packages/web-server/web-server-test.el | 30 ++++----
packages/web-server/web-server.el | 98 +++++++++++++++-----------
3 files changed, 93 insertions(+), 55 deletions(-)
diff --git a/packages/web-server/.github/workflows/test.yml
b/packages/web-server/.github/workflows/test.yml
new file mode 100644
index 0000000..0b2fe18
--- /dev/null
+++ b/packages/web-server/.github/workflows/test.yml
@@ -0,0 +1,20 @@
+name: CI
+
+on: [push, pull_request]
+
+jobs:
+ build:
+ runs-on: ubuntu-latest
+ strategy:
+ matrix:
+ emacs_version:
+ - 24.3
+ - 25.3
+ - 26.3
+ steps:
+ - uses: purcell/setup-emacs@master
+ with:
+ version: ${{ matrix.emacs_version }}
+ - uses: actions/checkout@v1
+ - name: Run tests
+ run: make src check
diff --git a/packages/web-server/web-server-test.el
b/packages/web-server/web-server-test.el
index 7ea02fa..5ec99b3 100644
--- a/packages/web-server/web-server-test.el
+++ b/packages/web-server/web-server-test.el
@@ -58,9 +58,9 @@
(ws-test-with (mapcar (lambda (letter)
`((:GET . ,letter) .
(lambda (request)
- (ws-response-header (process request) 200
+ (ws-response-header (ws-process request) 200
'("Content-type" . "text/plain"))
- (process-send-string (process request)
+ (process-send-string (ws-process request)
(concat "returned:" ,letter)))))
'("a" "b"))
(should (string= "returned:a" (ws-test-curl-to-string "a")))
@@ -71,9 +71,9 @@
(ws-test-with
'(((lambda (_) t) .
(lambda (request)
- (ws-response-header (process request) 200
+ (ws-response-header (ws-process request) 200
'("Content-type" . "text/plain"))
- (process-send-string (process request) "hello world"))))
+ (process-send-string (ws-process request) "hello world"))))
(should (string= (ws-test-curl-to-string "") "hello world"))))
(ert-deftest ws/removed-from-ws-servers-after-stop ()
@@ -89,7 +89,7 @@
(request (make-instance 'ws-request)))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
"GET / HTTP/1.1
Host: localhost:7777
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:26.0) Gecko/20100101
Firefox/26.0
@@ -102,7 +102,7 @@ Connection: keep-alive
")
(ws-parse-request request)
- (let ((headers (cdr (headers request))))
+ (let ((headers (cdr (ws-headers request))))
(should (string= (cdr (assoc :ACCEPT-ENCODING headers))
"gzip, deflate"))
(should (string= (cdr (assoc :GET headers)) "/"))
@@ -114,7 +114,7 @@ Connection: keep-alive
(request (make-instance 'ws-request)))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
"POST / HTTP/1.1
User-Agent: curl/7.33.0
Host: localhost:8080
@@ -135,7 +135,7 @@ Content-Disposition: form-data; name=\"name\"
------------------f1270d0deb77af03--
")
(ws-parse-request request)
- (let ((headers (cdr (headers request))))
+ (let ((headers (cdr (ws-headers request))))
(should (string= (cdr (assoc 'content (cdr (assoc "name"
headers))))
"\"schulte\""))
(should (string= (cdr (assoc 'content (cdr (assoc "date"
headers))))
@@ -148,7 +148,7 @@ Content-Disposition: form-data; name=\"name\"
(request (make-instance 'ws-request)))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
"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
@@ -167,7 +167,7 @@ Cache-Control: no-cache
org=-+one%0A-+two%0A-+three%0A-+four%0A%0A&beg=646&end=667&path=%2Fcomplex.org")
(ws-parse-request request)
- (let ((headers (cdr (headers request))))
+ (let ((headers (cdr (ws-headers request))))
(should (string= (cdr (assoc "path" headers)) "/complex.org"))
(should (string= (cdr (assoc "beg" headers)) "646"))
(should (string= (cdr (assoc "end" headers)) "667"))
@@ -192,7 +192,7 @@ The handler can then parse it itself."
(request (make-instance 'ws-request)))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
"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
@@ -210,7 +210,7 @@ Cache-Control: no-cache
{\"some example\": \"json data\"}")
(ws-parse-request request)
- (let ((headers (cdr (headers request))))
+ (let ((headers (cdr (ws-headers request))))
(should (string= (cdr (assoc :CONTENT-TYPE headers))
"application/json"))
(should (string= (oref request body)
@@ -260,7 +260,7 @@ Cache-Control: no-cache
(username "foo") (password "bar"))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
(format "GET / HTTP/1.1
Authorization: Basic %s
Connection: keep-alive
@@ -280,7 +280,7 @@ At least when it comes in a single chunk."
(request (make-instance 'ws-request)))
(unwind-protect
(progn
- (setf (pending request)
+ (setf (ws-pending request)
(format "POST / HTTP/1.1
User-Agent: curl/7.34.0
Host: localhost:9008
@@ -301,7 +301,7 @@ Content-Type: application/octet-stream
(should
(string= long-string
(cdr (assoc 'content
- (cdr (assoc "file" (headers request))))))))
+ (cdr (assoc "file" (ws-headers request))))))))
(ws-stop server))))
(ert-deftest ws/web-socket-handshake-rfc-example ()
diff --git a/packages/web-server/web-server.el
b/packages/web-server/web-server.el
index ab8da73..d1cd538 100644
--- a/packages/web-server/web-server.el
+++ b/packages/web-server/web-server.el
@@ -1,6 +1,6 @@
;;; web-server.el --- Emacs Web Server -*- lexical-binding:t -*-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
;; Author: Eric Schulte <address@hidden>
;; Maintainer: Eric Schulte <address@hidden>
@@ -50,20 +50,20 @@
(require 'cl-lib)
(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)))
+ ((handlers :initarg :handlers :accessor ws-handlers :initform nil)
+ (process :initarg :process :accessor ws-process :initform nil)
+ (port :initarg :port :accessor ws-port :initform nil)
+ (requests :initarg :requests :accessor ws-requests :initform nil)))
(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)
- (index :initarg :index :accessor index :initform 0)
- (active :initarg :active :accessor active :initform nil)
- (headers :initarg :headers :accessor headers :initform (list nil))
- (body :initarg :body :accessor body :initform "")))
+ ((process :initarg :process :accessor ws-process :initform nil)
+ (pending :initarg :pending :accessor ws-pending :initform "")
+ (context :initarg :context :accessor ws-context :initform nil)
+ (boundary :initarg :boundary :accessor ws-boundary :initform nil)
+ (index :initarg :index :accessor ws-index :initform 0)
+ (active :initarg :active :accessor ws-active :initform nil)
+ (headers :initarg :headers :accessor ws-headers :initform (list nil))
+ (body :initarg :body :accessor ws-body :initform "")))
(defvar ws-servers nil
"List holding all web servers.")
@@ -121,7 +121,7 @@ function.
(apply
#'make-network-process
:name "ws-server"
- :service (port server)
+ :service (ws-port server)
:filter 'ws-filter
:server t
:nowait (< emacs-major-version 26)
@@ -145,8 +145,8 @@ function.
(defun ws-stop (server)
"Stop SERVER."
(setq ws-servers (remove server ws-servers))
- (mapc #'delete-process (append (mapcar #'process (requests server))
- (list (process server)))))
+ (mapc #'delete-process (append (mapcar #'ws-process (ws-requests server))
+ (list (ws-process server)))))
(defun ws-stop-all ()
"Stop all servers in `ws-servers'."
@@ -226,12 +226,12 @@ function.
(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)
+ (unless (cl-find-if (lambda (c) (equal proc (ws-process c))) requests)
(push (make-instance 'ws-request :process proc) requests))
- (let ((request (cl-find-if (lambda (c) (equal proc (process c)))
requests)))
+ (let ((request (cl-find-if (lambda (c) (equal proc (ws-process c)))
requests)))
(with-slots (pending) request (setq pending (concat pending string)))
- (unless (active request) ; don't re-start if request is being parsed
- (setf (active request) t)
+ (unless (ws-active request) ; don't re-start if request is being parsed
+ (setf (ws-active request) t)
(when (not (eq (catch 'close-connection
(if (ws-parse-request request)
(ws-call-handler request handlers)
@@ -240,7 +240,7 @@ function.
;; Properly shut down processes requiring an ending (e.g., chunked)
(let ((ender (plist-get (process-plist proc) :ender)))
(when ender (process-send-string proc ender)))
- (setq requests (cl-remove-if (lambda (r) (eql proc (process r)))
requests))
+ (setq requests (cl-remove-if (lambda (r) (eql proc (ws-process r)))
requests))
(delete-process proc))))))
(defun ws-parse-request (request)
@@ -309,7 +309,7 @@ Return non-nil only when parsing is complete."
;; All other headers are collected directly.
(setcdr (last headers) header))))
(setq index tmp)))))
- (setf (active request) nil)
+ (setf (ws-active request) nil)
nil))
(defun ws-call-handler (request handlers)
@@ -317,23 +317,23 @@ Return non-nil only when parsing is complete."
(when (functionp handlers)
(throw 'matched-handler
(condition-case e (funcall handlers request)
- (error (ws-error (process request) "Caught Error: %S" e)))))
+ (error (ws-error (ws-process request) "Caught Error: %S" e)))))
(mapc (lambda (handler)
(let ((match (car handler))
(function (cdr handler)))
(when (or (and (consp match)
- (assoc (car match) (headers request))
+ (assoc (car match) (ws-headers request))
(string-match (cdr match)
(cdr (assoc (car match)
- (headers request)))))
+ (ws-headers request)))))
(and (functionp match) (funcall match request)))
(throw 'matched-handler
(condition-case e (funcall function request)
- (error (ws-error (process request)
+ (error (ws-error (ws-process request)
"Caught Error: %S" e)))))))
handlers)
- (ws-error (process request) "no handler matched request: %S"
- (headers request))))
+ (ws-error (ws-process request) "no handler matched request: %S"
+ (ws-headers request))))
(defun ws-error (proc msg &rest args)
(let ((buf (plist-get (process-plist proc) :log-buffer))
@@ -365,12 +365,12 @@ Return non-nil only when parsing is complete."
;; handler ------ holds the user-supplied function used called on the
;; data of parsed messages
(defclass ws-message () ; web socket message object
- ((process :initarg :process :accessor process :initform "")
- (pending :initarg :pending :accessor pending :initform "")
- (active :initarg :active :accessor active :initform nil)
- (new :initarg :new :accessor new :initform nil)
- (data :initarg :data :accessor data :initform "")
- (handler :initarg :handler :accessor handler :initform "")))
+ ((process :initarg :process :accessor ws-process :initform "")
+ (pending :initarg :pending :accessor ws-pending :initform "")
+ (active :initarg :active :accessor ws-active :initform nil)
+ (new :initarg :new :accessor ws-new :initform nil)
+ (data :initarg :data :accessor ws-data :initform "")
+ (handler :initarg :handler :accessor ws-handler :initform "")))
(defun ws-web-socket-connect (request handler)
"Establish a web socket connection with request.
@@ -402,12 +402,12 @@ received and parsed from the network."
(defun ws-web-socket-filter (process string)
(let ((message (plist-get (process-plist process) :message)))
- (if (active message) ; don't re-start if message is being parsed
- (setf (new message) string)
- (setf (pending message) (concat (pending message) string))
- (setf (active message) t)
+ (if (ws-active message) ; don't re-start if message is being parsed
+ (setf (ws-new message) string)
+ (setf (ws-pending message) (concat (ws-pending message) string))
+ (setf (ws-active message) t)
(ws-web-socket-parse-messages message))
- (setf (active message) nil)))
+ (setf (ws-active message) nil)))
(defun ws-web-socket-mask (masking-key data)
(let ((masking-data (apply #'concat (make-list (+ 1 (/ (length data) 4))
@@ -514,7 +514,7 @@ See RFC6455."
(when (< (+ index pl) (length pending))
(setq pending (substring pending (+ index pl)))))))
;; possibly re-parse any pending input
- (when (new message) (ws-web-socket-parse-messages message)))))
+ (when (ws-new message) (ws-web-socket-parse-messages message)))))
(defun ws-web-socket-frame (string &optional opcode)
"Frame STRING for web socket communication."
@@ -722,5 +722,23 @@ respectively."
"Perform the handshake defined in RFC6455."
(base64-encode-string (sha1 (concat (ws-trim key) ws-guid) nil nil 'binary)))
+;;; Enable the old accessors without the `ws-' namespace as obsolete.
+;;; Lets plan to remove these within a year of the date they were
+;;; marked obsolete, so that would be roughly 2021-03-12.
+(define-obsolete-function-alias 'active 'ws-active "2020-03-12")
+(define-obsolete-function-alias 'body 'ws-body "2020-03-12")
+(define-obsolete-function-alias 'boundary 'ws-boundary "2020-03-12")
+(define-obsolete-function-alias 'context 'ws-context "2020-03-12")
+(define-obsolete-function-alias 'data 'ws-data "2020-03-12")
+(define-obsolete-function-alias 'handler 'ws-handler "2020-03-12")
+(define-obsolete-function-alias 'handlers 'ws-handlers "2020-03-12")
+(define-obsolete-function-alias 'headers 'ws-headers "2020-03-12")
+(define-obsolete-function-alias 'index 'ws-index "2020-03-12")
+(define-obsolete-function-alias 'new 'ws-new "2020-03-12")
+(define-obsolete-function-alias 'pending 'ws-pending "2020-03-12")
+(define-obsolete-function-alias 'port 'ws-port "2020-03-12")
+(define-obsolete-function-alias 'process 'ws-process "2020-03-12")
+(define-obsolete-function-alias 'requests 'ws-requests "2020-03-12")
+
(provide 'web-server)
;;; web-server.el ends here
- [elpa] master updated (b0d5113 -> cbf5197), Stefan Monnier, 2020/03/30
- [elpa] master f58ecc6 1/6: Switch to lexical binding, Stefan Monnier, 2020/03/30
- [elpa] master c90d5ad 4/6: Don't forget run byte compile on github ci, Stefan Monnier, 2020/03/30
- [elpa] master b49ba25 5/6: Remove obsolete functions from test suite, Stefan Monnier, 2020/03/30
- [elpa] master 18a1147 3/6: Run tests on github ci, Stefan Monnier, 2020/03/30
- [elpa] master cbf5197 6/6: Merge commit 'b49ba259cc7e490e8acdecd28e66063f5ad1325e',
Stefan Monnier <=
- [elpa] master 8aa690b 2/6: Namespace all accessors, old names marked obsolete, Stefan Monnier, 2020/03/30