Browse files

Implement proper behavior on closing of server.

Now all client connections are closed when websocket-server-close is called.
  • Loading branch information...
1 parent 23b132e commit 5c2b2351e6d1b9be40b3ac232bcb20fac5eadf69 @ahyatt committed Aug 16, 2012
Showing with 71 additions and 13 deletions.
  1. +5 −2 websocket-functional-test.el
  2. +34 −3 websocket-test.el
  3. +32 −8 websocket.el
@@ -91,14 +91,16 @@
(message "Testing with emacs websocket server.")
(message "If this does not pass, make sure your firewall allows the connection.")
+(setq wstest-closed nil)
(setq server-conn (websocket-server
:on-message (lambda (ws frame)
(message "Server received text!")
(websocket-send-text ws
(websocket-frame-payload frame)))
- :on-open (lambda (websocket) "Client connection opened!")))
+ :on-open (lambda (websocket) "Client connection opened!")
+ :on-close (lambda (websocket)
+ (setq wstest-closed t))))
(setq wstest-msgs nil
@@ -113,4 +115,5 @@
(sleep-for 0.3)
(assert (equal (car wstest-msgs) "Hi to self!"))
(websocket-server-close server-conn)
+(assert wstest-closed)
(message "\nAll tests passed!\n")
@@ -323,18 +323,21 @@
:completep t))))))))
(ert-deftest websocket-close ()
- (let ((sent-frames))
+ (let ((sent-frames)
+ (processes-deleted))
(flet ((websocket-send (websocket frame) (push frame sent-frames))
(websocket-openp (websocket) t)
(kill-buffer (buffer))
- (process-buffer (conn)))
+ (delete-process (proc))
+ (process-buffer (conn) (add-to-list 'processes-deleted conn)))
(websocket-close (websocket-inner-create
:conn "fake-conn"
:url t
:accept-string t))
(should (equal sent-frames (list
(make-websocket-frame :opcode 'close
- :completep t)))))))
+ :completep t))))
+ (should (equal processes-deleted '("fake-conn"))))))
(ert-deftest websocket-outer-filter ()
(let* ((fake-ws (websocket-inner-create
@@ -539,3 +542,31 @@
(plist-get header-info :protocols)
(plist-get header-info :extension)))))))
+(ert-deftest websocket-server-close ()
+ (let ((websocket-server-websockets
+ (list (websocket-inner-create :conn 'conn-a :url t :accept-string t
+ :server-conn 'a
+ :ready-state 'open)
+ (websocket-inner-create :conn 'conn-b :url t :accept-string t
+ :server-conn 'b
+ :ready-state 'open)
+ (websocket-inner-create :conn 'conn-c :url t :accept-string t
+ :server-conn 'b
+ :ready-state 'closed)))
+ (deleted-processes)
+ (closed-websockets))
+ (flet ((delete-process (conn) (add-to-list 'deleted-processes conn))
+ (websocket-close (ws)
+ ;; we always remove on closing in the
+ ;; actual code.
+ (setq websocket-server-websockets
+ (remove ws websocket-server-websockets))
+ (should-not (eq (websocket-ready-state ws) 'closed))
+ (add-to-list 'closed-websockets ws)))
+ (websocket-server-close 'b))
+ (should (equal deleted-processes '(b)))
+ (should (eq 1 (length closed-websockets)))
+ (should (eq 'conn-b (websocket-conn (car closed-websockets))))
+ (should (eq 1 (length websocket-server-websockets)))
+ (should (eq 'conn-a (websocket-conn (car websocket-server-websockets))))))
@@ -97,6 +97,8 @@ same for the protocols.
(protocols nil :read-only t)
(extensions nil :read-only t)
(conn (assert nil) :read-only t)
+ ;; Only populated for servers, this is the server connection.
+ server-conn
(inflight-input nil))
@@ -533,9 +535,9 @@ connecting or open."
(make-websocket-frame :opcode 'close
:completep t))
(setf (websocket-ready-state websocket) 'closed))
- ;; Do we want to kill this? It may result in on-closed not being
- ;; called.
- (kill-buffer (process-buffer (websocket-conn websocket))))
+ (let ((buf (process-buffer (websocket-conn websocket))))
+ (delete-process (websocket-conn websocket))
+ (kill-buffer buf)))
(defun websocket-ensure-connected (websocket)
"If the WEBSOCKET connection is closed, open it."
@@ -757,6 +759,9 @@ of populating the list of server extensions to WEBSOCKET."
;; Websocket server ;;
+(defvar websocket-server-websockets nil
+ "A list of current websockets live on any server.")
(defun* websocket-server (port &rest plist)
"Open a websocket server on PORT.
This also takes a plist of callbacks: `:on-open', `:on-message',
@@ -775,28 +780,47 @@ connection, which should be kept in order to pass to
(defun websocket-server-close (conn)
- "Closes the websocket, as well as all open websockets."
- ;; TODO(ahyatt) Delete all open websockets (we have to start keeping
- ;; track first)
+ "Closes the websocket, as well as all open websockets for this server."
+ (let ((to-delete))
+ (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)
+ (websocket-close ws))))
+ (dolist (ws to-delete)
+ (setq websocket-server-websockets (remove ws websocket-server-websockets))))
(delete-process conn))
(defun websocket-server-accept (server client message)
"Accept a new websocket connection from a client."
- (message "Connected from %S: %s" client message)
(let ((ws (websocket-inner-create
+ :server-conn server
:conn client
:url client
: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
+ (or (process-get server :on-close) 'identity)))
+ (lambda (ws)
+ (setq websocket-server-websockets
+ (remove ws websocket-server-websockets))
+ (funcall user-method ws)))
:on-error (or (process-get server :on-error)
:protocols (process-get server :protocol)
:extensions (mapcar 'car (process-get server :extensions)))))
+ (add-to-list 'websocket-server-websockets ws)
(process-put client :websocket ws)
(set-process-filter client 'websocket-server-filter)
;; set-process-filter-multibyte is obsolete, but make-network-process's
;; :filter-multibyte arg does not seem to do anything.
- (set-process-filter-multibyte client nil)))
+ (set-process-filter-multibyte client nil)
+ (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))
+ (websocket-try-callback 'websocket-on-close 'on-close websocket)))))))
(defun websocket-create-headers (url key protocol extensions)
"Create connections headers for the given URL, KEY, PROTOCOL and EXTENSIONS.

0 comments on commit 5c2b235

Please sign in to comment.