branch: externals/websocket
commit f8b00eb017ec8ba0e6574425e4325ea3ab802469
Author: Andrew Hyatt <[email protected]>
Commit: Andrew Hyatt <[email protected]>
Add tests, update copyright
---
websocket-test.el | 166 ++++++++++++++++++++++++++++++------------------------
websocket.el | 152 ++++++++++++++++++++++++-------------------------
2 files changed, 167 insertions(+), 151 deletions(-)
diff --git a/websocket-test.el b/websocket-test.el
index c133272662..0613e22b01 100644
--- a/websocket-test.el
+++ b/websocket-test.el
@@ -1,6 +1,6 @@
-;;; websocket-test.el --- Unit tests for the websocket layer
+;;; websocket-test.el --- Unit tests for the websocket layer -*-
lexical-binding:t -*-
-;; Copyright (c) 2013 Free Software Foundation, Inc.
+;; Copyright (c) 2013, 2026 Free Software Foundation, Inc.
;;
;; Author: Andrew Hyatt <ahyatt at gmail dot com>
;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
@@ -24,6 +24,7 @@
(require 'ert)
(require 'websocket)
+(require 's)
(eval-when-compile (require 'cl))
(ert-deftest websocket-genbytes-length ()
@@ -266,12 +267,12 @@
(ert-deftest websocket-process-headers ()
(cl-flet ((url-cookie-handle-set-cookie
- (text)
- (should (equal text "foo=bar;"))
- ;; test that we have set the implicit buffer variable needed
- ;; by url-cookie-handle-set-cookie
- (should (equal url-current-object
- (url-generic-parse-url "ws://example.com/path")))))
+ (text)
+ (should (equal text "foo=bar;"))
+ ;; test that we have set the implicit buffer variable needed
+ ;; by url-cookie-handle-set-cookie
+ (should (equal url-current-object
+ (url-generic-parse-url
"ws://example.com/path")))))
(websocket-process-headers "ws://example.com/path"
(concat
"HTTP/1.1 101 Switching Protocols\r\n"
@@ -299,8 +300,8 @@
"hello"
(progn
(funcall (websocket-process-frame
- websocket
- (make-websocket-frame :opcode opcode :payload "hello")))
+ websocket
+ (make-websocket-frame :opcode opcode :payload
"hello")))
processed))))
(setq sent nil)
(cl-letf (((symbol-function 'websocket-send)
@@ -357,9 +358,9 @@
;; We've tested websocket-read-frame, now we can use that to help
;; test websocket-encode-frame.
(should (equal
- websocket-test-hello
- (websocket-encode-frame
- (make-websocket-frame :opcode 'text :payload "Hello" :completep
t) nil)))
+ websocket-test-hello
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'text :payload "Hello" :completep t)
nil)))
(dolist (len '(200 70000))
(let ((long-string (make-string len ?x)))
(should (equal long-string
@@ -371,9 +372,9 @@
(cl-letf (((symbol-function 'websocket-genbytes)
(lambda (n) (substring websocket-test-masked-hello 2 6))))
(should (equal websocket-test-masked-hello
- (websocket-encode-frame
- (make-websocket-frame :opcode 'text :payload "Hello"
- :completep t) t))))
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'text :payload "Hello"
+ :completep t) t))))
(should-not
(websocket-frame-completep
(websocket-read-frame
@@ -382,14 +383,14 @@
:completep nil) t))))
(should (equal 'close (websocket-frame-opcode
(websocket-read-frame
- (websocket-encode-frame
- (make-websocket-frame :opcode 'close :completep t)
t)))))
+ (websocket-encode-frame
+ (make-websocket-frame :opcode 'close :completep t)
t)))))
(dolist (opcode '(ping pong))
(let ((read-frame (websocket-read-frame
- (websocket-encode-frame
- (make-websocket-frame :opcode opcode
- :payload "data"
- :completep t) t))))
+ (websocket-encode-frame
+ (make-websocket-frame :opcode opcode
+ :payload "data"
+ :completep t) t))))
(should read-frame)
(should (equal
opcode
@@ -538,7 +539,7 @@
((symbol-function 'process-send-string) (lambda (conn string)
t)))
;; Just make sure there is no error.
(websocket-send ws (make-websocket-frame :opcode 'ping
- :completep t)))
+ :completep t)))
(should-error (websocket-send ws
(make-websocket-frame :opcode 'text)))
(should-error (websocket-send ws
@@ -550,6 +551,21 @@
(make-websocket-frame :opcode :close))
:type 'websocket-illegal-frame)))
+(ert-deftest websocket-ensure-handshake ()
+ (let ((sent-string nil))
+ (cl-letf (((symbol-function 'process-send-string)
+ (lambda (proc string) (setq sent-string string)))
+ ((symbol-function 'process-get)
+ (lambda (proc sym)
+ (websocket-inner-create
+ :conn t :url t :accept-string "key")))
+ ((symbol-function 'process-status)
+ (lambda (proc) 'run)))
+ (websocket-ensure-handshake "ws://example.com?query=1"
+ 'conn 'key nil
+ nil nil nil)
+ (should (s-starts-with-p "GET /?query=1 HTTP/1.1\r\n" sent-string)))))
+
(ert-deftest websocket-verify-client-headers ()
(let* ((http "HTTP/1.1")
(host "Host: authority")
@@ -567,10 +583,10 @@
(mapconcat 'identity (append (list http "" protocol extensions1
extensions2)
all-required-headers) "\r\n"))))
(should (websocket-verify-client-headers
- (mapconcat 'identity
- (mapcar 'upcase
- (append (list http "" protocol extensions1
extensions2)
- all-required-headers)) "\r\n")))
+ (mapconcat 'identity
+ (mapcar 'upcase
+ (append (list http "" protocol extensions1
extensions2)
+ all-required-headers)) "\r\n")))
(dolist (header all-required-headers)
(should-not (websocket-verify-client-headers
(mapconcat 'identity (append (list http "")
@@ -620,34 +636,34 @@
(cl-letf (((symbol-function 'process-send-string) (lambda (p text) (setq
response text)))
((symbol-function 'websocket-close) (lambda (ws) (setq closed
t)))
((symbol-function 'process-get) (lambda (process sym) ws)))
- ;; Bad request, in two parts
+ ;; Bad request, in two parts
(cl-letf (((symbol-function 'websocket-verify-client-headers)
(lambda (text) nil)))
- (websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
- (should-not closed)
- (websocket-server-filter nil "\r\n")
- (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
- (should-not (websocket-inflight-input ws)))
- ;; Good request, followed by packet
- (setq closed nil
- response nil)
- (setf (websocket-inflight-input ws) nil)
- (cl-letf (((symbol-function 'websocket-verify-client-headers)
- (lambda (text) t))
- ((symbol-function 'websocket-get-server-response)
- (lambda (ws protocols extensions)
- "response"))
- ((symbol-function 'websocket-process-input-on-open-ws)
- (lambda (ws text)
- (setq processed t)
- (should
- (equal text websocket-test-hello)))))
- (websocket-server-filter nil
- (concat "\r\n\r\n" websocket-test-hello))
- (should (equal (websocket-ready-state ws) 'open))
- (should-not closed)
- (should (equal response "response"))
- (should processed)))))
+ (websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
+ (should-not closed)
+ (websocket-server-filter nil "\r\n")
+ (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
+ (should-not (websocket-inflight-input ws)))
+ ;; Good request, followed by packet
+ (setq closed nil
+ response nil)
+ (setf (websocket-inflight-input ws) nil)
+ (cl-letf (((symbol-function 'websocket-verify-client-headers)
+ (lambda (text) t))
+ ((symbol-function 'websocket-get-server-response)
+ (lambda (ws protocols extensions)
+ "response"))
+ ((symbol-function 'websocket-process-input-on-open-ws)
+ (lambda (ws text)
+ (setq processed t)
+ (should
+ (equal text websocket-test-hello)))))
+ (websocket-server-filter nil
+ (concat "\r\n\r\n" websocket-test-hello))
+ (should (equal (websocket-ready-state ws) 'open))
+ (should-not closed)
+ (should (equal response "response"))
+ (should processed)))))
(ert-deftest websocket-complete-server-response-test ()
;; Example taken from RFC
@@ -659,24 +675,24 @@
"Sec-WebSocket-Protocol: chat\r\n\r\n"
)
(let ((header-info
- (websocket-verify-client-headers
- (concat "GET /chat HTTP/1.1\r\n"
- "Host: server.example.com\r\n"
- "Upgrade: websocket\r\n"
- "Connection: Upgrade\r\n"
- "Sec-WebSocket-Key:
dGhlIHNhbXBsZSBub25jZQ==\r\n"
- "Sec-WebSocket-Protocol: chat,
superchat\r\n"
- "Sec-WebSocket-Version: 13\r\n"))))
- (should header-info)
- (let ((ws (websocket-inner-create
- :conn t :url t
- :accept-string (websocket-calculate-accept
- (plist-get header-info :key))
- :protocols '("chat"))))
- (websocket-get-server-response
- ws
- (plist-get header-info :protocols)
- (plist-get header-info :extension)))))))
+ (websocket-verify-client-headers
+ (concat "GET /chat HTTP/1.1\r\n"
+ "Host: server.example.com\r\n"
+ "Upgrade: websocket\r\n"
+ "Connection: Upgrade\r\n"
+ "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
+ "Sec-WebSocket-Protocol: chat, superchat\r\n"
+ "Sec-WebSocket-Version: 13\r\n"))))
+ (should header-info)
+ (let ((ws (websocket-inner-create
+ :conn t :url t
+ :accept-string (websocket-calculate-accept
+ (plist-get header-info :key))
+ :protocols '("chat"))))
+ (websocket-get-server-response
+ ws
+ (plist-get header-info :protocols)
+ (plist-get header-info :extension)))))))
(ert-deftest websocket-server-close ()
(let ((websocket-server-websockets
@@ -712,10 +728,10 @@
(cl-letf (((symbol-function 'try-error)
(lambda (callback-type err expected-message)
(cl-flet ((display-warning
- (type message &optional level buffer-name)
- (should (eq type 'websocket))
- (should (eq level :error))
- (should (string= message expected-message))))
+ (type message &optional level buffer-name)
+ (should (eq type 'websocket))
+ (should (eq level :error))
+ (should (string= message expected-message))))
(websocket-default-error-handler nil
callback-type
err)))))
diff --git a/websocket.el b/websocket.el
index 9dc59a9d1c..2669c9c192 100644
--- a/websocket.el
+++ b/websocket.el
@@ -1,6 +1,6 @@
;;; websocket.el --- Emacs WebSocket client and server -*- lexical-binding:t
-*-
-;; Copyright (c) 2013, 2016-2023 Free Software Foundation, Inc.
+;; Copyright (c) 2013, 2016-2023, 2026 Free Software Foundation, Inc.
;; Author: Andrew Hyatt <[email protected]>
;; Homepage: https://github.com/ahyatt/emacs-websocket
@@ -53,8 +53,8 @@
;;; Code:
(cl-defstruct (websocket
- (:constructor nil)
- (:constructor websocket-inner-create))
+ (:constructor nil)
+ (:constructor websocket-inner-create))
"A websocket structure.
This follows the W3C Websocket API, except translated to elisp
idioms. The API is implemented in both the websocket struct and
@@ -320,25 +320,25 @@ We mask the frame or not, depending on SHOULD-MASK."
(`ping 9)
(`pong 10))
(if fin 128 0)))
- (when payloadp
- (list
- (logior
- (if should-mask 128 0)
- (cond ((< (length payload) 126) (length
payload))
- ((< (length payload) 65536) 126)
- (t 127)))))
- (when (and payloadp (>= (length payload) 126))
- (append (websocket-to-bytes
- (length payload)
- (cond ((< (length payload) 126) 1)
- ((< (length payload) 65536) 2)
- (t 8))) nil))
- (when (and payloadp should-mask)
- (append mask-key nil))
- (when payloadp
- (append (if should-mask (websocket-mask mask-key
payload)
- payload)
- nil)))))
+ (when payloadp
+ (list
+ (logior
+ (if should-mask 128 0)
+ (cond ((< (length payload) 126) (length
payload))
+ ((< (length payload) 65536) 126)
+ (t 127)))))
+ (when (and payloadp (>= (length payload) 126))
+ (append (websocket-to-bytes
+ (length payload)
+ (cond ((< (length payload) 126) 1)
+ ((< (length payload) 65536) 2)
+ (t 8))) nil))
+ (when (and payloadp should-mask)
+ (append mask-key nil))
+ (when payloadp
+ (append (if should-mask (websocket-mask
mask-key payload)
+ payload)
+ nil)))))
;; We have to make sure the non-payload data is a full 32-bit
frame
(if (= 1 (length val))
(append val '(0)) val)))))
@@ -437,7 +437,7 @@ ERR should be a cons of error symbol and error data."
(defun websocket-get-debug-buffer-create (websocket)
"Get or create the buffer corresponding to WEBSOCKET."
(let ((buf (get-buffer-create (format "*websocket %s debug*"
- (websocket-url websocket)))))
+ (websocket-url websocket)))))
(when (= 0 (buffer-size buf))
(buffer-disable-undo buf))
buf))
@@ -488,13 +488,13 @@ has connection termination."
(let ((opcode (websocket-frame-opcode frame)))
(cond ((memq opcode '(continuation text binary))
(lambda () (websocket-try-callback 'websocket-on-message 'on-message
- websocket frame)))
+ websocket frame)))
((eq opcode 'ping)
(lambda () (websocket-send websocket
- (make-websocket-frame
- :opcode 'pong
- :payload (websocket-frame-payload frame)
- :completep t))))
+ (make-websocket-frame
+ :opcode 'pong
+ :payload (websocket-frame-payload frame)
+ :completep t))))
((eq opcode 'close)
(lambda () (delete-process (websocket-conn websocket))))
(t (lambda ())))))
@@ -953,30 +953,30 @@ All these parameters are defined as in `websocket-open'."
(defun websocket-get-server-response (websocket client-protocols
client-extensions)
"Get the websocket response from client WEBSOCKET."
(let ((separator "\r\n"))
- (concat "HTTP/1.1 101 Switching Protocols" separator
- "Upgrade: websocket" separator
- "Connection: Upgrade" separator
- "Sec-WebSocket-Accept: "
- (websocket-accept-string websocket) separator
- (let ((protocols
- (websocket-intersect client-protocols
- (websocket-protocols
websocket))))
- (when protocols
- (concat
- (mapconcat
- (lambda (protocol) (format "Sec-WebSocket-Protocol: %s"
- protocol)) protocols separator)
- separator)))
- (let ((extensions (websocket-intersect
- client-extensions
- (websocket-extensions websocket))))
- (when extensions
- (concat
- (mapconcat
- (lambda (extension) (format "Sec-Websocket-Extensions:
%s"
- extension)) extensions separator)
- separator)))
- separator)))
+ (concat "HTTP/1.1 101 Switching Protocols" separator
+ "Upgrade: websocket" separator
+ "Connection: Upgrade" separator
+ "Sec-WebSocket-Accept: "
+ (websocket-accept-string websocket) separator
+ (let ((protocols
+ (websocket-intersect client-protocols
+ (websocket-protocols websocket))))
+ (when protocols
+ (concat
+ (mapconcat
+ (lambda (protocol) (format "Sec-WebSocket-Protocol: %s"
+ protocol)) protocols separator)
+ separator)))
+ (let ((extensions (websocket-intersect
+ client-extensions
+ (websocket-extensions websocket))))
+ (when extensions
+ (concat
+ (mapconcat
+ (lambda (extension) (format "Sec-Websocket-Extensions: %s"
+ extension)) extensions separator)
+ separator)))
+ separator)))
(defun websocket-server-filter (process output)
"This acts on all OUTPUT from websocket clients PROCESS."
@@ -988,30 +988,30 @@ All these parameters are defined as in `websocket-open'."
(let ((end-of-header-pos
(let ((pos (string-match "\r\n\r\n" text)))
(when pos (+ 4 pos)))))
- (if end-of-header-pos
- (progn
- (let ((header-info (websocket-verify-client-headers
text)))
- (if header-info
- (progn (setf (websocket-accept-string ws)
- (websocket-calculate-accept
- (plist-get header-info :key)))
- (process-send-string
- process
- (websocket-get-server-response
- ws (plist-get header-info :protocols)
- (plist-get header-info :extensions)))
- (setf (websocket-ready-state ws) 'open)
- (setf (websocket-origin ws) (plist-get
header-info :origin))
- (websocket-try-callback 'websocket-on-open
- 'on-open ws))
- (message "Invalid client headers found in: %s" output)
- (process-send-string process "HTTP/1.1 400 Bad
Request\r\n\r\n")
- (websocket-close ws)))
- (when (> (length text) (+ 1 end-of-header-pos))
- (websocket-server-filter process (substring
- text
-
end-of-header-pos))))
- (setf (websocket-inflight-input ws) text))))
+ (if end-of-header-pos
+ (progn
+ (let ((header-info (websocket-verify-client-headers text)))
+ (if header-info
+ (progn (setf (websocket-accept-string ws)
+ (websocket-calculate-accept
+ (plist-get header-info :key)))
+ (process-send-string
+ process
+ (websocket-get-server-response
+ ws (plist-get header-info :protocols)
+ (plist-get header-info :extensions)))
+ (setf (websocket-ready-state ws) 'open)
+ (setf (websocket-origin ws) (plist-get
header-info :origin))
+ (websocket-try-callback 'websocket-on-open
+ 'on-open ws))
+ (message "Invalid client headers found in: %s" output)
+ (process-send-string process "HTTP/1.1 400 Bad
Request\r\n\r\n")
+ (websocket-close ws)))
+ (when (> (length text) (+ 1 end-of-header-pos))
+ (websocket-server-filter process (substring
+ text
+ end-of-header-pos))))
+ (setf (websocket-inflight-input ws) text))))
((eq (websocket-ready-state ws) 'open)
(websocket-process-input-on-open-ws ws text))
((eq (websocket-ready-state ws) 'closed)
