From 45441054bc0dbd8ad6fc05f2ae2eb135830a9b02 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakub=20Piotr=20C=C5=82apa?= <jpc@zenburn.net>
Date: Mon, 6 Dec 2010 19:09:14 +0100
Subject: [PATCH] Secure websockets and the wss: protocol scheme.

Also changed the code to send the request, headers and Key3 all at once since some servers expect it this way (node.js had problems with this when on SSL).
---
 collects/net/websocket/client.rkt | 38 +++++++++++++++++++------------
 1 file changed, 24 insertions(+), 14 deletions(-)

diff --git a/collects/net/websocket/client.rkt b/collects/net/websocket/client.rkt
index 32ea70d036..96e66476ce 100644
--- a/collects/net/websocket/client.rkt
+++ b/collects/net/websocket/client.rkt
@@ -4,11 +4,18 @@
          web-server/http/request
          web-server/http/request-structs
          net/websocket/conn
-         net/websocket/handshake)
+         net/websocket/handshake
+         openssl)
 (provide (except-out (all-from-out net/websocket/conn) ws-conn))
 
+(define (ws-secure-url? u)
+  (and (url? u)
+       (equal? (url-scheme u) "wss")))
+
 (define (ws-url? u)
-  (and (url? u) (equal? (url-scheme u) "ws")))
+  (and (url? u)
+       (or (equal? (url-scheme u) "ws")
+           (ws-secure-url? u))))
 
 (provide/contract
  [ws-url? (-> any/c boolean?)]
@@ -41,20 +48,23 @@
                             pre-path)
                      pre-path)))))
   ; Connect
-  (define-values (ip op) (tcp-connect host port))
+  (define connect (if (ws-secure-url? url) ssl-connect tcp-connect))
+  (define-values (ip op) (ssl-connect host port))
   ; Handshake (client)
-  (fprintf op "GET ~a HTTP/1.1\r\n" the-path)
   (define-values (key1 key2 key3 client-ans) (generate-key))
-  (print-headers 
-   op
-   (list* (make-header #"Host" (string->bytes/utf-8 host))
-          (make-header #"Connection" #"Upgrade")
-          (make-header #"Upgrade" #"WebSocket")
-          (make-header #"Sec-WebSocket-Key1" (string->bytes/utf-8 key1))
-          (make-header #"Sec-WebSocket-Key2" (string->bytes/utf-8 key2))
-          headers))
-  
-  (write-bytes key3 op)
+  (write-bytes (call-with-output-bytes
+                (λ (op)
+                  (fprintf op "GET ~a HTTP/1.1\r\n" the-path)
+                  (print-headers
+                   op
+                   (list* (make-header #"Host" (string->bytes/utf-8 host))
+                          (make-header #"Connection" #"Upgrade")
+                          (make-header #"Upgrade" #"WebSocket")
+                          (make-header #"Sec-WebSocket-Key1" (string->bytes/utf-8 key1))
+                          (make-header #"Sec-WebSocket-Key2" (string->bytes/utf-8 key2))
+                          headers))
+                  (write-bytes key3 op)))
+               op)
   (flush-output op)
   ; Handshake (server)
   (define sresponse (read-bytes-line ip 'any))