X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/ca6579bf94d7c05584f97cc1bc2d7a8ae01a6906..f9b63e405daf25088fa663c3a1c65f66701b914a:/packages/websocket/websocket.el diff --git a/packages/websocket/websocket.el b/packages/websocket/websocket.el index 2390615e1..1e1baa369 100644 --- a/packages/websocket/websocket.el +++ b/packages/websocket/websocket.el @@ -5,7 +5,7 @@ ;; Author: Andrew Hyatt ;; Maintainer: Andrew Hyatt ;; Keywords: Communication, Websocket, Server -;; Version: 1.1 +;; Version: 1.4 ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -99,7 +99,7 @@ same for the protocols. accept-string (inflight-input nil)) -(defvar websocket-version "1.2" +(defvar websocket-version "1.4" "Version numbers of this version of websocket.el.") (defvar websocket-debug nil @@ -235,7 +235,11 @@ approximately 537M long." (if (= nbytes 8) (progn (let ((hi-32bits (lsh val -32)) - (low-32bits (logand #xffffffff val))) + ;; Test for systems that don't have > 32 bits, and + ;; for those systems just return the value. + (low-32bits (if (= 0 (expt 2 32)) + val + (logand #xffffffff val)))) (when (or (> hi-32bits 0) (> (lsh low-32bits -29) 0)) (signal 'websocket-frame-too-large val)) (bindat-pack `((:val vec 2 u32)) @@ -296,35 +300,40 @@ We mask the frame or not, depending on SHOULD-MASK." (let* ((opcode (websocket-frame-opcode frame)) (payload (websocket-frame-payload frame)) (fin (websocket-frame-completep frame)) - (payloadp (memq opcode '(continuation text binary))) + (payloadp (and payload + (memq opcode '(continuation ping pong text binary)))) (mask-key (when should-mask (websocket-genbytes 4)))) (apply 'unibyte-string - (append (list - (logior (cond ((eq opcode 'continuation) 0) - ((eq opcode 'text) 1) - ((eq opcode 'binary) 2) - ((eq opcode 'close) 8) - ((eq opcode 'ping) 9) - ((eq opcode '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)))))) + (let ((val (append (list + (logior (cond ((eq opcode 'continuation) 0) + ((eq opcode 'text) 1) + ((eq opcode 'binary) 2) + ((eq opcode 'close) 8) + ((eq opcode 'ping) 9) + ((eq opcode '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))))) + ;; We have to make sure the non-payload data is a full 32-bit frame + (if (= 1 (length val)) + (append val '(0)) val))))) (defun websocket-read-frame (s) "Read from string S a `websocket-frame' struct with the contents. @@ -334,7 +343,7 @@ the frame finishes. If the frame is not completed, return NIL." (websocket-ensure-length s 1) (let* ((opcode (websocket-get-opcode s)) (fin (logand 128 (websocket-get-bytes s 1))) - (payloadp (memq opcode '(continuation text binary))) + (payloadp (memq opcode '(continuation text binary ping pong))) (payload-len (when payloadp (websocket-get-payload-len (substring s 1)))) (maskp (and @@ -475,7 +484,10 @@ has connection termination." lex-ws lex-frame))) ((eq opcode 'ping) (lambda () (websocket-send lex-ws - (make-websocket-frame :opcode 'pong :completep t)))) + (make-websocket-frame + :opcode 'pong + :payload (websocket-frame-payload lex-frame) + :completep t)))) ((eq opcode 'close) (lambda () (delete-process (websocket-conn lex-ws)))) (t (lambda ())))))) @@ -506,10 +518,16 @@ has connection termination." (defun websocket-check (frame) "Check FRAME for correctness, returning true if correct." - (and (equal (not (memq (websocket-frame-opcode frame) - '(continuation text binary))) - (and (not (websocket-frame-payload frame)) - (websocket-frame-completep frame))))) + (or + ;; Text, binary, and continuation frames need payloads + (and (memq (websocket-frame-opcode frame) '(text binary continuation)) + (websocket-frame-payload frame)) + ;; Pings and pongs may optionally have them + (memq (websocket-frame-opcode frame) '(ping pong)) + ;; And close shouldn't have any payload, and should always be complete. + (and (eq (websocket-frame-opcode frame) 'close) + (not (websocket-frame-payload frame)) + (websocket-frame-completep frame)))) (defun websocket-send (websocket frame) "To the WEBSOCKET server, send the FRAME. @@ -556,9 +574,7 @@ connecting or open." (make-websocket-frame :opcode 'close :completep t)) (setf (websocket-ready-state websocket) 'closed)) - (let ((buf (process-buffer (websocket-conn websocket)))) - (delete-process (websocket-conn websocket)) - (kill-buffer buf))) + (delete-process (websocket-conn websocket))) (defun websocket-ensure-connected (websocket) "If the WEBSOCKET connection is closed, open it." @@ -650,7 +666,6 @@ describing the problem with the frame. (let* ((name (format "websocket to %s" url)) (url-struct (url-generic-parse-url url)) (key (websocket-genkey)) - (buf-name (format " *%s*" name)) (coding-system-for-read 'binary) (coding-system-for-write 'binary) (conn (if (member (url-type url-struct) '("ws" "wss")) @@ -659,13 +674,12 @@ describing the problem with the frame. (port (if (= 0 (url-port url-struct)) (if (eq type 'tls) 443 80) (url-port url-struct))) - (host (url-host url-struct)) - (buf (get-buffer-create buf-name))) + (host (url-host url-struct))) (if (eq type 'plain) - (make-network-process :name name :buffer buf :host host + (make-network-process :name name :buffer nil :host host :service port :nowait nil) (condition-case-unless-debug nil - (open-network-stream name buf host port :type type :nowait nil) + (open-network-stream name nil host port :type type :nowait nil) (wrong-number-of-arguments (signal 'websocket-wss-needs-emacs-24 "wss"))))) (signal 'websocket-unsupported-protocol (url-type url-struct)))) @@ -680,6 +694,7 @@ describing the problem with the frame. :extensions (mapcar 'car extensions) :accept-string (websocket-calculate-accept key)))) + (unless conn (error "Could not establish the websocket connection to %s" url)) (process-put conn :websocket websocket) (set-process-filter conn (lambda (process output) @@ -797,9 +812,10 @@ in the websocket client function `websocket-open'. Returns the connection, which should be kept in order to pass to `websocket-server-close'." (let* ((conn (make-network-process - :name (format "websocket server on port %d" port) + :name (format "websocket server on port %s" port) :server t :family 'ipv4 + :filter 'websocket-server-filter :log 'websocket-server-accept :filter-multibyte nil :plist plist @@ -840,10 +856,8 @@ connection, which should be kept in order to pass to :extensions (mapcar 'car (process-get server :extensions))))) (unless (member ws websocket-server-websockets) (push ws websocket-server-websockets)) - (set-process-coding-system client 'unix 'unix) (process-put client :websocket ws) - (set-process-filter client 'websocket-server-filter) - (set-process-coding-system client 'binary) + (set-process-coding-system client 'binary 'binary) (set-process-sentinel client (lambda (process change) (let ((websocket (process-get process :websocket))) @@ -860,7 +874,6 @@ These are defined as in `websocket-open'." "Upgrade: websocket\r\n" "Connection: Upgrade\r\n" "Sec-WebSocket-Key: %s\r\n" - "Origin: %s\r\n" "Sec-WebSocket-Version: 13\r\n" (when protocol (concat @@ -880,7 +893,6 @@ These are defined as in `websocket-open'." "\r\n") (url-host (url-generic-parse-url url)) key - system-name protocol)) (defun websocket-get-server-response (websocket client-protocols client-extensions)