Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add helper functions for websocket-get-opcode and

websocket-get-payload-len.  This is just the first version, and these
functions probably will need to be rewritten to work with a stream
that may not yet have all the data.
  • Loading branch information...
commit f4e1aa871bfe35983a989734804251d551785e59 1 parent 2a1518b
@ahyatt authored
Showing with 62 additions and 3 deletions.
  1. +22 −0 websocket-test.el
  2. +40 −3 websocket.el
View
22 websocket-test.el
@@ -94,6 +94,28 @@
;; 16-20 = 10110
(should (equal 22 (websocket-get-bits test-num 16 20)))))
+(defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
+ "'Hello' string example, taken from the RFC.")
+
+(ert-deftest websocket-get-opcode ()
+ (should (equal 'text (websocket-get-opcode websocket-test-hello))))
+
+(ert-deftest websocket-get-payload-len ()
+ (should (equal '(5 . 0)
+ (websocket-get-payload-len websocket-test-hello)))
+ (should (equal '(200 . 3)
+ (websocket-get-payload-len
+ (bindat-pack '((:len u32) (:val u16))
+ `((:len . ,(lsh 126 16))
+ (:val . 200))))))
+ ;; we don't want to hit up any limits even on strange emacs builds,
+ ;; so this test has a pretty small test value
+ (should (equal '(70000 . 9)
+ (websocket-get-payload-len
+ (bindat-pack '((:len u32) (:val vec 2 u32))
+ `((:len . ,(lsh 127 16))
+ (:val . [0 70000])))))))
+
(ert-run-tests-interactively 'websocket-genbytes-length)
(ert-run-tests-interactively 'websocket-filter-basic)
(ert-run-tests-interactively 'websocket-filter-inflight-packets)
View
43 websocket.el
@@ -24,6 +24,7 @@
;; This implements RFC 6455, which can be found at
;; http://tools.ietf.org/html/rfc6455.
+(require 'bindat)
(require 'url-parse)
(require 'calc)
(eval-when-compile (require 'cl))
@@ -74,8 +75,8 @@ This is based on the KEY from the Sec-WebSocket-Key header."
(base64-encode-string
(sha1 (concat key websocket-guid) nil nil t)))
-(defun websocket-get-bits (num start-bit end-bit)
- "Return the value of NUM between START-BIT and END-BIT.
+(defun websocket-get-bits (dword start-bit end-bit)
+ "Return the value of DWORD between START-BIT and END-BIT.
START-BIT must be less than END-BIT. The range is inclusive at
both ends. Although the ordering of bits is big-endian the bits
are numbed most significant first. That is, the most
@@ -83,11 +84,47 @@ significant, leftmost bit is 0."
(when (> start-bit end-bit)
(error
"In websocket-get-bits: Start bit must be less than end-bit."))
- (logand (lsh num (- (- 31 end-bit)))
+ (logand (lsh dword (- (- 31 end-bit)))
(loop for i from 0 upto
(- end-bit start-bit)
sum (expt 2 i))))
+(defun websocket-get-dword (s)
+ "From string S, retrieve the first dword."
+ (bindat-get-field (bindat-unpack '((:val dword)) s) :val))
+
+(defun websocket-get-opcode (s)
+ "Retrieve the opcode from the dword at the start of the frame
+given by string."
+ (let ((opcode (websocket-get-bits (websocket-get-dword s) 4 7)))
+ (cond ((= opcode 0) 'continuation)
+ ((= opcode 1) 'text)
+ ((= opcode 2) 'binary)
+ ((= opcode 8) 'close)
+ ((= opcode 9) 'ping)
+ ((= opcode 10) 'pong))))
+
+(defun websocket-get-payload-len (s)
+ "Parses out the payload length from the string.
+We start at position 0, and return a cons of the payload length and how
+many bytes were consumed from the string."
+ (let* ((dword (websocket-get-dword s))
+ (initial-val (websocket-get-bits dword 9 15)))
+ (cond ((< initial-val 126)
+ (cons initial-val 0))
+ ((= initial-val 126)
+ (cons
+ (bindat-get-field (bindat-unpack '((:val u16)) (substring s 4)) :val)
+ 3))
+ (t (let* ((32-bit-parts
+ (bindat-get-field (bindat-unpack '((:val vec 2 u32))
+ (substring s 4)) :val))
+ (cval (calc-eval "(2^32 * $ + $$)" nil
+ (aref 32-bit-parts 0) (aref 32-bit-parts 1))))
+ (when (calc-eval "$ > $$" 'pred cval most-positive-fixnum)
+ (error "Websocket sent a frame too large for emacs!"))
+ (cons (string-to-int cval) 9))))))
+
(defun websocket-open (url filter &optional close-callback)
"Open a websocket connection to URL.
Websocket packets are sent as the only argument to FILTER, and if
Please sign in to comment.
Something went wrong with that request. Please try again.