;;; websocket.el --- Emacs WebSocket client and server
-;; Copyright (c) 2010 Andrew Hyatt
-;;
+;; Copyright (c) 2013 Free Software Foundation, Inc.
+
;; 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.1
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of the
+;; published by the Free Software Foundation; either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-;; 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This implements RFC 6455, which can be found at
;; http://tools.ietf.org/html/rfc6455.
;;
-;; This library contains code to connect emacs as a client to a
-;; websocket server, and for emacs to act as a server for websocket
+;; This library contains code to connect Emacs as a client to a
+;; websocket server, and for Emacs to act as a server for websocket
;; connections.
;;
;; Websockets clients are created by calling `websocket-open', which
accept-string
(inflight-input nil))
-(defvar websocket-version "1.01"
+(defvar websocket-version "1.2"
"Version numbers of this version of websocket.el.")
(defvar websocket-debug nil
"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
exited by quitting instead of continuing, so it's best to have this set
-to `nil' unless it is especially needed.")
+to nil unless it is especially needed.")
(defmacro websocket-document-function (function docstring)
"Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc."
"Frame value found too large to parse!")))
;; n is not 8
(bindat-get-field
- (condition-case err
+ (condition-case _
(bindat-unpack
`((:val
,(cond ((= n 1) 'u8)
(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)))
- (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)
(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) 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 (if websocket-mask-frames
- (websocket-mask mask-key payload)
+ (append (if should-mask (websocket-mask mask-key payload)
payload)
nil))))))
:completep (> fin 0)))))
(defun websocket-format-error (err)
- "Format an error message like command level does. ERR should be
-a cons of error symbol and error data."
+ "Format an error message like command level does.
+ERR should be a cons of error symbol and error data."
;; Formatting code adapted from `edebug-report-error'
(concat (or (get (car err) 'error-message)
(mapconcat #'prin1-to-string
(cdr err) ", ")))))
-(defun websocket-default-error-handler (websocket type err)
+(defun websocket-default-error-handler (_websocket type err)
"The default error handler used to handle errors in callbacks."
(display-warning 'websocket
(format "in callback `%S': %s"
"The frame being sent is too large for this emacs to handle")
(defun websocket-intersect (a b)
- "Simple list intersection, should function like common lisp's `intersection'."
+ "Simple list intersection, should function like Common Lisp's `intersection'."
(let ((result))
(dolist (elem a (nreverse result))
(when (member elem b)
- (add-to-list 'result elem)))))
+ (push elem result)))))
(defun websocket-get-debug-buffer-create (websocket)
"Get or create the buffer corresponding to WEBSOCKET."
also with `websocket-error' condition. The data in the signal is
also the frame.
-The frame may be too large for this buid of emacs, in which case
+The frame may be too large for this buid of Emacs, in which case
`websocket-frame-too-large' is returned, with the data of the
size of the frame which was too large to process. This also has
the `websocket-error' condition."
(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-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
;;;;;;;;;;;;;;;;;;;;;;
(defun* websocket-open (url &key protocols extensions (on-open 'identity)
- (on-message (lambda (w f))) (on-close 'identity)
+ (on-message (lambda (_w _f))) (on-close 'identity)
(on-error 'websocket-default-error-handler))
"Open a websocket connection to URL, returning the `websocket' struct.
The PROTOCOL argument is optional, and setting it will declare to
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
connection is invalid, the connection will be closed."
(websocket-debug websocket "Received: %s" output)
(let ((start-point)
- (end-point 0)
(text (concat (websocket-inflight-input websocket) output))
(header-end-pos))
(setf (websocket-inflight-input websocket) nil)
(dolist (protocol (websocket-protocols websocket))
(websocket-debug websocket "Checking for protocol match: %s"
protocol)
- (let ((protocols))
- (if (string-match
- (format "\r\nSec-Websocket-Protocol: %s\r\n"
- protocol) output)
- (add-to-list 'protocols protocol)
- (signal 'websocket-invalid-header
- "Incorrect or missing protocol returned by the server."))
+ (let ((protocols
+ (if (string-match (format "\r\nSec-Websocket-Protocol: %s\r\n"
+ protocol)
+ output)
+ (list protocol)
+ (signal 'websocket-invalid-header
+ "Incorrect or missing protocol returned by the server."))))
(setf (websocket-negotiated-protocols websocket) protocols))))
(let* ((extensions (websocket-parse-repeated-field
output
"Sec-WebSocket-Extensions"))
(extra-extensions))
(dolist (ext extensions)
- (when (not (member
- (first (split-string ext "; ?"))
- (websocket-extensions websocket)))
- (add-to-list 'extra-extensions (first (split-string ext "; ?")))))
+ (let ((x (first (split-string ext "; ?"))))
+ (unless (or (member x (websocket-extensions websocket))
+ (member x extra-extensions))
+ (push x extra-extensions))))
(when extra-extensions
(signal 'websocket-invalid-header
(format "Non-requested extensions returned by server: %S"
(dolist (ws websocket-server-websockets)
(when (eq (websocket-server-conn ws) conn)
(if (eq (websocket-ready-state ws) 'closed)
- (add-to-list 'to-delete ws)
+ (unless (member ws to-delete)
+ (push ws to-delete))
(websocket-close ws))))
(dolist (ws to-delete)
(setq websocket-server-websockets (remove ws websocket-server-websockets))))
: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-message (or (process-get server :on-message) (lambda (_ws _frame)))
:on-close (lexical-let ((user-method
(or (process-get server :on-close) 'identity)))
(lambda (ws)
'websocket-default-error-handler)
:protocols (process-get server :protocol)
:extensions (mapcar 'car (process-get server :extensions)))))
- (add-to-list 'websocket-server-websockets ws)
+ (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)
(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)