From 1adbeaa73ff68425e0d451887a3d2264b7ed5a10 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 19 Aug 2010 16:33:27 -0600 Subject: [PATCH] Adding WebSocket support original commit: 347e946548c26bd51b682284816aa7f6f34b2d92 --- collects/net/scribblings/net.scrbl | 1 + collects/net/scribblings/websocket.scrbl | 116 +++++++++++++++++++++++ collects/tests/net/websocket.rkt | 98 +++++++++++++++++++ 3 files changed, 215 insertions(+) create mode 100644 collects/net/scribblings/websocket.scrbl create mode 100644 collects/tests/net/websocket.rkt diff --git a/collects/net/scribblings/net.scrbl b/collects/net/scribblings/net.scrbl index 23128e0fda..280a0c153e 100644 --- a/collects/net/scribblings/net.scrbl +++ b/collects/net/scribblings/net.scrbl @@ -7,6 +7,7 @@ @include-section["url.scrbl"] @include-section["uri-codec.scrbl"] +@include-section["websocket.scrbl"] @include-section["ftp.scrbl"] @include-section["sendurl.scrbl"] @include-section["smtp.scrbl"] diff --git a/collects/net/scribblings/websocket.scrbl b/collects/net/scribblings/websocket.scrbl new file mode 100644 index 0000000000..c887c99dc1 --- /dev/null +++ b/collects/net/scribblings/websocket.scrbl @@ -0,0 +1,116 @@ +#lang scribble/doc +@(require "common.ss" + scribble/bnf + (for-label net/url + unstable/contract + web-server/http + racket/list + racket/async-channel + net/websocket + net/websocket/client + net/websocket/server + net/websocket/conn)) + +@title[#:tag "websocket"]{WebSocket} + +@defmodule[net/websocket] + +The @racketmodname[net/websocket] library provides +utilities to run and communicate with WebSocket servers, +as specified in @link["http://www.whatwg.org/specs/web-socket-protocol/"]{the WebSocket protocol} IETF draft +as of August 16th, 2010. + +This module provides the exports from @racketmodname[net/websocket/client] and @racketmodname[net/websocket/server]. + +@section{Client API} + +@defmodule[net/websocket/client] + +@defproc[(ws-url? [x any/c]) boolean?]{ Returns true if @racket[x] is a @racket[url?] and has a @racket[url-scheme] equal to @litchar["ws"]. } + +@defproc[(ws-connect [u ws-url?] + [#:headers headers (listof header?) empty]) + open-ws-conn?]{ + Connects to the WebSocket server specified by @racket[u], providing @racket[headers] as additional headers. + Returns the connection handle. +} + +This module also provides the exports from @racketmodname[net/websocket/conn]. + +@section{Server API} + +@defmodule[net/websocket/server] + +@defproc[(ws-serve [conn-handle (open-ws-conn? any/c . -> . void)] + [#:conn-headers + conn-headers + (bytes? (listof header?) . -> . (values (listof header?) any/c)) + (λ (b hs) (values empty (void)))] + [#:port port tcp-listen-port? 80] + [#:listen-ip listen-ip (or/c string? false/c) #f] + [#:max-waiting max-waiting integer? 4] + [#:timeout timeout integer? (* 60 60)] + [#:confirmation-channel + confirm-ch + (or/c false/c async-channel?) + #f]) + (-> void)]{ + + Starts a WebSocket server where each new connection uses @racket[conn-headers] to compute + what headers the client receives based on the client's request line and headers. @racket[conn-headers] + also returns a piece of state that will be passed to @racket[conn-handle] as its second argument. + After the connection handshake is finished, @racket[conn-handle] receives the connection and is in + sole control until the WebSocket connection completes. + + All other arguments are used as in a @secref["dispatch-server-unit" #:doc '(lib "web-server/scribblings/web-server-internal.scrbl")]. + +} + +This module also provides the exports from @racketmodname[net/websocket/conn]. + +@section{Connections} + +@defmodule[net/websocket/conn] + +@defparam[framing-mode mode (symbols 'old 'new)]{ Controls whether framing is as before August 16th, 2010 or after. (Most Web browsers currently support only @racket['old] and they are incompatible, so you must choose the correct one.) Defaults to @racket['old].} + +@defproc[(ws-conn? [x any/c]) boolean?]{ Returns true if @racket[x] is a WebSocket connection. } + +@defproc[(open-ws-conn? [x any/c]) boolean?]{ Returns true if @racket[x] is an open WebSocket connection. } + +@defproc[(ws-conn-line [ws ws-conn?]) bytes?]{ Returns the request/response line of the WebSocket connection. } +@defproc[(ws-conn-closed? [ws ws-conn?]) boolean?]{ Returns true if the WebSocket connection has been closed. } +@defproc[(ws-conn-headers [ws ws-conn?]) (listof header?)]{ Returns the headers of the WebSocket connection. } + +WebSocket connection support only blocking calls: + +@defproc[(ws-send! [ws open-ws-conn?] [s string?]) void]{ Sends @racket[s] over @racket[ws]. } +@defproc[(ws-recv [ws open-ws-conn?]) (or/c string? eof-object?)]{ Receives a string from @racket[ws]. Returns @racket[eof] if the other end closes the connection. } + +@defproc[(ws-close! [ws open-ws-conn?]) void]{ Closes @racket[ws]. } + +@section{Example} + +This is a WebSocket echo server compatible with the browser origin security model: + +@racketblock[ +(ws-serve + #:port 8080 + (λ (wsc _) + (let loop () + (define m (ws-recv wsc)) + (printf "~a\n" m) + (unless (eof-object? m) + (ws-send! wsc m) + (loop)))) + #:conn-headers + (λ (_ hs) + (define origin + (header-value (headers-assq* #"Origin" hs))) + (values + (list + (make-header #"Sec-WebSocket-Origin" origin) + (make-header #"Sec-WebSocket-Location" + #"ws://localhost:8080/")) + #f))) +] diff --git a/collects/tests/net/websocket.rkt b/collects/tests/net/websocket.rkt new file mode 100644 index 0000000000..f9d3a9fca7 --- /dev/null +++ b/collects/tests/net/websocket.rkt @@ -0,0 +1,98 @@ +#lang racket +(require net/websocket/client + net/websocket/server + net/websocket/conn + net/websocket/handshake + racket/async-channel + net/url + rackunit + tests/eli-tester) + +(define RANDOM-K 100) + +(test + (for ([i (in-range RANDOM-K)]) + (define o (random 256)) + (define t (random 256)) + (define bot (if (o . < . t) o t)) + (define top (if (o . < . t) t o)) + (define botc (integer->char bot)) + (define topc (integer->char top)) + (test #:failure-prefix (format "~a / ~a" botc topc) + (<= bot (char->integer (random-char-between botc topc)) top))) + + (for ([i (in-range RANDOM-K)]) + (test (char-alphabetic? (random-alpha-char)))) + + (count-spaces "") => 0 + (count-spaces " ") => 3 + (count-spaces (make-string RANDOM-K #\space)) => RANDOM-K + + (count-spaces "18x 6]8vM;54 *(5: { U1]8 z [ 8") => 12 + (count-spaces "1_ tx7X d < nw 334J702) 7]o}` 0") => 10 + + (for ([i (in-range RANDOM-K)]) + (define len (add1 i)) + (define s (make-string len #\0)) + (define how-many (random len)) + (test (count-spaces (add-spaces how-many s)) => how-many)) + + (remove-alphas "A0A") => "0" + (remove-alphas "0") => "0" + (remove-alphas (make-string RANDOM-K #\A)) => "" + + (remove-alphas "18x 6]8vM;54 *(5: { U1]8 z [ 8") => "1868545188" + (remove-alphas "1_ tx7X d < nw 334J702) 7]o}` 0") => "1733470270" + + (for ([i (in-range RANDOM-K)]) + (define s (number->string i)) + (test (remove-alphas (add-alphas s)) => s)) + + (key->number "18x 6]8vM;54 *(5: { U1]8 z [ 8") => 155712099 + (key->number "1_ tx7X d < nw 334J702) 7]o}` 0") => 173347027 + + (for ([i (in-range RANDOM-K)]) + (test (key->number (number->key i)) => i)) + + (for ([i (in-range RANDOM-K)]) + (define-values (k1 k2 k3 ans) (generate-key)) + (test (handshake-solution k1 k2 k3) => ans)) + + (handshake-solution "18x 6]8vM;54 *(5: { U1]8 z [ 8" + "1_ tx7X d < nw 334J702) 7]o}` 0" + #"Tm[K T2u") + => + #"fQJ,fN/4F4!~K~MH" + + (local [(define (test-echo-server) + (define conn #f) + (define r (number->string (random 1000))) + (define shutdown! #f) + (define p #f) + (define confirm (make-async-channel)) + + (test (set! shutdown! + (ws-serve #:port 0 + #:confirmation-channel confirm + (λ (wsc _) + (let loop () + (define m (ws-recv wsc)) + (unless (eof-object? m) + (ws-send! wsc m) + (loop)))))) + shutdown! + (set! p (async-channel-get confirm)) + p + (set! conn (ws-connect (string->url (format "ws://localhost:~a" p)))) + conn + (ws-send! conn r) + (ws-recv conn) => r + (ws-send! conn "a") + (ws-recv conn) => "a" + (ws-close! conn) + (shutdown!)))] + (test + #:failure-prefix "old" + (parameterize ([framing-mode 'old]) (test-echo-server)) + #:failure-prefix "new" + (parameterize ([framing-mode 'new]) (test-echo-server))))) \ No newline at end of file