]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/websocket/websocket.el
Add *.info and dir to debbugs
[gnu-emacs-elpa] / packages / websocket / websocket.el
index 834efd1adc409b6c743332e5a05b96500054025a..969e70b26be495fbada9986a415e4b66b0c496ca 100644 (file)
@@ -5,7 +5,7 @@
 ;; Author: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Keywords: Communication, Websocket, Server
 ;; Author: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Keywords: Communication, Websocket, Server
-;; Version: 1.01
+;; Version: 1.3
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
 ;;
 ;; 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))
 
   accept-string
   (inflight-input nil))
 
-(defvar websocket-version "1.01"
+(defvar websocket-version "1.3"
   "Version numbers of this version of websocket.el.")
 
 (defvar websocket-debug nil
   "Version numbers of this version of websocket.el.")
 
 (defvar websocket-debug nil
@@ -111,11 +111,6 @@ URL of the connection.")
   "The websocket GUID as defined in RFC 6455.
 Do not change unless the RFC changes.")
 
   "The websocket GUID as defined in RFC 6455.
 Do not change unless the RFC changes.")
 
-(defvar websocket-mask-frames t
-  "If true, we mask frames as defined in the spec.
-This is recommended to be true, and some servers will refuse to
-communicate with unmasked clients.")
-
 (defvar websocket-callback-debug-on-error nil
   "If true, when an error happens in a client callback, invoke the debugger.
 Having this on can cause issues with missing frames if the debugger is
 (defvar websocket-callback-debug-on-error nil
   "If true, when an error happens in a client callback, invoke the debugger.
 Having this on can cause issues with missing frames if the debugger is
@@ -295,13 +290,14 @@ Otherwise we throw the error `websocket-incomplete-frame'."
   (when (< (length s) n)
     (throw 'websocket-incomplete-frame nil)))
 
   (when (< (length s) n)
     (throw 'websocket-incomplete-frame nil)))
 
-(defun websocket-encode-frame (frame)
-  "Encode the FRAME struct to the binary representation."
+(defun websocket-encode-frame (frame should-mask)
+  "Encode the FRAME struct to the binary representation.
+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)))
   (let* ((opcode (websocket-frame-opcode frame))
          (payload (websocket-frame-payload frame))
          (fin (websocket-frame-completep frame))
          (payloadp (memq opcode '(continuation text binary)))
-         (mask-key (when websocket-mask-frames  (websocket-genbytes 4))))
+         (mask-key (when should-mask (websocket-genbytes 4))))
     (apply 'unibyte-string
            (append (list
                     (logior (cond ((eq opcode 'continuation) 0)
     (apply 'unibyte-string
            (append (list
                     (logior (cond ((eq opcode 'continuation) 0)
@@ -314,7 +310,7 @@ Otherwise we throw the error `websocket-incomplete-frame'."
                    (when payloadp
                      (list
                       (logior
                    (when payloadp
                      (list
                       (logior
-                       (if websocket-mask-frames 128 0)
+                       (if should-mask 128 0)
                        (cond ((< (length payload) 126) (length payload))
                              ((< (length payload) 65536) 126)
                              (t 127)))))
                        (cond ((< (length payload) 126) (length payload))
                              ((< (length payload) 65536) 126)
                              (t 127)))))
@@ -323,11 +319,10 @@ Otherwise we throw the error `websocket-incomplete-frame'."
                                           (cond ((< (length payload) 126) 1)
                                                 ((< (length payload) 65536) 2)
                                                 (t 8))) nil))
                                           (cond ((< (length payload) 126) 1)
                                                 ((< (length payload) 65536) 2)
                                                 (t 8))) nil))
-                   (when (and payloadp websocket-mask-frames)
+                   (when (and payloadp should-mask)
                      (append mask-key nil))
                    (when payloadp
                      (append mask-key nil))
                    (when payloadp
-                     (append (if websocket-mask-frames
-                                 (websocket-mask mask-key payload)
+                     (append (if should-mask (websocket-mask mask-key payload)
                                payload)
                              nil))))))
 
                                payload)
                              nil))))))
 
@@ -542,7 +537,8 @@ the `websocket-error' condition."
   (unless (websocket-openp websocket)
     (signal 'websocket-closed frame))
   (process-send-string (websocket-conn websocket)
   (unless (websocket-openp websocket)
     (signal 'websocket-closed frame))
   (process-send-string (websocket-conn websocket)
-                       (websocket-encode-frame frame)))
+                       ;; We mask only when we're a client, following the spec.
+                       (websocket-encode-frame frame (not (websocket-server-p websocket)))))
 
 (defun websocket-openp (websocket)
   "Check WEBSOCKET and return non-nil if it is open, and either
 
 (defun websocket-openp (websocket)
   "Check WEBSOCKET and return non-nil if it is open, and either
@@ -554,14 +550,13 @@ connecting or open."
 (defun websocket-close (websocket)
   "Close WEBSOCKET and erase all the old websocket data."
   (websocket-debug websocket "Closing websocket")
 (defun websocket-close (websocket)
   "Close WEBSOCKET and erase all the old websocket data."
   (websocket-debug websocket "Closing websocket")
+  (websocket-try-callback 'websocket-on-close 'on-close websocket)
   (when (websocket-openp websocket)
     (websocket-send websocket
                     (make-websocket-frame :opcode 'close
                                           :completep t))
     (setf (websocket-ready-state websocket) 'closed))
   (when (websocket-openp websocket)
     (websocket-send websocket
                     (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."
 
 (defun websocket-ensure-connected (websocket)
   "If the WEBSOCKET connection is closed, open it."
@@ -653,7 +648,6 @@ describing the problem with the frame.
   (let* ((name (format "websocket to %s" url))
          (url-struct (url-generic-parse-url url))
          (key (websocket-genkey))
   (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"))
          (coding-system-for-read 'binary)
          (coding-system-for-write 'binary)
          (conn (if (member (url-type url-struct) '("ws" "wss"))
@@ -662,13 +656,12 @@ describing the problem with the frame.
                           (port (if (= 0 (url-port url-struct))
                                     (if (eq type 'tls) 443 80)
                                   (url-port url-struct)))
                           (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)
                        (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
                                                  :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))))
                            (wrong-number-of-arguments
                             (signal 'websocket-wss-needs-emacs-24 "wss")))))
                  (signal 'websocket-unsupported-protocol (url-type url-struct))))
@@ -683,6 +676,7 @@ describing the problem with the frame.
                      :extensions (mapcar 'car extensions)
                      :accept-string
                      (websocket-calculate-accept key))))
                      :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)
     (process-put conn :websocket websocket)
     (set-process-filter conn
                         (lambda (process output)
@@ -692,9 +686,10 @@ describing the problem with the frame.
      conn
      (lambda (process change)
        (let ((websocket (process-get process :websocket)))
      conn
      (lambda (process change)
        (let ((websocket (process-get process :websocket)))
-         (websocket-debug websocket
-                          "State change to %s" change)
-         (unless (eq 'closed (websocket-ready-state websocket))
+         (websocket-debug websocket "State change to %s" change)
+         (when (and
+                (member (process-status process) '(closed failed exit signal))
+                (not (eq 'closed (websocket-ready-state websocket))))
            (websocket-try-callback 'websocket-on-close 'on-close websocket)))))
     (set-process-query-on-exit-flag conn nil)
     (process-send-string conn
            (websocket-try-callback 'websocket-on-close 'on-close websocket)))))
     (set-process-query-on-exit-flag conn nil)
     (process-send-string conn
@@ -799,9 +794,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
 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
                 :server t
                 :family 'ipv4
+                :filter 'websocket-server-filter
                 :log 'websocket-server-accept
                 :filter-multibyte nil
                 :plist plist
                 :log 'websocket-server-accept
                 :filter-multibyte nil
                 :plist plist
@@ -827,6 +823,7 @@ connection, which should be kept in order to pass to
              :server-conn server
              :conn client
              :url client
              :server-conn server
              :conn client
              :url client
+             :server-p t
              :on-open (or (process-get server :on-open) 'identity)
              :on-message (or (process-get server :on-message) (lambda (_ws _frame)))
              :on-close (lexical-let ((user-method
              :on-open (or (process-get server :on-open) 'identity)
              :on-message (or (process-get server :on-message) (lambda (_ws _frame)))
              :on-close (lexical-let ((user-method
@@ -841,15 +838,15 @@ 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))
              :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)
     (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)))
          (websocket-debug websocket "State change to %s" change)
     (set-process-sentinel client
      (lambda (process change)
        (let ((websocket (process-get process :websocket)))
          (websocket-debug websocket "State change to %s" change)
-         (unless (eq 'closed (websocket-ready-state websocket))
+         (when (and
+                (member (process-status process) '(closed failed exit signal))
+                (not (eq 'closed (websocket-ready-state websocket))))
            (websocket-try-callback 'websocket-on-close 'on-close websocket)))))))
 
 (defun websocket-create-headers (url key protocol extensions)
            (websocket-try-callback 'websocket-on-close 'on-close websocket)))))))
 
 (defun websocket-create-headers (url key protocol extensions)
@@ -859,7 +856,6 @@ These are defined as in `websocket-open'."
                   "Upgrade: websocket\r\n"
                   "Connection: Upgrade\r\n"
                   "Sec-WebSocket-Key: %s\r\n"
                   "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
                   "Sec-WebSocket-Version: 13\r\n"
                   (when protocol
                     (concat
@@ -879,7 +875,6 @@ These are defined as in `websocket-open'."
                   "\r\n")
           (url-host (url-generic-parse-url url))
           key
                   "\r\n")
           (url-host (url-generic-parse-url url))
           key
-          system-name
           protocol))
 
 (defun websocket-get-server-response (websocket client-protocols client-extensions)
           protocol))
 
 (defun websocket-get-server-response (websocket client-protocols client-extensions)