[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[ELPA-diffs] elpa r429: Add websocket git revno bc5c2a2ee2b993a18e8e23ed

From: Stefan Monnier
Subject: [ELPA-diffs] elpa r429: Add websocket git revno bc5c2a2ee2b993a18e8e23ed725829d403508753.
Date: Thu, 01 Aug 2013 18:08:27 +0000
User-agent: Bazaar (2.6b2)

revno: 429
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: elpa
timestamp: Thu 2013-08-01 14:08:23 -0400
  Add websocket git revno bc5c2a2ee2b993a18e8e23ed725829d403508753.
  packages/websocket/            websocket-20130801180751-nzyk3vosqzza6c10-1
  packages/websocket/COPYING     copying-20130801180751-nzyk3vosqzza6c10-2
  packages/websocket/README.org  readme.org-20130801180751-nzyk3vosqzza6c10-3
  packages/websocket/websocket.el websocket.el-20130801180751-nzyk3vosqzza6c10-7
=== added directory 'packages/websocket'
=== added file 'packages/websocket/COPYING'
--- a/packages/websocket/COPYING        1970-01-01 00:00:00 +0000
+++ b/packages/websocket/COPYING        2013-08-01 18:08:23 +0000
@@ -0,0 +1,339 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 2, June 1991
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+                            Preamble
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.)  You can apply it to
+your programs, too.
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+  The precise terms and conditions for copying, distribution and
+modification follow.
+                    GNU GENERAL PUBLIC LICENSE
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+                            NO WARRANTY
+                     END OF TERMS AND CONDITIONS
+            How to Apply These Terms to Your New Programs
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+    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 License, or
+    (at your option) any later version.
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    GNU 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.
+Also add information on how to contact you by electronic and paper mail.
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.
\ No newline at end of file

=== added file 'packages/websocket/README.org'
--- a/packages/websocket/README.org     1970-01-01 00:00:00 +0000
+++ b/packages/websocket/README.org     2013-08-01 18:08:23 +0000
@@ -0,0 +1,31 @@
+* Description
+This is a elisp library for websocket clients to talk to websocket
+servers, and for websocket servers to accept connections from
+websocket clients. This library is designed to be used by other
+library writers, to write apps that use websockets, and is not useful
+by itself.
+An example of how to use the library is in the
+This library is compatible with emacs 23 and 24, although only emacs
+24 support secure websockets.
+* Version release checklist
+Each version that is released should be checked with this checklist:
+- [ ] All ert test passing
+- [ ] Functional test passing on emacs 23 and 24
+- [ ] websocket.el byte compiling cleanly.
+* Existing clients:
+- [[https://github.com/tkf/emacs-ipython-notebook][Emacs IPython Notebook]]
+- [[https://github.com/syohex/emacs-realtime-markdown-viewer][Emacs Realtime 
Markdown Viewer]]
+- [[https://github.com/jscheid/kite][Kite]]
+If you are using this module for your own emacs package, please let me
+know by editing this file, adding your project, and sending a pull
+request to this repository.

=== added file 'packages/websocket/testserver.py'
--- a/packages/websocket/testserver.py  1970-01-01 00:00:00 +0000
+++ b/packages/websocket/testserver.py  2013-08-01 18:08:23 +0000
@@ -0,0 +1,34 @@
+import logging
+import tornado
+import tornado.web
+from tornado import httpserver
+from tornado import ioloop
+from tornado import websocket
+class EchoWebSocket(websocket.WebSocketHandler):
+    def open(self):
+        logging.info("OPEN")
+    def on_message(self, message):
+        logging.info(u"ON_MESSAGE: {0}".format(message))
+        self.write_message(u"You said: {0}".format(message))
+    def on_close(self):
+        logging.info("ON_CLOSE")
+    def allow_draft76(self):
+        return False
+if __name__ == "__main__":
+    import tornado.options
+    tornado.options.parse_command_line()
+    application = tornado.web.Application([
+        (r"/", EchoWebSocket),
+    ])
+    server = httpserver.HTTPServer(application)
+    server.listen(9999)
+    logging.info("STARTED: Server start listening")
+    ioloop.IOLoop.instance().start()

=== added file 'packages/websocket/websocket-functional-test.el'
--- a/packages/websocket/websocket-functional-test.el   1970-01-01 00:00:00 
+++ b/packages/websocket/websocket-functional-test.el   2013-08-01 18:08:23 
@@ -0,0 +1,133 @@
+;; Simple functional testing
+;; Usage: emacs -batch -Q -L . -l websocket-functional-test.el
+;; Note: this functional tests requires that you have python with the
+;; Tornado web server.  See http://www.tornadoweb.org/en/stable/ for
+;; information on aquiring.
+(require 'tls)   ;; tests a particular bug we had on emacs 23
+(setq debug-on-error t)
+(require 'websocket)
+(eval-when-compile (require 'cl))
+;; Local server test ;;
+(message "Testing with local server")
+(setq websocket-debug t)
+(defvar wstest-server-buffer (get-buffer-create "*wstest-server*"))
+(defvar wstest-server-name "wstest-server")
+(defvar wstest-server-proc
+  (start-process wstest-server-name wstest-server-buffer
+                 "python" "testserver.py" "--log_to_stderr" "--logging=debug"))
+(sleep-for 1)
+(defvar wstest-msgs nil)
+(defvar wstest-closed nil)
+(message "Opening the websocket")
+(defvar wstest-ws
+  (websocket-open
+   "ws://"
+   :on-message (lambda (websocket frame)
+                 (push (websocket-frame-payload frame) wstest-msgs)
+                 (message "ws frame: %S" (websocket-frame-payload frame))
+                 (error "Test error (expected)"))
+   :on-close (lambda (websocket) (setq wstest-closed t))))
+(defun wstest-pop-to-debug ()
+  "Open websocket log buffer. Not used in testing. Just for debugging."
+  (interactive)
+  (pop-to-buffer (websocket-get-debug-buffer-create wstest-ws)))
+(sleep-for 0.1)
+(assert (websocket-openp wstest-ws))
+(assert (null wstest-msgs))
+(websocket-send-text wstest-ws "Hi!")
+(sleep-for 0.1)
+(assert (equal (car wstest-msgs) "You said: Hi!"))
+(setf (websocket-on-error wstest-ws) (lambda (ws type err)))
+(websocket-send-text wstest-ws "Hi after error!")
+(sleep-for 0.1)
+(assert (equal (car wstest-msgs) "You said: Hi after error!"))
+(websocket-close wstest-ws)
+(assert (null (websocket-openp wstest-ws)))
+(stop-process wstest-server-proc)
+(kill-process wstest-server-proc)
+;; Make sure the processes are closed.  This happens asynchronously,
+;; so let's wait for it.
+(sleep-for 1)
+(assert (null (process-list)) t)
+;; Remote server test, with wss ;;
+(when (>= (string-to-int (substring emacs-version 0 2)) 24)
+  (message "Testing with wss://echo.websocket.org")
+  (setq wstest-ws
+        (websocket-open
+         "wss://echo.websocket.org"
+         :on-open (lambda (websocket)
+                    (message "Websocket opened"))
+         :on-message (lambda (websocket frame)
+                       (push (websocket-frame-payload frame) wstest-msgs)
+                       (message "ws frame: %S" (websocket-frame-payload 
+         :on-close (lambda (websocket)
+                     (message "Websocket closed")
+                     (setq wstest-closed t)))
+        wstest-msgs nil)
+  (sleep-for 0.3)
+  (assert (websocket-openp wstest-ws))
+  (assert (null wstest-msgs))
+  (websocket-send-text wstest-ws "Hi!")
+  (sleep-for 0.3)
+  (assert (equal (car wstest-msgs) "Hi!"))
+  (websocket-close wstest-ws))
+;; Local client and server ;;
+(message "Testing with emacs websocket server.")
+(message "If this does not pass, make sure your firewall allows the 
+(setq wstest-closed nil)
+(setq server-conn (websocket-server
+                   9998
+                   :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-close (lambda (websocket)
+                               (setq wstest-closed t))))
+(setq wstest-msgs nil
+      wstest-ws
+      (websocket-open
+       "ws://localhost:9998"
+       :on-message (lambda (websocket frame)
+                     (push (websocket-frame-payload frame) wstest-msgs)
+                     (message "ws frame: %S" (websocket-frame-payload 
+(assert (websocket-openp wstest-ws))
+(websocket-send-text wstest-ws "Hi to self!")
+(sleep-for 0.3)
+(assert (equal (car wstest-msgs) "Hi to self!"))
+(websocket-server-close server-conn)
+(assert wstest-closed)
+(websocket-close wstest-ws)
+(sleep-for 1)
+(assert (null (process-list)) t)
+(message "\nAll tests passed!\n")

=== added file 'packages/websocket/websocket-test.el'
--- a/packages/websocket/websocket-test.el      1970-01-01 00:00:00 +0000
+++ b/packages/websocket/websocket-test.el      2013-08-01 18:08:23 +0000
@@ -0,0 +1,596 @@
+;; websocket-test.el --- Unit tests for the websocket layer
+;; Copyright (c) 2010 Andrew Hyatt
+;; Author: Andrew Hyatt <ahyatt at gmail dot com>
+;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
+;; 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
+;; License, or (at your option) any later version.
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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.
+;;; Commentary:
+;; This defines and runs ert unit tests.  You can download ert from:
+;; http://github.com/ohler/ert, it also comes with Emacs 24 and above.
+(require 'ert)
+(require 'websocket)
+(eval-when-compile (require 'cl))
+(ert-deftest websocket-genbytes-length ()
+  (loop repeat 100
+        do (should (= (string-bytes (websocket-genbytes 16)) 16))))
+(ert-deftest websocket-calculate-accept ()
+  ;; This example comes straight from RFC 6455
+  (should
+   (equal "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
+          (websocket-calculate-accept "dGhlIHNhbXBsZSBub25jZQ=="))))
+(defconst websocket-test-hello "\x81\x05\x48\x65\x6c\x6c\x6f"
+  "'Hello' string example, taken from the RFC.")
+(defconst websocket-test-masked-hello
+  "\x81\x85\x37\xfa\x21\x3d\x7f\x9f\x4d\x51\x58"
+  "'Hello' masked string example, taken from the RFC.")
+(ert-deftest websocket-get-bytes ()
+  (should (equal #x5 (websocket-get-bytes "\x5" 1)))
+  (should (equal #x101 (websocket-get-bytes "\x1\x1" 2)))
+  (should (equal #xffffff
+                 (websocket-get-bytes "\x0\x0\x0\x0\x0\xFF\xFF\xFF" 8)))
+  (should-error (websocket-get-bytes "\x0\x0\x0\x1\x0\x0\x0\x1" 8)
+                :type 'websocket-unparseable-frame)
+  (should-error (websocket-get-bytes "\x0\x0\x0" 3))
+  (should-error (websocket-get-bytes "\x0" 2) :type 
+(ert-deftest websocket-get-opcode ()
+  (should (equal 'text (websocket-get-opcode websocket-test-hello))))
+(ert-deftest websocket-get-payload-len ()
+  (should (equal '(5 . 1)
+                 (websocket-get-payload-len
+                  (substring websocket-test-hello 1))))
+  (should (equal '(200 . 3)
+                 (websocket-get-payload-len
+                  (bindat-pack '((:len u8) (:val u16))
+                               `((:len . 126)
+                                 (: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 u8) (:val vec 2 u32))
+                               `((:len . 127)
+                                 (:val . [0 70000])))))))
+(ert-deftest websocket-read-frame ()
+  (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
+                                       :length (length websocket-test-hello)
+                                       :completep t)
+                 (websocket-read-frame websocket-test-hello)))
+  (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
+                                       :length (length websocket-test-hello)
+                                       :completep t)
+                 (websocket-read-frame (concat websocket-test-hello
+                                               "should-not-be-read"))))
+  (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
+                                       :length (length 
+                                       :completep t)
+                 (websocket-read-frame websocket-test-masked-hello)))
+  (should (equal (make-websocket-frame :opcode 'text :payload "Hello"
+                                       :length (length websocket-test-hello)
+                                       :completep nil)
+                 (websocket-read-frame
+                  (concat (unibyte-string
+                           (logand (string-to-char
+                                    (substring websocket-test-hello 0 1))
+                                   127))
+                          (substring websocket-test-hello 1)))))
+  (dotimes (i (- (length websocket-test-hello) 1))
+    (should-not (websocket-read-frame
+                 (substring websocket-test-hello 0
+                            (- (length websocket-test-hello) (+ i 1))))))
+  (dotimes (i (- (length websocket-test-masked-hello) 1))
+    (should-not (websocket-read-frame
+                 (substring websocket-test-masked-hello 0
+                            (- (length websocket-test-masked-hello) (+ i 
+(defun websocket-test-header-with-lines (&rest lines)
+  (mapconcat 'identity (append lines '("\r\n")) "\r\n"))
+(ert-deftest websocket-verify-response-code ()
+  (should (websocket-verify-response-code "HTTP/1.1 101"))
+  (should
+   (eq 400 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 400")
+                          :type 'websocket-received-error-http-response))))
+  (should
+   (eq 200 (cdr (should-error (websocket-verify-response-code "HTTP/1.1 
+(ert-deftest websocket-verify-headers ()
+  (let ((accept "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=")
+        (invalid-accept "Sec-WebSocket-Accept: bad")
+        (upgrade "Upgrade: websocket")
+        (connection "Connection: upgrade")
+        (ws (websocket-inner-create
+             :conn "fake-conn" :url "ws://foo/bar"
+             :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="))
+        (ws-with-protocol
+         (websocket-inner-create
+             :conn "fake-conn" :url "ws://foo/bar"
+             :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
+             :protocols '("myprotocol")))
+        (ws-with-extensions
+         (websocket-inner-create
+             :conn "fake-conn" :url "ws://foo/bar"
+             :accept-string "s3pPLMBiTxaQ9kYGzzhZRbK+xOo="
+             :extensions '("ext1" "ext2"))))
+    (should (websocket-verify-headers
+             ws
+             (websocket-test-header-with-lines accept upgrade connection)))
+    (should-error
+     (websocket-verify-headers
+      ws
+      (websocket-test-header-with-lines invalid-accept upgrade connection))
+     :type 'websocket-invalid-header)
+    (should-error (websocket-verify-headers
+                   ws
+                   (websocket-test-header-with-lines upgrade connection))
+                  :type 'websocket-invalid-header)
+    (should-error (websocket-verify-headers
+                   ws
+                   (websocket-test-header-with-lines accept connection))
+                  :type 'websocket-invalid-header)
+    (should-error (websocket-verify-headers
+                   ws
+                   (websocket-test-header-with-lines accept upgrade))
+                  :type 'websocket-invalid-header)
+    (should-error (websocket-verify-headers
+                   ws-with-protocol
+                   (websocket-test-header-with-lines accept upgrade 
+                  :type 'websocket-invalid-header)
+    (should-error
+     (websocket-verify-headers
+      ws-with-protocol
+      (websocket-test-header-with-lines accept upgrade connection
+                                        "Sec-Websocket-Protocol: foo"))
+     :type 'websocket-invalid-header)
+    (should
+     (websocket-verify-headers
+      ws-with-protocol
+      (websocket-test-header-with-lines accept upgrade connection
+                                        "Sec-Websocket-Protocol: myprotocol")))
+    (should (equal '("myprotocol")
+                   (websocket-negotiated-protocols ws-with-protocol)))
+    (should-error
+     (websocket-verify-headers
+      ws-with-extensions
+      (websocket-test-header-with-lines accept upgrade connection
+                                        "Sec-Websocket-Extensions: foo")))
+    (should
+     (websocket-verify-headers
+      ws-with-extensions
+      (websocket-test-header-with-lines
+       accept upgrade connection "Sec-Websocket-Extensions: ext1, ext2; a=1")))
+    (should (equal '("ext1" "ext2; a=1")
+                   (websocket-negotiated-extensions ws-with-extensions)))
+    (should
+     (websocket-verify-headers
+      ws-with-extensions
+      (websocket-test-header-with-lines accept upgrade connection
+                                        "Sec-Websocket-Extensions: ext1"
+                                        "Sec-Websocket-Extensions: ext2; 
+    (should (equal '("ext1" "ext2; a=1")
+                   (websocket-negotiated-extensions ws-with-extensions)))))
+(ert-deftest websocket-create-headers ()
+  (let ((system-name "mysystem")
+        (base-headers (concat "Host: www.example.com\r\n"
+                              "Upgrade: websocket\r\n"
+                              "Connection: Upgrade\r\n"
+                              "Sec-WebSocket-Key: key\r\n"
+                              "Origin: mysystem\r\n"
+                              "Sec-WebSocket-Version: 13\r\n")))
+    (should (equal (concat base-headers "\r\n")
+                   (websocket-create-headers "ws://www.example.com/path"
+                                             "key" nil nil)))
+    (should (equal (concat base-headers
+                           "Sec-WebSocket-Protocol: protocol\r\n\r\n")
+                   (websocket-create-headers "ws://www.example.com/path"
+                                             "key" '("protocol") nil)))
+    (should (equal
+             (concat base-headers
+                     "Sec-WebSocket-Extensions: ext1; a; b=2, ext2\r\n\r\n")
+             (websocket-create-headers "ws://www.example.com/path"
+                                       "key" nil
+                                       '(("ext1" . ("a" "b=2"))
+                                         ("ext2")))))))
+(ert-deftest websocket-process-frame ()
+  (let* ((sent)
+         (processed)
+         (deleted)
+         (websocket (websocket-inner-create
+                     :conn t :url t
+                     :on-message (lambda (websocket frame)
+                                   (setq
+                                    processed
+                                    (websocket-frame-payload frame)))
+                     :accept-string t)))
+    (dolist (opcode '(text binary continuation))
+      (setq processed nil)
+      (should (equal
+               "hello"
+               (progn
+                 (funcall (websocket-process-frame
+                   websocket
+                   (make-websocket-frame :opcode opcode :payload "hello")))
+                 processed))))
+    (setq sent nil)
+    (flet ((websocket-send (websocket content) (setq sent content)))
+      (should (equal
+               (make-websocket-frame :opcode 'pong :completep t)
+               (progn
+                 (funcall (websocket-process-frame websocket
+                                           (make-websocket-frame :opcode 
+                 sent))))
+    (flet ((delete-process (conn) (setq deleted t)))
+      (should (progn
+                (funcall
+                 (websocket-process-frame websocket
+                                          (make-websocket-frame :opcode 
+                deleted)))))
+(ert-deftest websocket-process-frame-error-handling ()
+  (let* ((error-called)
+         (websocket (websocket-inner-create
+                     :conn t :url t :accept-string t
+                     :on-message (lambda (websocket frame)
+                                   (message "In on-message")
+                                   (error "err"))
+                     :on-error (lambda (ws type err)
+                                 (should (eq 'on-message type))
+                                 (setq error-called t)))))
+    (funcall (websocket-process-frame websocket
+                                      (make-websocket-frame :opcode 'text
+                                                            :payload "hello")))
+    (should error-called)))
+(ert-deftest websocket-to-bytes ()
+  ;; We've tested websocket-get-bytes by itself, now we can use it to
+  ;; help test websocket-to-bytes.
+  (should (equal 30 (websocket-get-bytes (websocket-to-bytes 30 1) 1)))
+  (should (equal 300 (websocket-get-bytes (websocket-to-bytes 300 2) 2)))
+  (should (equal 70000 (websocket-get-bytes (websocket-to-bytes 70000 8) 8)))
+  (should-error (websocket-to-bytes 536870912 8) :type 
+  (should-error (websocket-to-bytes 30 3))
+  (should-error (websocket-to-bytes 300 1))
+  ;; I'd like to test the error for 32-byte systems on 8-byte lengths,
+  ;; but elisp does not allow us to temporarily set constants such as
+  ;; most-positive-fixnum.
+  )
+(ert-deftest websocket-encode-frame ()
+  ;; We've tested websocket-read-frame, now we can use that to help
+  ;; test websocket-encode-frame.
+  (let ((websocket-mask-frames nil))
+    (should (equal
+             websocket-test-hello
+             (websocket-encode-frame
+              (make-websocket-frame :opcode 'text :payload "Hello" :completep 
+    (dolist (len '(200 70000))
+      (let ((long-string (make-string len ?x)))
+        (should (equal long-string
+                       (websocket-frame-payload
+                        (websocket-read-frame
+                         (websocket-encode-frame
+                          (make-websocket-frame :opcode 'text
+                                                :payload long-string)))))))))
+  (let ((websocket-mask-frames t))
+    (flet ((websocket-genbytes (n) (substring websocket-test-masked-hello 2 
+      (should (equal websocket-test-masked-hello
+                     (websocket-encode-frame
+                      (make-websocket-frame :opcode 'text :payload "Hello"
+                                            :completep t))))))
+  (should-not
+   (websocket-frame-completep
+    (websocket-read-frame
+     (websocket-encode-frame (make-websocket-frame :opcode 'text
+                                                   :payload "Hello"
+                                                   :completep nil)))))
+  (dolist (opcode '(close ping pong))
+    (should (equal
+             opcode
+             (websocket-frame-opcode
+              (websocket-read-frame
+               (websocket-encode-frame (make-websocket-frame :opcode opcode
+                                                             :completep 
+(ert-deftest websocket-close ()
+  (let ((sent-frames)
+        (processes-deleted))
+    (flet ((websocket-send (websocket frame) (push frame sent-frames))
+           (websocket-openp (websocket) t)
+           (kill-buffer (buffer))
+           (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))))
+      (should (equal processes-deleted '("fake-conn"))))))
+(ert-deftest websocket-outer-filter ()
+  (let* ((fake-ws (websocket-inner-create
+                   :conn t :url t :accept-string t
+                   :on-open (lambda (websocket)
+                              (should (eq (websocket-ready-state websocket)
+                                          'open))
+                              (setq open-callback-called t)
+                              (error "Ignore me!"))
+                   :on-error (lambda (ws type err))))
+         (processed-frames)
+         (frame1 (make-websocket-frame :opcode 'text :payload "foo" :completep 
+                                       :length 9))
+         (frame2 (make-websocket-frame :opcode 'text :payload "bar" :completep 
+                                       :length 9))
+         (open-callback-called)
+         (websocket-frames
+          (concat
+           (websocket-encode-frame frame1)
+           (websocket-encode-frame frame2))))
+    (flet ((websocket-process-frame
+            (websocket frame)
+            (lexical-let ((frame frame))
+              (lambda () (push frame processed-frames))))
+           (websocket-verify-response-code (output) t)
+           (websocket-verify-headers (websocket output) t))
+      (websocket-outer-filter fake-ws "Sec-")
+      (should (eq (websocket-ready-state fake-ws) 'connecting))
+      (should-not open-callback-called)
+      (websocket-outer-filter fake-ws "WebSocket-Accept: acceptstring")
+      (should-not open-callback-called)
+      (websocket-outer-filter fake-ws (concat
+                                       "\r\n\r\n"
+                                       (substring websocket-frames 0 2)))
+      (should open-callback-called)
+      (websocket-outer-filter fake-ws (substring websocket-frames 2))
+      (should (equal (list frame2 frame1) processed-frames))
+      (should-not (websocket-inflight-input fake-ws)))
+    (flet ((websocket-close (websocket)))
+      (setf (websocket-ready-state fake-ws) 'connecting)
+      (should (eq 500 (cdr (should-error
+                                (websocket-outer-filter fake-ws "HTTP/1.1 
+                                :type 
+(ert-deftest websocket-outer-filter-bad-connection ()
+  (let* ((on-open-calledp)
+         (websocket-closed-calledp)
+         (fake-ws (websocket-inner-create
+                   :conn t :url t :accept-string t
+                   :on-open (lambda (websocket)
+                              (setq on-open-calledp t)))))
+    (flet ((websocket-verify-response-code (output) t)
+           (websocket-verify-headers (websocket output) (error "Bad headers!"))
+           (websocket-close (websocket) (setq websocket-closed-calledp t)))
+      (condition-case err
+          (progn (websocket-outer-filter fake-ws "HTTP/1.1 101\r\n\r\n")
+                 (error "Should have thrown an error!"))
+        (error
+         (should-not on-open-calledp)
+         (should websocket-closed-calledp))))))
+(ert-deftest websocket-send-text ()
+  (flet ((websocket-send (ws frame)
+                         (should (equal
+                                  (websocket-frame-payload frame)
+                                  "\344\275\240\345\245\275"))))
+    (websocket-send-text nil "你好")))
+(ert-deftest websocket-send ()
+  (let ((ws (websocket-inner-create :conn t :url t :accept-string t)))
+    (flet ((websocket-ensure-connected (websocket))
+           (websocket-openp (websocket) t)
+           (process-send-string (conn string)))
+      ;; Just make sure there is no error.
+      (websocket-send ws (make-websocket-frame :opcode 'ping
+                                                       :completep t)))
+    (should-error (websocket-send ws
+                                  (make-websocket-frame :opcode 'text)))
+    (should-error (websocket-send ws
+                                  (make-websocket-frame :opcode 'close
+                                                        :payload "bye!"
+                                                        :completep t))
+                  :type 'websocket-illegal-frame)
+    (should-error (websocket-send ws
+                                  (make-websocket-frame :opcode :close))
+                  :type 'websocket-illegal-frame)))
+(ert-deftest websocket-verify-client-headers ()
+  (let* ((http "HTTP/1.1")
+         (host "Host: authority")
+         (upgrade "Upgrade: websocket")
+         (key (format "Sec-Websocket-Key: %s" "key"))
+         (version "Sec-Websocket-Version: 13")
+         (origin "Origin: origin")
+         (protocol "Sec-Websocket-Protocol: protocol")
+         (extensions1 "Sec-Websocket-Extensions: foo")
+         (extensions2 "Sec-Websocket-Extensions: bar; baz=2")
+         (all-required-headers (list host upgrade key version)))
+    ;; Test that all these headers are necessary
+    (should (equal
+             '(:key "key" :protocols ("protocol") :extensions ("foo" "bar; 
+             (websocket-verify-client-headers
+              (mapconcat 'identity (append (list http "" protocol extensions1 
+                                           all-required-headers) "\r\n"))))
+    (should (websocket-verify-client-headers
+              (mapconcat 'identity
+                         (mapcar 'upcase
+                                 (append (list http "" protocol extensions1 
+                                         all-required-headers)) "\r\n")))
+    (dolist (header all-required-headers)
+      (should-not (websocket-verify-client-headers
+                   (mapconcat 'identity (append (list http "")
+                                                (remove header 
+                              "\r\n"))))
+    (should-not (websocket-verify-client-headers
+                 (mapconcat 'identity (append (list "HTTP/1.0" "") 
+                            "\r\n")))))
+(ert-deftest websocket-intersect ()
+  (should (equal '(2) (websocket-intersect '(1 2) '(2 3))))
+  (should (equal nil (websocket-intersect '(1 2) '(3 4))))
+  (should (equal '(1 2) (websocket-intersect '(1 2) '(1 2)))))
+(ert-deftest websocket-get-server-response ()
+  (let ((ws (websocket-inner-create :conn t :url t :accept-string "key"
+                                    :protocols '("spa" "spb")
+                                    :extensions '("sea" "seb"))))
+    (should (equal (concat
+                    "HTTP/1.1 101 Switching Protocols\r\n"
+                    "Upgrade: websocket\r\n"
+                    "Connection: Upgrade\r\n"
+                    "Sec-WebSocket-Accept: key\r\n\r\n")
+                   (websocket-get-server-response ws nil nil)))
+    (should (string-match "Sec-Websocket-Protocol: spb\r\n"
+                          (websocket-get-server-response ws '("spb" "spc") 
+    (should-not (string-match "Sec-Websocket-Protocol:"
+                              (websocket-get-server-response ws '("spc") nil)))
+    (let ((output (websocket-get-server-response ws '("spa" "spb") nil)))
+      (should (string-match "Sec-Websocket-Protocol: spa\r\n" output))
+      (should (string-match "Sec-Websocket-Protocol: spb\r\n" output)))
+    (should (string-match "Sec-Websocket-Extensions: sea"
+                          (websocket-get-server-response ws nil '("sea" 
+    (should-not (string-match "Sec-Websocket-Extensions:"
+                              (websocket-get-server-response ws nil '("sec"))))
+    (let ((output (websocket-get-server-response ws nil '("sea" "seb"))))
+      (should (string-match "Sec-Websocket-Extensions: sea\r\n" output))
+      (should (string-match "Sec-Websocket-Extensions: seb\r\n" output)))))
+(ert-deftest websocket-server-filter ()
+  (let ((on-open-called)
+        (ws (websocket-inner-create :conn t :url t :accept-string "key"
+                                    :on-open (lambda (ws) (setq on-open-called 
+        (closed)
+        (response)
+        (processed))
+    (flet ((process-send-string (p text) (setq response text))
+           (websocket-close (ws) (setq closed t))
+           (process-get (process sym) ws))
+     ;; Bad request, in two parts
+     (flet ((websocket-verify-client-headers (text) nil))
+       (websocket-server-filter nil "HTTP/1.0 GET /foo \r\n")
+       (should-not closed)
+       (websocket-server-filter nil "\r\n")
+       (should (equal response "HTTP/1.1 400 Bad Request\r\n\r\n"))
+       (should-not (websocket-inflight-input ws)))
+    ;; Good request, followed by packet
+     (setq closed nil
+           response nil)
+     (setf (websocket-inflight-input ws) nil)
+     (flet ((websocket-verify-client-headers (text) t)
+            (websocket-get-server-response (ws protocols extensions)
+                                           "response")
+            (websocket-process-input-on-open-ws (ws text)
+                                                (setq processed t)
+                                                (should
+                                                 (equal text 
+       (websocket-server-filter nil
+                                (concat "\r\n\r\n" websocket-test-hello))
+       (should (equal (websocket-ready-state ws) 'open))
+       (should-not closed)
+       (should (equal response "response"))
+       (should processed)))))
+(ert-deftest websocket-complete-server-response-test ()
+  ;; Example taken from RFC
+  (should (equal
+           (concat "HTTP/1.1 101 Switching Protocols\r\n"
+                   "Upgrade: websocket\r\n"
+                   "Connection: Upgrade\r\n"
+                   "Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=\r\n"
+                   "Sec-WebSocket-Protocol: chat\r\n\r\n"
+                   )
+           (let ((header-info
+                          (websocket-verify-client-headers
+                           (concat "GET /chat HTTP/1.1\r\n"
+                                   "Host: server.example.com\r\n"
+                                   "Upgrade: websocket\r\n"
+                                   "Connection: Upgrade\r\n"
+                                   "Sec-WebSocket-Key: 
+                                   "Origin: http://example.com\r\n";
+                                   "Sec-WebSocket-Protocol: chat, 
+                                   "Sec-WebSocket-Version: 13\r\n"))))
+                     (should header-info)
+                     (let ((ws (websocket-inner-create
+                                :conn t :url t
+                                :accept-string (websocket-calculate-accept
+                                                (plist-get header-info :key))
+                                :protocols '("chat"))))
+                       (websocket-get-server-response
+                        ws
+                        (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) 
+                            (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))))))
+(ert-deftest websocket-default-error-handler ()
+  (flet ((try-error
+          (callback-type err expected-message)
+          (flet ((display-warning
+                  (type message &optional level buffer-name)
+                  (should (eq type 'websocket))
+                  (should (eq level :error))
+                  (should (string= message expected-message))))
+            (websocket-default-error-handler nil
+                                             callback-type
+                                             err))))
+    (try-error
+     'on-message
+     '(end-of-buffer)
+     "in callback `on-message': End of buffer")
+    (try-error
+     'on-close
+     '(wrong-number-of-arguments 1 2)
+     "in callback `on-close': Wrong number of arguments: 1, 2")))

=== added file 'packages/websocket/websocket.el'
--- a/packages/websocket/websocket.el   1970-01-01 00:00:00 +0000
+++ b/packages/websocket/websocket.el   2013-08-01 18:08:23 +0000
@@ -0,0 +1,989 @@
+;;; websocket.el --- Emacs WebSocket client and server
+;; Copyright (c) 2010 Andrew Hyatt
+;; Author: Andrew Hyatt <ahyatt at gmail dot com>
+;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
+;; Keywords: Communication, Websocket, Server
+;; Version: 1.01
+;; 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
+;; License, or (at your option) any later version.
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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.
+;;; 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
+;; connections.
+;; Websockets clients are created by calling `websocket-open', which
+;; returns a `websocket' struct.  Users of this library use the
+;; websocket struct, and can call methods `websocket-send-text', which
+;; sends text over the websocket, or `websocket-send', which sends a
+;; `websocket-frame' struct, enabling finer control of what is sent.
+;; A callback is passed to `websocket-open' that will retrieve
+;; websocket frames called from the websocket.  Websockets are
+;; eventually closed with `websocket-close'.
+;; Server functionality is similar.  A server is started with
+;; `websocket-server' called with a port and the callbacks to use,
+;; which returns a process.  The process can later be closed with
+;; `websocket-server-close'.  A `websocket' struct is also created
+;; for every connection, and is exposed through the callbacks.
+(require 'bindat)
+(require 'url-parse)
+(eval-when-compile (require 'cl))
+;;; Code:
+(defstruct (websocket
+            (:constructor nil)
+            (:constructor websocket-inner-create))
+  "A websocket structure.
+This follows the W3C Websocket API, except translated to elisp
+idioms.  The API is implemented in both the websocket struct and
+additional methods.  Due to how defstruct slots are accessed, all
+API methods are prefixed with \"websocket-\" and take a websocket
+as an argument, so the distrinction between the struct API and
+the additional helper APIs are not visible to the caller.
+A websocket struct is created with `websocket-open'.
+`ready-state' contains one of 'connecting, 'open, or
+'closed, depending on the state of the websocket.
+The W3C API \"bufferedAmount\" call is not currently implemented,
+since there is no elisp API to get the buffered amount from the
+subprocess.  There may, in fact, be output data buffered,
+however, when the `on-message' or `on-close' callbacks are
+`on-open', `on-message', `on-close', and `on-error' are described
+in `websocket-open'.
+The `negotiated-extensions' slot lists the extensions accepted by
+both the client and server, and `negotiated-protocols' does the
+same for the protocols.
+  ;; API
+  (ready-state 'connecting)
+  client-data
+  on-open
+  on-message
+  on-close
+  on-error
+  negotiated-protocols
+  negotiated-extensions
+  (server-p nil :read-only t)
+  ;; Other data - clients should not have to access this.
+  (url (assert nil) :read-only t)
+  (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
+  accept-string
+  (inflight-input nil))
+(defvar websocket-version "1.01"
+  "Version numbers of this version of websocket.el.")
+(defvar websocket-debug nil
+  "Set to true to output debugging info to a per-websocket buffer.
+The buffer is ` *websocket URL debug*' where URL is the
+URL of the connection.")
+(defconst websocket-guid "258EAFA5-E914-47DA-95CA-C5AB0DC85B11"
+  "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.")
+(defmacro websocket-document-function (function docstring)
+  "Document FUNCTION with DOCSTRING.  Use this for defstruct accessor etc."
+  (declare (indent defun)
+           (doc-string 2))
+  `(put ',function 'function-documentation ,docstring))
+(websocket-document-function websocket-on-open
+  "Accessor for websocket on-open callback.
+See `websocket-open' for details.
+\(fn WEBSOCKET)")
+(websocket-document-function websocket-on-message
+  "Accessor for websocket on-message callback.
+See `websocket-open' for details.
+\(fn WEBSOCKET)")
+(websocket-document-function websocket-on-close
+  "Accessor for websocket on-close callback.
+See `websocket-open' for details.
+\(fn WEBSOCKET)")
+(websocket-document-function websocket-on-error
+  "Accessor for websocket on-error callback.
+See `websocket-open' for details.
+\(fn WEBSOCKET)")
+(defun websocket-genbytes (nbytes)
+  "Generate NBYTES random bytes."
+  (let ((s (make-string nbytes ?\s)))
+    (dotimes (i nbytes)
+      (aset s i (random 256)))
+    s))
+(defun websocket-try-callback (websocket-callback callback-type websocket
+                                                  &rest rest)
+  "Invoke function WEBSOCKET-CALLBACK with WEBSOCKET and REST args.
+If an error happens, it is handled according to
+  ;; This looks like it should be able to done more efficiently, but
+  ;; I'm not sure that's the case.  We can't do it as a macro, since
+  ;; we want it to change whenever websocket-callback-debug-on-error
+  ;; changes.
+  (let ((args rest)
+        (debug-on-error websocket-callback-debug-on-error))
+    (push websocket args)
+    (if websocket-callback-debug-on-error
+        (condition-case err
+            (apply (funcall websocket-callback websocket) args)
+          ((debug error) (funcall (websocket-on-error websocket)
+                                  websocket callback-type err)))
+      (condition-case err
+          (apply (funcall websocket-callback websocket) args)
+        (error (funcall (websocket-on-error websocket) websocket
+                        callback-type err))))))
+(defun websocket-genkey ()
+  "Generate a key suitable for the websocket handshake."
+  (base64-encode-string (websocket-genbytes 16)))
+(defun websocket-calculate-accept (key)
+  "Calculate the expect value of the accept header.
+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-bytes (s n)
+  "From string S, retrieve the value of N bytes.
+Return the value as an unsigned integer.  The value N must be a
+power of 2, up to 8.
+We support getting frames up to 536870911 bytes (2^29 - 1),
+approximately 537M long."
+  (if (= n 8)
+    (let* ((32-bit-parts
+            (bindat-get-field (bindat-unpack '((:val vec 2 u32)) s) :val))
+           (cval
+            (logior (lsh (aref 32-bit-parts 0) 32) (aref 32-bit-parts 1))))
+      (if (and (= (aref 32-bit-parts 0) 0)
+               (= (lsh (aref 32-bit-parts 1) -29) 0))
+          cval
+        (signal 'websocket-unparseable-frame
+                "Frame value found too large to parse!")))
+    ;; n is not 8
+    (bindat-get-field
+     (condition-case err
+         (bindat-unpack
+          `((:val
+             ,(cond ((= n 1) 'u8)
+                    ((= n 2) 'u16)
+                    ((= n 4) 'u32)
+                    ;; This is an error with the library,
+                    ;; not a user-facing, meaningful error.
+                    (t (error
+                        "websocket-get-bytes: Unknown N: %s" n)))))
+          s)
+       (args-out-of-range (signal 'websocket-unparseable-frame
+                                  (format "Frame unexpectedly shortly: %s" 
+     :val)))
+(defun websocket-to-bytes (val nbytes)
+  "Encode the integer VAL in NBYTES of data.
+NBYTES much be a power of 2, up to 8.
+This supports encoding values up to 536870911 bytes (2^29 - 1),
+approximately 537M long."
+  (when (and (< nbytes 8)
+             (> val (expt 2 (* 8 nbytes))))
+    ;; not a user-facing error, this must be caused from an error in
+    ;; this library
+    (error "websocket-to-bytes: Value %d could not be expressed in %d bytes"
+           val nbytes))
+  (if (= nbytes 8)
+      (progn
+        (let ((hi-32bits (lsh val -32))
+              (low-32bits (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))
+                       `((:val . [,hi-32bits ,low-32bits])))))
+    (bindat-pack
+     `((:val ,(cond ((= nbytes 1) 'u8)
+                    ((= nbytes 2) 'u16)
+                    ((= nbytes 4) 'u32)
+                    ;; Library error, not system error
+                    (t (error "websocket-to-bytes: Unknown NBYTES: %s" 
+     `((:val . ,val)))))
+(defun websocket-get-opcode (s)
+  "Retrieve the opcode from first byte of string S."
+  (websocket-ensure-length s 1)
+  (let ((opcode (logand #xf (websocket-get-bytes s 1))))
+    (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)
+  "Parse out the payload length from the string S.
+We start at position 0, and return a cons of the payload length and how
+many bytes were consumed from the string."
+  (websocket-ensure-length s 1)
+  (let* ((initial-val (logand 127 (websocket-get-bytes s 1))))
+    (cond ((= initial-val 127)
+           (websocket-ensure-length s 9)
+           (cons (websocket-get-bytes (substring s 1) 8) 9))
+          ((= initial-val 126)
+           (websocket-ensure-length s 3)
+           (cons (websocket-get-bytes (substring s 1) 2) 3))
+          (t (cons initial-val 1)))))
+(defstruct websocket-frame opcode payload length completep)
+(defun websocket-mask (key data)
+  "Using string KEY, mask string DATA according to the RFC.
+This is used to both mask and unmask data."
+  (apply
+   'string
+   (loop for b across data
+         for i from 0 to (length data)
+         collect (logxor (websocket-get-bytes (substring key (mod i 4)) 1) 
+(defun websocket-ensure-length (s n)
+  "Ensure the string S has at most N bytes.
+Otherwise we throw the error `websocket-incomplete-frame'."
+  (when (< (length s) n)
+    (throw 'websocket-incomplete-frame nil)))
+(defun websocket-encode-frame (frame)
+  "Encode the FRAME struct to the binary representation."
+  (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))))
+    (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 websocket-mask-frames 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 websocket-mask-frames)
+                     (append mask-key nil))
+                   (when payloadp
+                     (append (if websocket-mask-frames
+                                 (websocket-mask mask-key payload)
+                               payload)
+                             nil))))))
+(defun websocket-read-frame (s)
+  "Read from string S a `websocket-frame' struct with the contents.
+This only gets complete frames.  Partial frames need to wait until
+the frame finishes.  If the frame is not completed, return NIL."
+  (catch 'websocket-incomplete-frame
+    (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)))
+           (payload-len (when payloadp
+                          (websocket-get-payload-len (substring s 1))))
+           (maskp (and
+                   payloadp
+                   (= 128 (logand 128 (websocket-get-bytes (substring s 1) 
+           (payload-start (when payloadp (+ (if maskp 5 1) (cdr payload-len))))
+           (payload-end (when payloadp (+ payload-start (car payload-len))))
+           (unmasked-payload (when payloadp
+                               (websocket-ensure-length s payload-end)
+                               (substring s payload-start payload-end))))
+      (make-websocket-frame
+       :opcode opcode
+       :payload
+       (if maskp
+           (let ((masking-key (substring s (+ 1 (cdr payload-len))
+                                         (+ 5 (cdr payload-len)))))
+             (websocket-mask masking-key unmasked-payload))
+         unmasked-payload)
+       :length (if payloadp payload-end 1)
+       :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."
+  ;; Formatting code adapted from `edebug-report-error'
+  (concat (or (get (car err) 'error-message)
+              (format "peculiar error (%s)" (car err)))
+          (when (cdr err)
+            (format ": %s"
+                    (mapconcat #'prin1-to-string
+                               (cdr 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"
+                           type
+                           (websocket-format-error err))
+                   :error))
+;; Error symbols in use by the library
+(put 'websocket-unsupported-protocol 'error-conditions
+     '(error websocket-error websocket-unsupported-protocol))
+(put 'websocket-unsupported-protocol 'error-message "Unsupported websocket 
+(put 'websocket-wss-needs-emacs-24 'error-conditions
+     '(error websocket-error websocket-unsupported-protocol
+             websocket-wss-needs-emacs-24))
+(put 'websocket-wss-needs-emacs-24 'error-message
+     "wss protocol is not supported for Emacs before version 24.")
+(put 'websocket-received-error-http-response 'error-conditions
+     '(error websocket-error websocket-received-error-http-response))
+(put 'websocket-received-error-http-response 'error-message
+     "Error response received from websocket server")
+(put 'websocket-invalid-header 'error-conditions
+     '(error websocket-error websocket-invalid-header))
+(put 'websocket-invalid-header 'error-message
+     "Invalid HTTP header sent")
+(put 'websocket-illegal-frame 'error-conditions
+     '(error websocket-error websocket-illegal-frame))
+(put 'websocket-illegal-frame 'error-message
+     "Cannot send illegal frame to websocket")
+(put 'websocket-closed 'error-conditions
+     '(error websocket-error websocket-closed))
+(put 'websocket-closed 'error-message
+     "Cannot send message to a closed websocket")
+(put 'websocket-unparseable-frame 'error-conditions
+     '(error websocket-error websocket-unparseable-frame))
+(put 'websocket-unparseable-frame 'error-message
+     "Received an unparseable frame")
+(put 'websocket-frame-too-large 'error-conditions
+     '(error websocket-error websocket-frame-too-large))
+(put 'websocket-frame-too-large 'error-message
+     "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 
+  (let ((result))
+    (dolist (elem a (nreverse result))
+      (when (member elem b)
+        (add-to-list 'result elem)))))
+(defun websocket-get-debug-buffer-create (websocket)
+  "Get or create the buffer corresponding to WEBSOCKET."
+  (let ((buf (get-buffer-create (format "*websocket %s debug*"
+                                    (websocket-url websocket)))))
+    (when (= 0 (buffer-size buf))
+      (buffer-disable-undo buf))
+    buf))
+(defun websocket-debug (websocket msg &rest args)
+  "In the WEBSOCKET's debug buffer, send MSG, with format ARGS."
+  (when websocket-debug
+    (let ((buf (websocket-get-debug-buffer-create websocket)))
+      (save-excursion
+        (with-current-buffer buf
+          (goto-char (point-max))
+          (insert "[WS] ")
+          (insert (apply 'format (append (list msg) args)))
+          (insert "\n"))))))
+(defun websocket-verify-response-code (output)
+  "Verify that OUTPUT contains a valid HTTP response code.
+The only acceptable one to websocket is responce code 101.
+A t value will be returned on success, and an error thrown
+if not."
+  (string-match "HTTP/1.1 \\([[:digit:]]+\\)" output)
+  (unless (equal "101" (match-string 1 output))
+       (signal 'websocket-received-error-http-response
+               (string-to-number (match-string 1 output))))
+  t)
+(defun websocket-parse-repeated-field (output field)
+  "From header-containing OUTPUT, parse out the list from a
+possibly repeated field."
+  (let ((pos 0)
+        (extensions))
+    (while (and pos
+                (string-match (format "\r\n%s: \\(.*\\)\r\n" field)
+                              output pos))
+      (when (setq pos (match-end 1))
+        (setq extensions (append extensions (split-string
+                                             (match-string 1 output) ", ?")))))
+    extensions))
+(defun websocket-process-frame (websocket frame)
+  "Using the WEBSOCKET's filter and connection, process the FRAME.
+This returns a lambda that should be executed when all frames have
+been processed.  If the frame has a payload, the lambda has the frame
+passed to the filter slot of WEBSOCKET.  If the frame is a ping,
+the lambda has a reply with a pong.  If the frame is a close, the lambda
+has connection termination."
+  (let ((opcode (websocket-frame-opcode frame)))
+    (lexical-let ((lex-ws websocket)
+                  (lex-frame frame))
+      (cond ((memq opcode '(continuation text binary))
+             (lambda () (websocket-try-callback 'websocket-on-message 
+                                           lex-ws lex-frame)))
+            ((eq opcode 'ping)
+             (lambda () (websocket-send lex-ws
+                                   (make-websocket-frame :opcode 'pong 
:completep t))))
+            ((eq opcode 'close)
+             (lambda () (delete-process (websocket-conn lex-ws))))
+            (t (lambda ()))))))
+(defun websocket-process-input-on-open-ws (websocket text)
+  "This handles input processing for both the client and server filters."
+  (let ((current-frame)
+        (processing-queue)
+        (start-point 0))
+    (while (setq current-frame (websocket-read-frame
+                                (substring text start-point)))
+      (push (websocket-process-frame websocket current-frame) processing-queue)
+      (incf start-point (websocket-frame-length current-frame)))
+    (when (> (length text) start-point)
+      (setf (websocket-inflight-input websocket)
+            (substring text start-point)))
+    (dolist (to-process (nreverse processing-queue))
+      (funcall to-process))))
+(defun websocket-send-text (websocket text)
+  "To the WEBSOCKET, send TEXT as a complete frame."
+  (websocket-send
+   websocket
+   (make-websocket-frame :opcode 'text
+                         :payload (encode-coding-string
+                                   text 'raw-text)
+                         :completep t)))
+(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)))))
+(defun websocket-send (websocket frame)
+  "To the WEBSOCKET server, send the FRAME.
+This will raise an error if the frame is illegal.
+The error signaled may be of type `websocket-illegal-frame' if
+the frame is malformed in some way, also having the condition
+type of `websocket-error'.  The data associated with the signal
+is the frame being sent.
+If the websocket is closed a signal `websocket-closed' is sent,
+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
+`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-check frame)
+    (signal 'websocket-illegal-frame frame))
+  (websocket-debug websocket "Sending frame, opcode: %s payload: %s"
+                   (websocket-frame-opcode frame)
+                   (websocket-frame-payload frame))
+  (websocket-ensure-connected websocket)
+  (unless (websocket-openp websocket)
+    (signal 'websocket-closed frame))
+  (process-send-string (websocket-conn websocket)
+                       (websocket-encode-frame frame)))
+(defun websocket-openp (websocket)
+  "Check WEBSOCKET and return non-nil if it is open, and either
+connecting or open."
+  (and websocket
+       (not (eq 'close (websocket-ready-state websocket)))
+       (member (process-status (websocket-conn websocket)) '(open run))))
+(defun websocket-close (websocket)
+  "Close WEBSOCKET and erase all the old websocket data."
+  (websocket-debug websocket "Closing websocket")
+  (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)))
+(defun websocket-ensure-connected (websocket)
+  "If the WEBSOCKET connection is closed, open it."
+  (unless (and (websocket-conn websocket)
+               (ecase (process-status (websocket-conn websocket))
+                 ((run open listen) t)
+                 ((stop exit signal closed connect failed nil) nil)))
+    (websocket-close websocket)
+    (websocket-open (websocket-url websocket)
+                    :protocols (websocket-protocols websocket)
+                    :extensions (websocket-extensions websocket)
+                    :on-open (websocket-on-open websocket)
+                    :on-message (websocket-on-message websocket)
+                    :on-close (websocket-on-close websocket)
+                    :on-error (websocket-on-error websocket))))
+;; Websocket client ;;
+(defun* websocket-open (url &key protocols extensions (on-open '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
+the server that this client supports the protocols in the list
+given.  We will require that the server also has to support that
+Similar logic applies to EXTENSIONS, which is a list of conses,
+the car of which is a string naming the extension, and the cdr of
+which is the list of parameter strings to use for that extension.
+The parameter strings are of the form \"key=value\" or \"value\".
+EXTENSIONS can be NIL if none are in use.  An example value would
+be '(\"deflate-stream\" . (\"mux\" \"max-channels=4\")).
+Optionally you can specify
+ON-OPEN, ON-MESSAGE and ON-CLOSE callbacks as well.
+The ON-OPEN callback is called after the connection is
+established with the websocket as the only argument.  The return
+value is unused.
+The ON-MESSAGE callback is called after receiving a frame, and is
+called with the websocket as the first argument and
+`websocket-frame' struct as the second.  The return value is
+The ON-CLOSE callback is called after the connection is closed, or
+failed to open.  It is called with the websocket as the only
+argument, and the return value is unused.
+The ON-ERROR callback is called when any of the other callbacks
+have an error.  It takes the websocket as the first argument, and
+a symbol as the second argument either `on-open', `on-message',
+or `on-close', and the error as the third argument. Do NOT
+rethrow the error, or else you may miss some websocket messages.
+You similarly must not generate any other errors in this method.
+If you want to debug errors, set
+`websocket-callback-debug-on-error' to `t', but this also can be
+dangerous is the debugger is quit out of.  If not specified,
+`websocket-default-error-handler' is used.
+For each of these event handlers, the client code can store
+arbitrary data in the `client-data' slot in the returned
+The following errors might be thrown in this method or in
+websocket processing, all of them having the error-condition
+`websocket-error' in addition to their own symbol:
+`websocket-unsupported-protocol': Data in the error signal is the
+protocol that is unsupported.  For example, giving a URL starting
+with http by mistake raises this error.
+`websocket-wss-needs-emacs-24': Trying to connect wss protocol
+using Emacs < 24 raises this error.  You can catch this error
+also by `websocket-unsupported-protocol'.
+`websocket-received-error-http-response': Data in the error
+signal is the integer error number.
+`websocket-invalid-header': Data in the error is a string
+describing the invalid header received from the server.
+`websocket-unparseable-frame': Data in the error is a string
+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"))
+                   (let* ((type (if (equal (url-type url-struct) "ws")
+                                    'plain 'tls))
+                          (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)))
+                       (if (eq type 'plain)
+                           (make-network-process :name name :buffer buf :host 
+                                                 :service port :nowait nil)
+                         (condition-case-unless-debug nil
+                             (open-network-stream name buf host port :type 
type :nowait nil)
+                           (wrong-number-of-arguments
+                            (signal 'websocket-wss-needs-emacs-24 "wss")))))
+                 (signal 'websocket-unsupported-protocol (url-type 
+         (websocket (websocket-inner-create
+                     :conn conn
+                     :url url
+                     :on-open on-open
+                     :on-message on-message
+                     :on-close on-close
+                     :on-error on-error
+                     :protocols protocols
+                     :extensions (mapcar 'car extensions)
+                     :accept-string
+                     (websocket-calculate-accept key))))
+    (process-put conn :websocket websocket)
+    (set-process-filter conn
+                        (lambda (process output)
+                          (let ((websocket (process-get process :websocket)))
+                            (websocket-outer-filter websocket output))))
+    (set-process-sentinel
+     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-try-callback 'websocket-on-close 'on-close websocket)))))
+    (set-process-query-on-exit-flag conn nil)
+    (process-send-string conn
+                         (format "GET %s HTTP/1.1\r\n"
+                                 (let ((path (url-filename url-struct)))
+                                   (if (> (length path) 0) path "/"))))
+    (websocket-debug websocket "Sending handshake, key: %s, acceptance: %s"
+                     key (websocket-accept-string websocket))
+    (process-send-string conn
+                         (websocket-create-headers url key protocols 
+    (websocket-debug websocket "Websocket opened")
+    websocket))
+(defun websocket-outer-filter (websocket output)
+  "Filter the WEBSOCKET server's OUTPUT.
+This will parse headers and process frames repeatedly until there
+is no more output or the connection closes.  If the websocket
+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)
+    ;; If we've received the complete header, check to see if we've
+    ;; received the desired handshake.
+    (when (and (eq 'connecting (websocket-ready-state websocket))
+               (setq header-end-pos (string-match "\r\n\r\n" text))
+               (setq start-point (+ 4 header-end-pos)))
+      (condition-case err
+          (progn
+            (websocket-verify-response-code text)
+            (websocket-verify-headers websocket text))
+        (error
+         (websocket-close websocket)
+         (signal (car err) (cdr err))))
+      (setf (websocket-ready-state websocket) 'open)
+      (websocket-try-callback 'websocket-on-open 'on-open websocket))
+    (when (eq 'open (websocket-ready-state websocket))
+      (websocket-process-input-on-open-ws
+       websocket (substring text (or start-point 0))))))
+(defun websocket-verify-headers (websocket output)
+  "Based on WEBSOCKET's data, ensure the headers in OUTPUT are valid.
+The output is assumed to have complete headers.  This function
+will either return t or call `error'.  This has the side-effect
+of populating the list of server extensions to WEBSOCKET."
+  (let ((accept-string
+         (concat "Sec-WebSocket-Accept: " (websocket-accept-string 
+    (websocket-debug websocket "Checking for accept header: %s" accept-string)
+    (unless (string-match (regexp-quote accept-string) output)
+      (signal 'websocket-invalid-header
+              "Incorrect handshake from websocket: is this really a websocket 
+  (let ((case-fold-search t))
+    (websocket-debug websocket "Checking for upgrade header")
+    (unless (string-match "\r\nUpgrade: websocket\r\n" output)
+      (signal 'websocket-invalid-header
+              "No 'Upgrade: websocket' header found"))
+    (websocket-debug websocket "Checking for connection header")
+    (unless (string-match "\r\nConnection: upgrade\r\n" output)
+      (signal 'websocket-invalid-header
+              "No 'Connection: upgrade' header found"))
+    (when (websocket-protocols websocket)
+      (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."))
+          (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 "; ?")))))
+      (when extra-extensions
+        (signal 'websocket-invalid-header
+                (format "Non-requested extensions returned by server: %S"
+                        extra-extensions)))
+      (setf (websocket-negotiated-extensions websocket) extensions)))
+  t)
+;; 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',
+`:on-close' and `:on-error', which operate exactly as documented
+in the websocket client function `websocket-open'.  Returns the
+connection, which should be kept in order to pass to
+  (let* ((conn (make-network-process
+                :name (format "websocket server on port %d" port)
+                :server t
+                :family 'ipv4
+                :log 'websocket-server-accept
+                :filter-multibyte nil
+                :plist plist
+                :service port)))
+    conn))
+(defun websocket-server-close (conn)
+  "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 
+  (delete-process conn))
+(defun websocket-server-accept (server client message)
+  "Accept a new websocket connection from a client."
+  (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 
+             :on-close (lexical-let ((user-method
+                                      (or (process-get server :on-close) 
+                         (lambda (ws)
+                           (setq websocket-server-websockets
+                                 (remove ws websocket-server-websockets))
+                           (funcall user-method ws)))
+             :on-error (or (process-get server :on-error)
+                           'websocket-default-error-handler)
+             :protocols (process-get server :protocol)
+             :extensions (mapcar 'car (process-get server :extensions)))))
+    (add-to-list 'websocket-server-websockets ws)
+    (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-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 
+(defun websocket-create-headers (url key protocol extensions)
+  "Create connections headers for the given URL, KEY, PROTOCOL and EXTENSIONS.
+These are defined as in `websocket-open'."
+  (format (concat "Host: %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
+                     (mapconcat (lambda (protocol)
+                                  (format "Sec-WebSocket-Protocol: %s" 
+                                protocol "\r\n")
+                     "\r\n"))
+                  (when extensions
+                    (format "Sec-WebSocket-Extensions: %s\r\n"
+                            (mapconcat
+                             (lambda (ext)
+                               (concat (car ext)
+                                       (when (cdr ext) "; ")
+                                       (when (cdr ext)
+                                         (mapconcat 'identity (cdr ext) "; 
+                             extensions ", ")))
+                  "\r\n")
+          (url-host (url-generic-parse-url url))
+          key
+          system-name
+          protocol))
+(defun websocket-get-server-response (websocket client-protocols 
+  "Get the websocket response from client WEBSOCKET."
+  (let ((separator "\r\n"))
+      (concat "HTTP/1.1 101 Switching Protocols" separator
+              "Upgrade: websocket" separator
+              "Connection: Upgrade" separator
+              "Sec-WebSocket-Accept: "
+              (websocket-accept-string websocket) separator
+              (let ((protocols
+                         (websocket-intersect client-protocols
+                                              (websocket-protocols 
+                    (when protocols
+                      (concat
+                       (mapconcat
+                        (lambda (protocol) (format "Sec-WebSocket-Protocol: %s"
+                                              protocol)) protocols separator)
+                       separator)))
+              (let ((extensions (websocket-intersect
+                                   client-extensions
+                                   (websocket-extensions websocket))))
+                  (when extensions
+                    (concat
+                     (mapconcat
+                      (lambda (extension) (format "Sec-Websocket-Extensions: 
+                                             extension)) extensions separator)
+                     separator)))
+              separator)))
+(defun websocket-server-filter (process output)
+  "This acts on all OUTPUT from websocket clients PROCESS."
+  (let* ((ws (process-get process :websocket))
+         (text (concat (websocket-inflight-input ws) output)))
+    (setf (websocket-inflight-input ws) nil)
+    (cond ((eq (websocket-ready-state ws) 'connecting)
+           ;; check for connection string
+           (let ((end-of-header-pos
+                  (let ((pos (string-match "\r\n\r\n" text)))
+                    (when pos (+ 4 pos)))))
+               (if end-of-header-pos
+                   (progn
+                     (let ((header-info (websocket-verify-client-headers 
+                       (if header-info
+                           (progn (setf (websocket-accept-string ws)
+                                        (websocket-calculate-accept
+                                         (plist-get header-info :key)))
+                                  (process-send-string
+                                   process
+                                   (websocket-get-server-response
+                                    ws (plist-get header-info :protocols)
+                                    (plist-get header-info :extensions)))
+                                  (setf (websocket-ready-state ws) 'open)
+                                  (websocket-try-callback 'websocket-on-open
+                                                          'on-open ws))
+                         (message "Invalid client headers found in: %s" output)
+                         (process-send-string process "HTTP/1.1 400 Bad 
+                         (websocket-close ws)))
+                     (when (> (length text) (+ 1 end-of-header-pos))
+                       (websocket-server-filter process (substring
+                                                           text
+                 (setf (websocket-inflight-input ws) text))))
+          ((eq (websocket-ready-state ws) 'open)
+           (websocket-process-input-on-open-ws ws text))
+          ((eq (websocket-ready-state ws) 'closed)
+           (message "WARNING: Should not have received further input on closed 
+(defun websocket-verify-client-headers (output)
+  "Verify the headers from the WEBSOCKET client connection in OUTPUT.
+Unlike `websocket-verify-headers', this is a quieter routine.  We
+don't want to error due to a bad client, so we just print out
+messages and a plist containing `:key', the websocket key,
+`:protocols' and `:extensions'."
+  (block nil
+    (let ((case-fold-search t)
+          (plist))
+      (unless (string-match "HTTP/1.1" output)
+        (message "Websocket client connection: HTTP/1.1 not found")
+        (return nil))
+      (unless (string-match "^Host: " output)
+        (message "Websocket client connection: Host header not found")
+        (return nil))
+      (unless (string-match "^Upgrade: websocket\r\n" output)
+        (message "Websocket client connection: Upgrade: websocket not found")
+        (return nil))
+      (if (string-match "^Sec-WebSocket-Key: \\([[:graph:]]+\\)\r\n" output)
+          (setq plist (plist-put plist :key (match-string 1 output)))
+        (message "Websocket client connect: No key sent")
+        (return nil))
+      (unless (string-match "^Sec-WebSocket-Version: 13" output)
+        (message "Websocket client connect: Websocket version 13 not found")
+        (return nil))
+      (when (string-match "^Sec-WebSocket-Protocol:" output)
+        (setq plist (plist-put plist :protocols (websocket-parse-repeated-field
+                                                 output
+                                                 "Sec-Websocket-Protocol"))))
+      (when (string-match "^Sec-WebSocket-Extensions:" output)
+        (setq plist (plist-put plist :extensions 
+                                                  output
+      plist)))
+(provide 'websocket)
+;;; websocket.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]