[elpa] master cb4b138: Add ability to handle cookies.

[Andrew Hyatt]

branch: master
commit cb4b138705e692a4cda0b72a1422049d37a41199
Author: Andrew Hyatt <address@hidden>
Commit: Andrew Hyatt <address@hidden>

    Add ability to handle cookies.
    
    * websocket.el (websocket-open, websocket-process-headers,
      websocket-out-filter, websocket-create-headers): Add ability to set
      and accept cookies, using the url-cookie library.  Also make sure the
      port is included in the Host header.
---
 packages/websocket/websocket.el |   79 +++++++++++++++++++++++++-------------
 1 files changed, 52 insertions(+), 27 deletions(-)

diff --git a/packages/websocket/websocket.el b/packages/websocket/websocket.el
index 1e1baa3..c42f2cc 100644
--- a/packages/websocket/websocket.el
+++ b/packages/websocket/websocket.el
@@ -5,7 +5,7 @@
 ;; Author: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Maintainer: Andrew Hyatt <ahyatt at gmail dot com>
 ;; Keywords: Communication, Websocket, Server
-;; Version: 1.4
+;; Version: 1.5
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -45,6 +45,7 @@
 
 (require 'bindat)
 (require 'url-parse)
+(require 'url-cookie)
 (eval-when-compile (require 'cl))
 
 ;;; Code:
@@ -99,7 +100,7 @@ same for the protocols.
   accept-string
   (inflight-input nil))
 
-(defvar websocket-version "1.4"
+(defvar websocket-version "1.5"
   "Version numbers of this version of websocket.el.")
 
 (defvar websocket-debug nil
@@ -611,6 +612,11 @@ 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\")).
 
+Cookies that are set via `url-cookie-store' will be used during
+communication with the server, and cookies received from the
+server will be stored in the same cookie storage that the
+`url-cookie' package uses.
+
 Optionally you can specify
 ON-OPEN, ON-MESSAGE and ON-CLOSE callbacks as well.
 
@@ -721,6 +727,14 @@ describing the problem with the frame.
     (websocket-debug websocket "Websocket opened")
     websocket))
 
+(defun websocket-process-headers (url headers)
+  "On opening URL, process the HEADERS sent from the server."
+  (when (string-match "Set-Cookie: \(.*\)\r\n" headers)
+    ;; The url-current-object is assumed to be set by
+    ;; url-cookie-handle-set-cookie.
+    (let ((url-current-object (url-generic-parse-url url)))
+      (url-cookie-handle-set-cookie (match-string 1 headers)))))
+
 (defun websocket-outer-filter (websocket output)
   "Filter the WEBSOCKET server's OUTPUT.
 This will parse headers and process frames repeatedly until there
@@ -739,7 +753,8 @@ connection is invalid, the connection will be closed."
       (condition-case err
           (progn
             (websocket-verify-response-code text)
-            (websocket-verify-headers websocket text))
+            (websocket-verify-headers websocket text)
+            (websocket-process-headers (websocket-url websocket) text))
         (error
          (websocket-close websocket)
          (signal (car err) (cdr err))))
@@ -870,30 +885,40 @@ connection, which should be kept in order to pass to
 (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"
-                  "Sec-WebSocket-Version: 13\r\n"
-                  (when protocol
-                    (concat
-                     (mapconcat (lambda (protocol)
-                                  (format "Sec-WebSocket-Protocol: %s" 
protocol))
-                                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
-          protocol))
+  (let* ((parsed-url (url-generic-parse-url url))
+         (host-port (if (url-port-if-non-default parsed-url)
+                        (format "%s:%s" (url-host parsed-url) (url-port 
parsed-url))
+                      (url-host parsed-url)))
+         (cookie-header (url-cookie-generate-header-lines
+                         host-port (car (url-path-and-query parsed-url))
+                         (equal (url-type parsed-url) "wss"))))
+    (format (concat "Host: %s\r\n"
+                    "Upgrade: websocket\r\n"
+                    "Connection: Upgrade\r\n"
+                    "Sec-WebSocket-Key: %s\r\n"
+                    "Sec-WebSocket-Version: 13\r\n"
+                    (when protocol
+                      (concat
+                       (mapconcat
+                        (lambda (protocol)
+                          (format "Sec-WebSocket-Protocol: %s" protocol))
+                        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 ", ")))
+                    (when cookie-header cookie-header)
+                    "\r\n")
+            host-port
+            key
+            protocol)))
 
 (defun websocket-get-server-response (websocket client-protocols 
client-extensions)
   "Get the websocket response from client WEBSOCKET."