emacs-elpa-diffs
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]