From a5c309a12b64bd2dddb1e6022a9487e78fc302a8 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 29 Jun 2010 13:23:23 -0600 Subject: [PATCH 1/8] Nail down port and dont conflict original commit: 2e5c04f083c53a9aac18409720e3e1ba905f3be0 --- collects/tests/net/url-port.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/tests/net/url-port.rkt b/collects/tests/net/url-port.rkt index 6e4f5ddea8..5c12e5bc81 100644 --- a/collects/tests/net/url-port.rkt +++ b/collects/tests/net/url-port.rkt @@ -4,7 +4,7 @@ tests/eli-tester) (define ((make-tester url->port) response) - (define port-no (+ 9000 (random 100))) + (define port-no 9001) (define server-cust (make-custodian)) (parameterize ([current-custodian server-cust]) From a616f14181e72f546800f0a48d837498b7c27764 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 29 Jun 2010 13:49:01 -0600 Subject: [PATCH 2/8] Close connection sooner original commit: fc91321f21cbbecd19297f739203d8fb6123b7af --- collects/tests/net/ftp.rkt | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/collects/tests/net/ftp.rkt b/collects/tests/net/ftp.rkt index 511586b168..11554516dc 100644 --- a/collects/tests/net/ftp.rkt +++ b/collects/tests/net/ftp.rkt @@ -21,7 +21,8 @@ (ftp-make-file-seconds ftp-date))) (ftp-download-file conn tmp-dir pth) - (delete-file (build-path tmp-dir pth)) - (delete-directory/files tmp-dir) - (ftp-close-connection conn))) \ No newline at end of file + (ftp-close-connection conn) + + (delete-file (build-path tmp-dir pth)) + (delete-directory/files tmp-dir))) \ No newline at end of file From 1adbeaa73ff68425e0d451887a3d2264b7ed5a10 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 19 Aug 2010 16:33:27 -0600 Subject: [PATCH 3/8] 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 From 646061cf40246f754f82967e4a001a6d93a5b832 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 19 Aug 2010 16:32:33 -0600 Subject: [PATCH 4/8] Adding WebSocket example original commit: 1f61e7eb7f010f2474b78a552c5b2c9483442002 --- collects/tests/net/websocket/example.rkt | 36 ++++++++++++ collects/tests/net/websocket/index.html | 25 ++++++++ collects/tests/net/websocket/script.js | 72 ++++++++++++++++++++++++ collects/tests/net/websocket/style.css | 48 ++++++++++++++++ 4 files changed, 181 insertions(+) create mode 100644 collects/tests/net/websocket/example.rkt create mode 100644 collects/tests/net/websocket/index.html create mode 100644 collects/tests/net/websocket/script.js create mode 100644 collects/tests/net/websocket/style.css diff --git a/collects/tests/net/websocket/example.rkt b/collects/tests/net/websocket/example.rkt new file mode 100644 index 0000000000..b8f3e4ce95 --- /dev/null +++ b/collects/tests/net/websocket/example.rkt @@ -0,0 +1,36 @@ +#lang racket +(require net/websocket + web-server/http + racket/runtime-path + web-server/templates + web-server/servlet-env) + +(framing-mode 'old) + +(define stop-ws! + (ws-serve (λ (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)) + #:port 8080)) + +(define-runtime-path example-pth ".") + +(serve/servlet (λ (req) + (make-response/full + 200 #"Okay" + (current-seconds) TEXT/HTML-MIME-TYPE + empty + (list (string->bytes/utf-8 (include-template "index.html"))))) + #:servlet-path "/" + #:port 8081 + #:extra-files-paths (list example-pth)) diff --git a/collects/tests/net/websocket/index.html b/collects/tests/net/websocket/index.html new file mode 100644 index 0000000000..11da6ed2b8 --- /dev/null +++ b/collects/tests/net/websocket/index.html @@ -0,0 +1,25 @@ + + + + + Websocket Test + + + + + +
+
+
+
+
+
+ Command + + +
+
+
+
+ + diff --git a/collects/tests/net/websocket/script.js b/collects/tests/net/websocket/script.js new file mode 100644 index 0000000000..245509c0ea --- /dev/null +++ b/collects/tests/net/websocket/script.js @@ -0,0 +1,72 @@ +var ws; + +$(document).ready(function() { + if (!window.console) window.console = {}; + if (!window.console.log) window.console.log = function() {}; + + ws = new WebSocket("ws://localhost:8080/"); + + ws.onopen = function() { + console.log("websocket connected"); + ws.onmessage = function(event) { + showCommand(eval("\"" + event.data + "\"")); + }; + + $(window).bind('beforeunload', function() { + ws.close(); + }); + }; + + ws.onclose = function() { + console.log("websocket disconnected"); + }; + + $("#commandForm").bind("submit", function(e) { + e.preventDefault(); + e.stopPropagation(); + + newCommand($(this)); + return false; + }); + + $("#commandForm").bind("keypress", function(e) { + if (e.keyCode == 13) { + e.preventDefault(); + e.stopPropagation(); + + newCommand($(this)); + } + }); + + $("#commandInput").select(); +}); + +function newCommand(form) { + var submit = form.find("#commandSubmit"); + var text = form.find("#commandInput"); + submit.disable(); + ws.send(text.val()); + text.val("").select(); + submit.enable(); +} + +function showCommand(message) { + var node = $("

" + message + "

"); + node.hide(); + $("#inbox").append(node); + node.show(); +} + +jQuery.fn.enable = function(opt_enable) { + if (arguments.length && !opt_enable) { + this.attr("disabled", "disabled"); + } else { + this.removeAttr("disabled"); + } + return this; +}; + +jQuery.fn.disable = function() { + this.enable(false); + return this; +}; diff --git a/collects/tests/net/websocket/style.css b/collects/tests/net/websocket/style.css new file mode 100644 index 0000000000..1c40ba43b0 --- /dev/null +++ b/collects/tests/net/websocket/style.css @@ -0,0 +1,48 @@ +body { + background: white; + margin: 10px; +} + +body, +input { + font-family: sans-serif; + font-size: 10pt; + color: black; +} + +table { + border-collapse: collapse; + border: 0; +} + +td { + border: 0; + padding: 0; +} + +#body { + position: absolute; + bottom: 10px; + left: 10px; +} + +#input { + margin-top: 0.5em; +} + +#inbox div { + padding-top: 0.25em; +} + +#nav { + float: right; + z-index: 99; +} + +legend { + display: none; +} + +fieldset { + border: none; +} From 58ec991bd118c43c3a7d3645c8dbf0accc760585 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 19 Aug 2010 16:32:55 -0600 Subject: [PATCH 5/8] Adding WebSocket stress test and improving fit output original commit: 5eb8f181f6993d7ba8a0281772117b1dd75e72c7 --- collects/tests/stress/net/websocket.rkt | 32 +++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 collects/tests/stress/net/websocket.rkt diff --git a/collects/tests/stress/net/websocket.rkt b/collects/tests/stress/net/websocket.rkt new file mode 100644 index 0000000000..da05936bd1 --- /dev/null +++ b/collects/tests/stress/net/websocket.rkt @@ -0,0 +1,32 @@ +#lang racket/base +(require tests/stress/stress + net/websocket + net/url + racket/async-channel) + +(fit "websocket echo server" + 500 + (λ (n) + (define confirm (make-async-channel)) + (define 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)))))) + (define port (async-channel-get confirm)) + + (define THREADS 10) + (define REQS n) + + (for-each thread-wait + (for/list ([t (in-range THREADS)]) + (thread + (λ () + (define conn (ws-connect (string->url (format "ws://localhost:~a" port)))) + (for ([r (in-range REQS)]) + (ws-send! conn "ping") + (ws-recv conn)))))))) From 21c34d29d40069a3550df3a1accbc0f4bda39d8c Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Sat, 28 Aug 2010 18:52:29 -0600 Subject: [PATCH 6/8] Increasing FTP test stability original commit: bc15f398f259af333564a68540482fab81e583d3 --- collects/tests/net/ftp.rkt | 71 +++++++++++++++++++++++--------------- 1 file changed, 43 insertions(+), 28 deletions(-) diff --git a/collects/tests/net/ftp.rkt b/collects/tests/net/ftp.rkt index 88ddaf0078..5007eeb8a6 100644 --- a/collects/tests/net/ftp.rkt +++ b/collects/tests/net/ftp.rkt @@ -8,13 +8,21 @@ (thread (λ () (define-values (ip op) (tcp-accept listener)) - (thread (λ () - (copy-port ip cop) - (flush-output cop) - (close-input-port ip))) - (thread (λ () - (copy-port tp op) - (close-output-port op))))) + (define ip->cop-t + (thread (λ () + (copy-port ip cop)))) + (define tp->op-t + (thread (λ () + (copy-port tp op)))) + + (thread-wait tp->op-t) + (thread-wait ip->cop-t) + + (flush-output op) + (flush-output cop) + + (close-output-port op) + (close-input-port ip))) the-port)) (define (ftp-port-split n) @@ -120,7 +128,7 @@ drwxrwxr-x 2 0 1003 4096 Aug 02 2003 fontutils drwxr-xr-x 2 1003 1003 4096 Apr 20 21:05 freedink drwxrwxr-x 2 0 1003 4096 Jan 04 2009 freefont END - ))) + ))) (define-values (pasv1-port-maj pasv1-port-min) (ftp-port-split pasv1-port)) (define-values (pasv2-thread pasv2-port) @@ -146,7 +154,7 @@ pretty obvious and could be educational. ;-) Thank You! END - ))) + ))) (define-values (pasv2-port-maj pasv2-port-min) (ftp-port-split pasv2-port)) (define-values (main-thread main-port) @@ -197,9 +205,9 @@ END 221 Goodbye. END - pasv1-port-maj pasv1-port-min - pasv2-port-maj pasv2-port-min - )))) + pasv1-port-maj pasv1-port-min + pasv2-port-maj pasv2-port-min + )))) (define server "localhost") (define port main-port) @@ -212,21 +220,27 @@ END (ftp-connection? 1) => #f (set! conn (ftp-establish-connection server port user passwd)) (ftp-connection? conn) - (ftp-cd conn "gnu") - (for ([f (in-list (ftp-directory-list conn))]) - (match-define (list type ftp-date name) f) + (when (ftp-connection? conn) (test - (ftp-make-file-seconds ftp-date))) - - (ftp-download-file conn tmp-dir pth) - - (ftp-close-connection conn) - - (delete-file (build-path tmp-dir pth)) - (delete-directory/files tmp-dir) - - (get-output-string cop) => - #< + #< Date: Mon, 30 Aug 2010 06:38:48 -0600 Subject: [PATCH 7/8] Moving stress tests original commit: f899e03b59b6bb5c65369d2670ee8c116abc7c03 --- collects/tests/{stress/net => net/stress}/websocket.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) rename collects/tests/{stress/net => net/stress}/websocket.rkt (91%) diff --git a/collects/tests/stress/net/websocket.rkt b/collects/tests/net/stress/websocket.rkt similarity index 91% rename from collects/tests/stress/net/websocket.rkt rename to collects/tests/net/stress/websocket.rkt index da05936bd1..76a851064f 100644 --- a/collects/tests/stress/net/websocket.rkt +++ b/collects/tests/net/stress/websocket.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require tests/stress/stress +(require tests/stress net/websocket net/url racket/async-channel) @@ -29,4 +29,6 @@ (define conn (ws-connect (string->url (format "ws://localhost:~a" port)))) (for ([r (in-range REQS)]) (ws-send! conn "ping") - (ws-recv conn)))))))) + (ws-recv conn)))))) + + (shutdown!))) From e0be19cac19f727d72790b9ccf285e03c9cbda28 Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 15 Nov 2010 16:55:21 +0100 Subject: [PATCH 8/8] add #:tcp@ to ws-serve for wss: support original commit: 11f2653b7e20e25d19157f3bdeba73632584f77b --- collects/net/scribblings/websocket.scrbl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/collects/net/scribblings/websocket.scrbl b/collects/net/scribblings/websocket.scrbl index c887c99dc1..5833c5d117 100644 --- a/collects/net/scribblings/websocket.scrbl +++ b/collects/net/scribblings/websocket.scrbl @@ -6,6 +6,7 @@ web-server/http racket/list racket/async-channel + (prefix-in raw: (for-label net/tcp-unit)) net/websocket net/websocket/client net/websocket/server @@ -46,6 +47,7 @@ This module also provides the exports from @racketmodname[net/websocket/conn]. conn-headers (bytes? (listof header?) . -> . (values (listof header?) any/c)) (λ (b hs) (values empty (void)))] + [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:port port tcp-listen-port? 80] [#:listen-ip listen-ip (or/c string? false/c) #f] [#:max-waiting max-waiting integer? 4] @@ -64,6 +66,7 @@ This module also provides the exports from @racketmodname[net/websocket/conn]. All other arguments are used as in a @secref["dispatch-server-unit" #:doc '(lib "web-server/scribblings/web-server-internal.scrbl")]. + The @racket[#:tcp@] keyword is provided for building an SSL server. } This module also provides the exports from @racketmodname[net/websocket/conn].