diff options
Diffstat (limited to 'websocket.el')
| -rw-r--r-- | websocket.el | 120 |
1 files changed, 77 insertions, 43 deletions
diff --git a/websocket.el b/websocket.el index afa17c4..b572b19 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))) |