branch: externals/websocket
commit 2195e1247ecb04c30321702aa5f5618a51c329c5
Merge: 03d1cca4bd 3210187c10
Author: Andrew Hyatt <[email protected]>
Commit: GitHub <[email protected]>
Merge pull request #84 from ahyatt/monnier-improvements
Cleanups of obsolete functions, stylistic improvements
---
.gitignore | 5 ++
websocket-functional-test.el | 19 +++--
websocket-test.el | 174 +++++++++++++++++++++++--------------------
websocket.el | 120 ++++++++++++++++++-----------
4 files changed, 188 insertions(+), 130 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..a6ae3c855d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+*.elc
+
+# ELPA-generated files.
+/websocket-autoloads.el
+/websocket-pkg.el
diff --git a/websocket-functional-test.el b/websocket-functional-test.el
index 3d13694720..c14f4ae2b5 100644
--- a/websocket-functional-test.el
+++ b/websocket-functional-test.el
@@ -27,10 +27,9 @@
;; These tests are written to test the basic connectivity and message-sending.
;; Corner-cases and error handling is tested in websocket-test.el.
-(require 'tls) ;; tests a particular bug we had on Emacs 23
+(require 'nsm)
(require 'websocket)
-(require 'cl)
-(require 'f)
+(require 'ert)
;;; Code:
@@ -50,16 +49,18 @@ written to be used widely."
"Run the main part of an ert test against WSTEST-SERVER-URL."
;; the server may have an untrusted certificate, for the test to proceed, we
;; need to disable trust checking.
- (let* ((tls-checktrust nil)
- (wstest-closed nil)
+ (let* ((nsm-trust-local-network t)
+ ;; (wstest-closed nil)
(wstest-msg)
- (wstest-server-proc)
+ ;; (wstest-server-proc)
(wstest-ws
(websocket-open
wstest-server-url
:on-message (lambda (_websocket frame)
(setq wstest-msg (websocket-frame-text frame)))
- :on-close (lambda (_websocket) (setq wstest-closed t)))))
+ :on-close (lambda (_websocket)
+ ;; (setq wstest-closed t)
+ t))))
(should (websocket-test-wait-with-timeout 2 (websocket-openp wstest-ws)))
(should (websocket-test-wait-with-timeout 2 (eq 'open
(websocket-ready-state wstest-ws))))
(should (null wstest-msg))
@@ -70,7 +71,9 @@ written to be used widely."
;; Hack because we have to be able to find the testserver.py script.
(defconst websocket-ft-testserver (format "%s/testserver.py"
(file-name-directory
- (f-this-file))))
+ (if (fboundp 'macroexp-file-name)
+ (macroexp-file-name) ;Emacs-28
+ load-file-name))))
(ert-deftest websocket-client-with-local-server ()
;; If testserver.py cannot start, this test will fail.
diff --git a/websocket-test.el b/websocket-test.el
index 35589dd0a1..d9d6976180 100644
--- a/websocket-test.el
+++ b/websocket-test.el
@@ -24,11 +24,11 @@
(require 'ert)
(require 'websocket)
-(require 's)
-(eval-when-compile (require 'cl))
+;; (require 's)
+(eval-when-compile (require 'cl-lib))
(ert-deftest websocket-genbytes-length ()
- (loop repeat 100
+ (cl-loop repeat 100
do (should (= (string-bytes (websocket-genbytes 16)) 16))))
(ert-deftest websocket-calculate-accept ()
@@ -38,18 +38,21 @@
(websocket-calculate-accept "dGhlIHNhbXBsZSBub25jZQ=="))))
(defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
- "'Hello' string example, taken from the RFC.")
+ "\"Hello\" string example, taken from the RFC.")
(defconst websocket-test-masked-hello
"\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58"
- "'Hello' masked string example, taken from the RFC.")
+ "\"Hello\" masked string example, taken from the RFC.")
(ert-deftest websocket-get-bytes ()
(should (equal #x5 (websocket-get-bytes "\x5" 1)))
(should (equal #x101 (websocket-get-bytes "\x1\x1" 2)))
(should (equal #xffffff
(websocket-get-bytes "\x0\x0\x0\x0\x0\xFF\xFF\xFF" 8)))
- (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
+ (unless (fboundp 'bindat-type)
+ (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
+ :type 'websocket-unparseable-frame))
+ (should-error (websocket-get-bytes "\x80\x0\x0\x0\x0\x0\x0\x0" 8)
:type 'websocket-unparseable-frame)
(should-error (websocket-get-bytes "\x0\x0\x0" 3))
(should-error (websocket-get-bytes "\x0" 2) :type
'websocket-unparseable-frame))
@@ -107,7 +110,7 @@
(- (length websocket-test-masked-hello) (+ i
1)))))))
(defun websocket-test-header-with-lines (&rest lines)
- (mapconcat 'identity (append lines '("\r\n")) "\r\n"))
+ (mapconcat #'identity (append lines '("\r\n")) "\r\n"))
(ert-deftest websocket-verify-response-code ()
(should (websocket-verify-response-code "HTTP/1.1 101"))
@@ -226,7 +229,7 @@
"Sec-WebSocket-Key: key\r\n"
"Sec-WebSocket-Version: 13\r\n")))
(cl-letf (((symbol-function 'url-cookie-generate-header-lines)
- (lambda (host localpart secure) "")))
+ (lambda (_host _localpart _secure) "")))
(should (equal (concat base-headers "\r\n")
(websocket-create-headers "ws://www.example.com/path"
"key" nil nil nil)))
@@ -266,20 +269,21 @@
(websocket-create-headers "ws://www.example.com:123/path" "key" nil nil
nil)))))
(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")))))
+ (cl-letf (((symbol-function 'url-cookie-handle-set-cookie)
+ (lambda (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"
"Upgrade: websocket\r\n"
"Connection: Upgrade\r\n"
"Set-Cookie: foo=bar;\r\n\r\n")))
- (cl-flet ((url-cookie-handle-set-cookie (text) (should nil)))
+ (cl-letf (((symbol-function 'url-cookie-handle-set-cookie)
+ (lambda (_text) (should nil))))
(websocket-process-headers "ws://example.com/path"
"HTTP/1.1 101 Switching Protocols\r\n")))
@@ -289,7 +293,7 @@
(deleted)
(websocket (websocket-inner-create
:conn t :url t
- :on-message (lambda (websocket frame)
+ :on-message (lambda (_websocket frame)
(setq
processed
(websocket-frame-payload frame)))
@@ -305,7 +309,7 @@
processed))))
(setq sent nil)
(cl-letf (((symbol-function 'websocket-send)
- (lambda (websocket content) (setq sent content))))
+ (lambda (_websocket content) (setq sent content))))
(should (equal
(make-websocket-frame :opcode 'pong :payload "data" :completep
t)
(progn
@@ -314,7 +318,7 @@
:payload "data")))
sent))))
(cl-letf (((symbol-function 'delete-process)
- (lambda (conn) (setq deleted t))))
+ (lambda (_conn) (setq deleted t))))
(should (progn
(funcall
(websocket-process-frame websocket
@@ -325,10 +329,10 @@
(let* ((error-called)
(websocket (websocket-inner-create
:conn t :url t :accept-string t
- :on-message (lambda (websocket frame)
+ :on-message (lambda (_websocket _frame)
(message "In on-message")
(error "err"))
- :on-error (lambda (ws type err)
+ :on-error (lambda (_ws type _err)
(should (eq 'on-message type))
(setq error-called t)))))
(funcall (websocket-process-frame websocket
@@ -344,9 +348,12 @@
(should (equal 70000 (websocket-get-bytes (websocket-to-bytes 70000 8) 8)))
;; Only run if the number we're testing with is not more than the system can
;; handle.
- (if (equal "1" (calc-eval (format "536870912 < %d" most-positive-fixnum)))
+ (if (and (not (fboundp 'bindat-type))
+ (equal "1" (calc-eval (format "536870912 < %d"
most-positive-fixnum))))
(should-error (websocket-to-bytes 536870912 8)
:type 'websocket-frame-too-large))
+ (should-error (websocket-to-bytes (expt 2 63) 8)
+ :type 'websocket-frame-too-large)
(should-error (websocket-to-bytes 30 3))
(should-error (websocket-to-bytes 300 1))
;; I'd like to test the error for 32-byte systems on 8-byte lengths,
@@ -368,19 +375,22 @@
(websocket-read-frame
(websocket-encode-frame
(make-websocket-frame :opcode 'text
- :payload long-string) t)))))))
+ :payload long-string)
+ t)))))))
(cl-letf (((symbol-function 'websocket-genbytes)
- (lambda (n) (substring websocket-test-masked-hello 2 6))))
+ (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))))
+ :completep t)
+ t))))
(should-not
(websocket-frame-completep
(websocket-read-frame
(websocket-encode-frame (make-websocket-frame :opcode 'text
:payload "Hello"
- :completep nil) t))))
+ :completep nil)
+ t))))
(should (equal 'close (websocket-frame-opcode
(websocket-read-frame
(websocket-encode-frame
@@ -422,10 +432,10 @@
(let ((sent-frames)
(processes-deleted))
(cl-letf (((symbol-function 'websocket-send)
- (lambda (websocket frame) (push frame sent-frames)))
+ (lambda (_websocket frame) (push frame sent-frames)))
((symbol-function 'websocket-openp)
- (lambda (websocket) t))
- ((symbol-function 'kill-buffer) (lambda (buffer) t))
+ (lambda (_websocket) t))
+ ((symbol-function 'kill-buffer) (lambda (_buffer) t))
((symbol-function 'delete-process)
(lambda (proc) (add-to-list 'processes-deleted proc))))
(websocket-close (websocket-inner-create
@@ -447,7 +457,7 @@
'open))
(setq open-callback-called t)
(error "Ignore me!"))
- :on-error (lambda (ws type err))))
+ :on-error (lambda (_ws _type _err) nil)))
(processed-frames)
(frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep
t
:length 9))
@@ -458,12 +468,11 @@
(websocket-encode-frame frame1 t)
(websocket-encode-frame frame2 t))))
(cl-letf (((symbol-function 'websocket-process-frame)
- (lambda (websocket frame)
- (lexical-let ((frame frame))
- (lambda () (push frame processed-frames)))))
+ (lambda (_websocket frame)
+ (lambda () (push frame processed-frames))))
((symbol-function 'websocket-verify-headers)
- (lambda (websocket output) t))
- ((symbol-function 'websocket-close) (lambda (websocket) t)))
+ (lambda (_websocket _output) t))
+ ((symbol-function 'websocket-close) (lambda (_websocket) t)))
(websocket-outer-filter fake-ws "HTTP/1.1 101 Switching Protocols\r\n")
(websocket-outer-filter fake-ws "Sec-")
(should (eq (websocket-ready-state fake-ws) 'connecting))
@@ -477,10 +486,10 @@
(websocket-outer-filter fake-ws (substring websocket-frames 2))
(should (equal (list frame2 frame1) processed-frames))
(should-not (websocket-inflight-input fake-ws)))
- (cl-letf (((symbol-function 'websocket-close) (lambda (websocket) t)))
+ (cl-letf (((symbol-function 'websocket-close) (lambda (_websocket) t)))
(let ((on-error-called))
(setf (websocket-ready-state fake-ws) 'connecting)
- (setf (websocket-on-open fake-ws) (lambda (ws &rest _) t))
+ (setf (websocket-on-open fake-ws) (lambda (_ws &rest _) t))
(setf (websocket-on-error fake-ws)
(lambda (_ type err)
(should (eq type 'on-open))
@@ -494,15 +503,15 @@
(websocket-closed-calledp)
(fake-ws (websocket-inner-create
:conn t :url t :accept-string t
- :on-open (lambda (websocket)
+ :on-open (lambda (_websocket)
(setq on-open-calledp t)))))
(cl-letf (((symbol-function 'websocket-verify-response-code)
- (lambda (output) t))
+ (lambda (_output) t))
((symbol-function 'websocket-verify-headers)
- (lambda (websocket output) (error "Bad headers!")))
+ (lambda (_websocket _output) (error "Bad headers!")))
((symbol-function 'websocket-close)
- (lambda (websocket) (setq websocket-closed-calledp t))))
- (condition-case err
+ (lambda (_websocket) (setq websocket-closed-calledp t))))
+ (condition-case nil
(progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
(error "Should have thrown an error!"))
(error
@@ -510,14 +519,15 @@
(should websocket-closed-calledp))))))
(ert-deftest websocket-outer-filter-fragmented-header ()
- (let* ((on-open-calledp)
- (websocket-closed-calledp)
+ (let* (;; (on-open-calledp)
+ ;; (websocket-closed-calledp)
(fake-ws (websocket-inner-create
:protocols '("websocket")
:conn t :url t :accept-string "17hG/VoPPd14L9xPSI7LtEr7PQc="
- :on-open (lambda (websocket)
- (setq on-open-calledp t)))))
- (cl-letf (((symbol-function 'websocket-close) (lambda (websocket) t)))
+ :on-open (lambda (_websocket)
+ ;; (setq on-open-calledp t)
+ t))))
+ (cl-letf (((symbol-function 'websocket-close) (lambda (_websocket) t)))
(websocket-outer-filter fake-ws "HTTP/1.1 101 Web Socket Protocol
Handsh")
(websocket-outer-filter fake-ws "ake\r\nConnection: Upgrade\r\n")
(websocket-outer-filter fake-ws "Upgrade: websocket\r\n")
@@ -526,7 +536,7 @@
(ert-deftest websocket-send-text ()
(cl-letf (((symbol-function 'websocket-send)
- (lambda (ws frame)
+ (lambda (_ws frame)
(should (equal
(websocket-frame-payload frame)
"\344\275\240\345\245\275")))))
@@ -534,9 +544,9 @@
(ert-deftest websocket-send ()
(let ((ws (websocket-inner-create :conn t :url t :accept-string t)))
- (cl-letf (((symbol-function 'websocket-ensure-connected) (lambda
(websocket) t))
- ((symbol-function 'websocket-openp) (lambda (websocket) t))
- ((symbol-function 'process-send-string) (lambda (conn string)
t)))
+ (cl-letf (((symbol-function 'websocket-ensure-connected) (lambda
(_websocket) t))
+ ((symbol-function 'websocket-openp) (lambda (_websocket) t))
+ ((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)))
@@ -554,17 +564,17 @@
(ert-deftest websocket-ensure-handshake ()
(let ((sent-string nil))
(cl-letf (((symbol-function 'process-send-string)
- (lambda (proc string) (setq sent-string string)))
+ (lambda (_proc string) (setq sent-string string)))
((symbol-function 'process-get)
- (lambda (proc sym)
+ (lambda (_proc _sym)
(websocket-inner-create
:conn t :url t :accept-string "key")))
((symbol-function 'process-status)
- (lambda (proc) 'run)))
+ (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)))))
+ (should (string-prefix-p "GET /?query=1 HTTP/1.1\r\n" sent-string)))))
(ert-deftest websocket-verify-client-headers ()
(let* ((http "HTTP/1.1")
@@ -580,20 +590,22 @@
(should (equal
'(:key "key" :protocols ("protocol") :extensions ("foo" "bar;
baz=2"))
(websocket-verify-client-headers
- (mapconcat 'identity (append (list http "" protocol extensions1
extensions2)
- all-required-headers) "\r\n"))))
+ (mapconcat #'identity (append (list http "" protocol extensions1
extensions2)
+ all-required-headers)
+ "\r\n"))))
(should (websocket-verify-client-headers
- (mapconcat 'identity
- (mapcar 'upcase
+ (mapconcat #'identity
+ (mapcar #'upcase
(append (list http "" protocol extensions1
extensions2)
- all-required-headers)) "\r\n")))
+ all-required-headers))
+ "\r\n")))
(dolist (header all-required-headers)
(should-not (websocket-verify-client-headers
- (mapconcat 'identity (append (list http "")
+ (mapconcat #'identity (append (list http "")
(remove header
all-required-headers))
"\r\n"))))
(should-not (websocket-verify-client-headers
- (mapconcat 'identity (append (list "HTTP/1.0" "")
all-required-headers)
+ (mapconcat #'identity (append (list "HTTP/1.0" "")
all-required-headers)
"\r\n")))))
(ert-deftest websocket-intersect ()
@@ -627,18 +639,20 @@
(should (string-match "Sec-Websocket-Extensions: seb\r\n" output)))))
(ert-deftest websocket-server-filter ()
- (let ((on-open-called)
+ (let (;; (on-open-called)
(ws (websocket-inner-create :conn t :url t :accept-string "key"
- :on-open (lambda (ws) (setq on-open-called
t))))
+ :on-open (lambda (_ws)
+ ;; (setq on-open-called t)
+ t)))
(closed)
(response)
(processed))
- (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)))
+ (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
(cl-letf (((symbol-function 'websocket-verify-client-headers)
- (lambda (text) nil)))
+ (lambda (_text) nil)))
(websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
(should-not closed)
(websocket-server-filter nil "\r\n")
@@ -649,12 +663,12 @@
response nil)
(setf (websocket-inflight-input ws) nil)
(cl-letf (((symbol-function 'websocket-verify-client-headers)
- (lambda (text) t))
+ (lambda (_text) t))
((symbol-function 'websocket-get-server-response)
- (lambda (ws protocols extensions)
+ (lambda (_ws _protocols _extensions)
"response"))
((symbol-function 'websocket-process-input-on-open-ws)
- (lambda (ws text)
+ (lambda (_ws text)
(setq processed t)
(should
(equal text websocket-test-hello)))))
@@ -725,16 +739,18 @@
(should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
(ert-deftest websocket-default-error-handler ()
- (cl-letf (((symbol-function 'try-error)
- (lambda (callback-type err expected-message)
- (cl-flet ((display-warning
- (type message &optional level buffer-name)
+ ;; `cl-flet' creates a function definition for the current lexical
+ ;; scope, whereas `cl-letf' overrides a global binding, like
+ ;; a dynamically-scoped definition.
+ (cl-flet ((try-error (callback-type err expected-message)
+ (cl-letf (((symbol-function 'display-warning)
+ (lambda (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)))))
+ (should (string= message expected-message)))))
+ (websocket-default-error-handler nil
+ callback-type
+ err))))
(try-error
'on-message
'(end-of-buffer)
diff --git a/websocket.el b/websocket.el
index afa17c4b85..b572b19300 100644
--- a/websocket.el
+++ b/websocket.el
@@ -189,13 +189,21 @@ This is based on the KEY from the Sec-WebSocket-Key
header."
(base64-encode-string
(sha1 (concat key websocket-guid) nil nil t)))
+(defmacro websocket--if-when-compile (cond then else)
+ (declare (debug t) (indent 2))
+ (if (eval cond t) then else))
+
(defun websocket-get-bytes (s n)
"From string S, retrieve the value of N bytes.
Return the value as an unsigned integer. The value N must be a
power of 2, up to 8.
-We support getting frames up to 536870911 bytes (2^29 - 1),
-approximately 537M long."
+In Emacs<28, we support getting frames only up to 536870911 bytes (2^29 - 1),
+approximately 537M long.
+
+This is only used in situations where `bindat-type' is not available."
+ (unless (memq n '(1 2 4 8))
+ (error "websocket-get-bytes: Unknown N: %S" n))
(if (= n 8)
(let* ((32-bit-parts
(bindat-get-field (bindat-unpack '((:val vec 2 u32)) s) :val))
@@ -224,33 +232,39 @@ approximately 537M long."
:val)))
(defun websocket-to-bytes (val nbytes)
- "Encode the integer VAL in NBYTES of data.
+ "Encode the unsigned integer VAL in NBYTES of data.
NBYTES much be a power of 2, up to 8.
-This supports encoding values up to 536870911 bytes (2^29 - 1),
-approximately 537M long."
- (when (and (< nbytes 8)
- (> val (expt 2 (* 8 nbytes))))
+In Emacs<28, this supports encoding values only up to 536870911 bytes
+\(2^29 - 1), approximately 537M long."
+ (unless (memq nbytes '(1 2 4 8))
+ (error "websocket-to-bytes: Unknown NBYTES: %S" nbytes))
+ (unless (= 0 (ash val (- (* 8 nbytes))))
;; not a user-facing error, this must be caused from an error in
;; this library
(error "websocket-to-bytes: Value %d could not be expressed in %d bytes"
val nbytes))
- (if (= nbytes 8)
+ (websocket--if-when-compile (fboundp 'bindat-type)
(progn
- (let* ((hi-32bits (ash val -32))
- ;; This is just VAL on systems that don't have >= 32 bits.
- (low-32bits (- val (ash hi-32bits 32))))
- (when (or (> hi-32bits 0) (> (ash low-32bits -29) 0))
+ (if (and (= nbytes 8) (> (ash val -63) 0))
(signal 'websocket-frame-too-large (list val)))
- (bindat-pack `((:val vec 2 u32))
- `((:val . [,hi-32bits ,low-32bits])))))
- (bindat-pack
- `((:val ,(cond ((= nbytes 1) 'u8)
- ((= nbytes 2) 'u16)
- ((= nbytes 4) 'u32)
- ;; Library error, not system error
- (t (error "websocket-to-bytes: Unknown NBYTES: %S"
nbytes)))))
- `((:val . ,val)))))
+ (bindat-pack (bindat-type uint (* 8 nbytes)) val))
+ (if (= nbytes 8)
+ (progn
+ (let* ((hi-32bits (ash val -32))
+ ;; This is just VAL on systems that don't have >= 32 bits.
+ (low-32bits (- val (ash hi-32bits 32))))
+ (when (or (> hi-32bits 0) (> (ash low-32bits -29) 0))
+ (signal 'websocket-frame-too-large (list val)))
+ (bindat-pack `((:val vec 2 u32))
+ `((:val . [,hi-32bits ,low-32bits])))))
+ (bindat-pack
+ `((:val ,(cond ((= nbytes 1) 'u8)
+ ((= nbytes 2) 'u16)
+ ((= nbytes 4) 'u32)
+ ;; Library error, not system error
+ (t (error "websocket-to-bytes: Unknown NBYTES: %S"
nbytes)))))
+ `((:val . ,val))))))
(defun websocket-get-opcode (s)
"Retrieve the opcode from first byte of string S."
@@ -268,14 +282,29 @@ approximately 537M long."
We start at position 0, and return a cons of the payload length and how
many bytes were consumed from the string."
(websocket-ensure-length s 1)
- (let* ((initial-val (logand 127 (aref s 0))))
- (cond ((= initial-val 127)
- (websocket-ensure-length s 9)
- (cons (websocket-get-bytes (substring s 1) 8) 9))
- ((= initial-val 126)
- (websocket-ensure-length s 3)
- (cons (websocket-get-bytes (substring s 1) 2) 3))
- (t (cons initial-val 1)))))
+ (websocket--if-when-compile (fboundp 'bindat-type)
+ (bindat-unpack
+ (bindat-type
+ (len1-raw u8)
+ (len1 unit (logand 127 len1-raw))
+ (len2len unit (pcase len1 (127 8) (126 2) (_ 0)))
+ (len2 uint (progn
+ (websocket-ensure-length s (1+ len2len))
+ (* 8 len2len)))
+ :unpack-val (cons (if (< len1 126) len1
+ (if (and (= len2len 8) (> (ash len2 -63) 0))
+ (signal 'websocket-unparseable-frame (list
"MSB must be 0 for 64-bit length"))
+ len2))
+ (1+ len2len)))
+ s)
+ (let* ((initial-val (logand 127 (aref s 0))))
+ (cond ((= initial-val 127)
+ (websocket-ensure-length s 9)
+ (cons (websocket-get-bytes (substring s 1) 8) 9))
+ ((= initial-val 126)
+ (websocket-ensure-length s 3)
+ (cons (websocket-get-bytes (substring s 1) 2) 3))
+ (t (cons initial-val 1))))))
(cl-defstruct websocket-frame opcode payload length completep)
@@ -330,9 +359,11 @@ We mask the frame or not, depending on SHOULD-MASK."
(when (and payloadp (>= (length payload) 126))
(append (websocket-to-bytes
(length payload)
- (cond ((< (length payload) 126) 1)
+ (cond ((< (length payload) 126)
+ 1) ;FIXME: 0? Impossible?
((< (length payload) 65536) 2)
- (t 8))) nil))
+ (t 8)))
+ nil))
(when (and payloadp should-mask)
(append mask-key nil))
(when payloadp
@@ -695,7 +726,7 @@ to the websocket protocol.
:on-close on-close
:on-error on-error
:protocols protocols
- :extensions (mapcar 'car extensions)
+ :extensions (mapcar #'car extensions)
:accept-string
(websocket-calculate-accept key))))
(unless conn (error "Could not establish the websocket connection to %s"
url))
@@ -744,11 +775,12 @@ to the websocket protocol.
(defun websocket-process-headers (url headers)
"On opening URL, process the HEADERS sent from the server."
- (when (string-match "Set-Cookie: \(.*\)\r\n" headers)
- ;; The url-current-object is assumed to be set by
- ;; url-cookie-handle-set-cookie.
- (let ((url-current-object (url-generic-parse-url url)))
- (url-cookie-handle-set-cookie (match-string 1 headers)))))
+ (when (string-match "Set-Cookie: \\(.*\\)\r\n" headers)
+ (let ((cookie (match-string 1 headers))
+ ;; The url-current-object is assumed to be set by
+ ;; url-cookie-handle-set-cookie.
+ (url-current-object (url-generic-parse-url url)))
+ (url-cookie-handle-set-cookie cookie))))
(defun websocket-outer-filter (websocket output)
"Filter the WEBSOCKET server's OUTPUT.
@@ -854,8 +886,8 @@ connection, which should be kept in order to pass to
:server t
:family 'ipv4
:noquery t
- :filter 'websocket-server-filter
- :log 'websocket-server-accept
+ :filter #'websocket-server-filter
+ :log #'websocket-server-accept
:filter-multibyte nil
:plist plist
:host (plist-get plist :host)
@@ -893,7 +925,7 @@ connection, which should be kept in order to pass to
:on-error (or (process-get server :on-error)
'websocket-default-error-handler)
:protocols (process-get server :protocol)
- :extensions (mapcar 'car (process-get server :extensions)))))
+ :extensions (mapcar #'car (process-get server :extensions)))))
(unless (member ws websocket-server-websockets)
(push ws websocket-server-websockets))
(process-put client :websocket ws)
@@ -939,7 +971,7 @@ All these parameters are defined as in `websocket-open'."
(car ext)
(when (cdr ext) "; ")
(when (cdr ext)
- (mapconcat 'identity (cdr ext) "; "))))
+ (mapconcat #'identity (cdr ext) "; "))))
extensions ", "))))
host-port
key
@@ -965,7 +997,8 @@ All these parameters are defined as in `websocket-open'."
(concat
(mapconcat
(lambda (protocol) (format "Sec-WebSocket-Protocol: %s"
- protocol)) protocols separator)
+ protocol))
+ protocols separator)
separator)))
(let ((extensions (websocket-intersect
client-extensions
@@ -974,7 +1007,8 @@ All these parameters are defined as in `websocket-open'."
(concat
(mapconcat
(lambda (extension) (format "Sec-Websocket-Extensions: %s"
- extension)) extensions separator)
+ extension))
+ extensions separator)
separator)))
separator)))
