summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-03-25 16:20:48 -0400
committerDavid Thompson <dthompson2@worcester.edu>2016-03-25 16:20:48 -0400
commit581482b4631cfa49d439b6574faf075daa7ebf7b (patch)
tree80d0ca8597bab93e4673a3a3dacf207ea0dcc994
parent5cc3adb20f2fcc091540a1fa035f668e57ea2a83 (diff)
client: Generate random nonce for handshake.
* web/socket/client.scm (generate-websocket-nonce): New procedure. (make-handshake-request): Change argument from uri to websocket. Generate a real nonce for Sec-WebSocket-Key header. (handshake): Adjust make-handshake-request call.
-rw-r--r--web/socket/client.scm16
1 files changed, 11 insertions, 5 deletions
diff --git a/web/socket/client.scm b/web/socket/client.scm
index 5712cd5..8bd0c3d 100644
--- a/web/socket/client.scm
+++ b/web/socket/client.scm
@@ -111,21 +111,27 @@ scheme."
"Return #t if the WebSocket WS is in the closed state."
(eq? (websocket-state ws) 'closed))
+(define (generate-websocket-nonce ws)
+ "Return a random, base64 encoded nonce using the entropy source of
+WS."
+ (base64-encode
+ (get-bytevector-n (websocket-entropy-port ws) 16)))
+
;; See Section 4.1 - Client Requirements
-(define (make-handshake-request uri)
+(define (make-handshake-request ws)
"Create an HTTP request for initiating a WebSocket connect with the
remote resource described by URI."
- (let ((headers `((host . (,(uri-host uri) . #f))
+ (let* ((uri (websocket-uri ws))
+ (headers `((host . (,(uri-host uri) . #f))
(upgrade . ("WebSocket"))
(connection . (upgrade))
- ;; TODO: Generate a real key.
- (sec-websocket-key . "AQIDBAUGBwgJCgsMDQ4PEC==")
+ (sec-websocket-key . ,(generate-websocket-nonce ws))
(sec-websocket-version . "13"))))
(build-request uri #:method 'GET #:headers headers)))
(define (handshake ws)
"Perform the WebSocket handshake for the client WS."
- (write-request (make-handshake-request (websocket-uri ws))
+ (write-request (make-handshake-request ws)
(websocket-socket ws))
(let* ((response (read-response (websocket-socket ws)))
(headers (response-headers response))