Merge pull request #84 from ahyatt/monnier-improvementsexternals/websocket

Cleanups of obsolete functions, stylistic improvements

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)))