suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding WebSocket support

Browse Source 
original commit: 347e946548
This commit is contained in:
Jay McCarthy 2010-08-19 16:33:27 -06:00
parent 98c8c339e6
commit 1adbeaa73f
3 changed files with 215 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/net/scribblings/net.scrbl
View File

@ -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"]

116
collects/net/scribblings/websocket.scrbl Normal file
View File

@ -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)))
]

98
collects/tests/net/websocket.rkt Normal file
View File

@ -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)))))