adjusted the framework preferences system to work better with failures under windows
original commit: cde613218e
This commit is contained in:
Robby Findler
commit
5b5c803b8c
|
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
@include-section["url.scrbl"]
|
@include-section["url.scrbl"]
|
||||||
@include-section["uri-codec.scrbl"]
|
@include-section["uri-codec.scrbl"]
|
||||||
|
@include-section["websocket.scrbl"]
|
||||||
@include-section["ftp.scrbl"]
|
@include-section["ftp.scrbl"]
|
||||||
@include-section["sendurl.scrbl"]
|
@include-section["sendurl.scrbl"]
|
||||||
@include-section["smtp.scrbl"]
|
@include-section["smtp.scrbl"]
|
||||||
|
|
|
||||||
121
collects/net/scribblings/websocket.scrbl
Normal file
121
collects/net/scribblings/websocket.scrbl
Normal file
|
|
@ -0,0 +1,121 @@
|
||||||
|
#lang scribble/doc
|
||||||
|
@(require "common.ss"
|
||||||
|
scribble/bnf
|
||||||
|
(for-label net/url
|
||||||
|
unstable/contract
|
||||||
|
web-server/http
|
||||||
|
racket/list
|
||||||
|
racket/async-channel
|
||||||
|
(prefix-in raw: (for-label net/tcp-unit))
|
||||||
|
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"] or @litchar["wss"]. }
|
||||||
|
|
||||||
|
@defproc[(wss-url? [x any/c]) boolean?]{ Returns true if @racket[x] is a @racket[url?] and has a @racket[url-scheme] equal to @litchar["wss"]. }
|
||||||
|
|
||||||
|
@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)))]
|
||||||
|
[#: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]
|
||||||
|
[#: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")].
|
||||||
|
|
||||||
|
The @racket[#:tcp@] keyword is provided for building an SSL server.
|
||||||
|
}
|
||||||
|
|
||||||
|
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)))
|
||||||
|
]
|
||||||
|
|
@ -13,7 +13,9 @@
|
||||||
|
|
||||||
(define separate-by-default?
|
(define separate-by-default?
|
||||||
;; internal configuration, 'browser-default lets some browsers decide
|
;; internal configuration, 'browser-default lets some browsers decide
|
||||||
(get-preference 'new-browser-for-urls (lambda () 'browser-default)))
|
(get-preference 'new-browser-for-urls
|
||||||
|
(lambda () 'browser-default)
|
||||||
|
#:timeout-lock-there (lambda (path) 'browser-default)))
|
||||||
|
|
||||||
;; all possible unix browsers, filtered later to just existing executables
|
;; all possible unix browsers, filtered later to just existing executables
|
||||||
;; order matters: the default will be the first of these that is found
|
;; order matters: the default will be the first of these that is found
|
||||||
|
|
|
||||||
|
|
@ -1,19 +1,227 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
(require net/ftp tests/eli-tester)
|
(require net/ftp tests/eli-tester)
|
||||||
|
|
||||||
(define server "ftp.gnu.org")
|
(define (tcp-serve-port cop tp)
|
||||||
(define port 21)
|
(define listener (tcp-listen 0))
|
||||||
(define user "anonymous")
|
(define-values (_1 the-port _2 _3) (tcp-addresses listener #t))
|
||||||
(define passwd "nonny")
|
(values
|
||||||
|
(thread
|
||||||
|
(λ ()
|
||||||
|
(define-values (ip op) (tcp-accept listener))
|
||||||
|
(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)
|
||||||
|
(quotient/remainder n 256))
|
||||||
|
|
||||||
(provide tests)
|
(provide tests)
|
||||||
(define (tests)
|
(define (tests)
|
||||||
|
(define cop (open-output-string))
|
||||||
|
(define-values (pasv1-thread pasv1-port)
|
||||||
|
(tcp-serve-port (current-output-port) (open-input-string #<<END
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jan 16 2004 3dldf
|
||||||
|
-rw-r--r-- 1 1003 65534 1492 Jan 25 2001 =README
|
||||||
|
-rw-r--r-- 1 1003 65534 745 Mar 20 1997 =README-about-.diff-files
|
||||||
|
-rw-r--r-- 1 1003 65534 1042 Jan 08 2000 =README-about-.gz-files
|
||||||
|
drwxrwxr-x 3 0 1003 4096 Feb 08 2005 GNUinfo
|
||||||
|
drwxrwsr-x 3 0 1003 4096 Aug 14 2003 GNUsBulletins
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Mar 25 18:42 Licenses
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 MailingListArchives
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 MicrosPorts
|
||||||
|
-rw-r--r-- 1 1003 65534 29107 May 03 1998 ProgramIndex
|
||||||
|
-rw-r--r-- 1 1003 65534 257 Jun 12 2000 README.DESCRIPTIONS
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Dec 29 2007 a2ps
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Feb 12 16:45 acct
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jun 09 2006 adns
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 14 2008 aeneas
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Dec 20 2008 anubis
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Feb 24 00:20 archimedes
|
||||||
|
drwxrwxr-x 4 0 1003 4096 Apr 16 2008 aspell
|
||||||
|
lrwxr-xr-x 1 0 0 15 Mar 11 2005 aspell-dict-csb -> aspell/dict/csb
|
||||||
|
lrwxrwxrwx 1 0 0 14 Nov 24 2003 aspell-dict-ga -> aspell/dict/ga
|
||||||
|
lrwxrwxrwx 1 0 0 14 Mar 22 2004 aspell-dict-hr -> aspell/dict/hr
|
||||||
|
lrwxrwxrwx 1 0 0 14 Mar 12 2004 aspell-dict-is -> aspell/dict/is
|
||||||
|
lrwxrwxrwx 1 0 0 14 Nov 24 2003 aspell-dict-it -> aspell/dict/it
|
||||||
|
lrwxrwxrwx 1 0 0 14 Apr 26 2004 aspell-dict-sk -> aspell/dict/sk
|
||||||
|
drwxrwxr-x 13 0 1003 8192 Jul 03 14:05 auctex
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 18:10 autoconf
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 06 14:30 autoconf-archive
|
||||||
|
drwxrwxr-x 32 0 1003 4096 Jul 25 18:10 autogen
|
||||||
|
drwxrwxr-x 2 0 1003 8192 Dec 08 2009 automake
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 26 2007 avl
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 15 2009 ballandpaddle
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 barcode
|
||||||
|
drwxrwxr-x 8 0 1003 4096 Jan 18 2010 bash
|
||||||
|
drwxrwxr-x 3 0 1003 8192 Jan 18 2007 bayonne
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 bc
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Mar 03 15:25 binutils
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 06 02:25 bison
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 bool
|
||||||
|
drwxr-xr-x 10 1003 1003 4096 Jul 30 2007 bpel2owfn
|
||||||
|
-rw-r--r-- 1 1003 65534 420 Nov 15 2000 brl.README
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 calc
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Dec 16 2008 ccaudio
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Oct 25 2009 ccrtp
|
||||||
|
drwxrwxr-x 2 0 1003 8192 May 19 00:50 ccscript
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 cfengine
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 11 2009 cflow
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Nov 14 2009 cgicc
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jan 12 2004 chess
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 cim
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Mar 25 17:25 classpath
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Apr 28 2007 classpathx
|
||||||
|
drwxrwxr-x 6 0 1003 4096 Jul 07 17:30 clisp
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 clx
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jun 05 2004 combine
|
||||||
|
lrwxrwxrwx 1 0 0 9 Nov 18 2003 commonc++ -> commoncpp
|
||||||
|
drwxrwxr-x 2 0 1003 8192 Aug 11 06:30 commoncpp
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Feb 13 2008 config
|
||||||
|
drwxrwxr-x 2 0 1003 8192 Apr 23 16:45 coreutils
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Mar 10 13:20 cpio
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Aug 02 2003 cpp2html
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Mar 18 06:45 cppi
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Apr 11 2009 cssc
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Feb 21 2008 dap
|
||||||
|
-rw-r--r-- 1 1003 65534 110 Jun 06 1999 dc.README
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Feb 11 2009 ddd
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Apr 06 18:50 ddrescue
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jan 30 2004 dejagnu
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 07 20:50 denemo
|
||||||
|
-rw-r--r-- 1 1003 65534 145 May 22 2001 dia.README
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jul 07 19:35 dico
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Sep 17 2007 diction
|
||||||
|
-rw-r--r-- 1 1003 65534 134 Apr 15 2002 dictionary.README
|
||||||
|
drwxrwxr-x 2 0 1003 4096 May 03 17:00 diffutils
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Apr 11 11:55 dionysus
|
||||||
|
drwxrwxr-x 2 0 0 4096 Apr 03 2007 dismal
|
||||||
|
-rw-r--r-- 1 1003 65534 492 Apr 03 2007 djgpp.README
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Feb 18 2005 dominion
|
||||||
|
drwxrwxr-x 5 0 1003 4096 Dec 10 2008 dotgnu
|
||||||
|
-rw-r--r-- 1 1003 65534 96 Feb 09 1999 dumb.README
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jul 10 2009 ed
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Apr 08 18:05 edma
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Feb 17 00:20 electric
|
||||||
|
-rw-r--r-- 1 1003 65534 835 Jan 24 1999 elisp-archive.README
|
||||||
|
drwxrwxr-x 3 0 1003 4096 May 08 04:01 emacs
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Sep 16 2008 emms
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jun 01 23:25 enscript
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jan 26 2008 erc
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Jan 10 2010 fdisk
|
||||||
|
drwxr-xr-x 2 1003 1003 4096 Nov 16 2008 ferret
|
||||||
|
drwxrwxr-x 2 0 1003 4096 Jun 06 2009 findutils
|
||||||
|
drwxrwxr-x 2 0 0 4096 Mar 20 2007 flex
|
||||||
|
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)
|
||||||
|
(tcp-serve-port (current-output-port) (open-input-string #<<END
|
||||||
|
1) Sometimes diffs between two versions were either too large to be
|
||||||
|
worth making, or too difficult. In those cases where a .diff file is
|
||||||
|
missing, please just FTP the latest version.
|
||||||
|
|
||||||
|
2) The .diff file suffix signifies a patch file produced by the GNU
|
||||||
|
'diff' program.
|
||||||
|
|
||||||
|
A diff file like this has all of the changes from one version of a
|
||||||
|
program to the next (i.e. gcc-2.6.2-2.6.3.diff will take gcc-2.6.2 and
|
||||||
|
produce gcc 2.6.3).
|
||||||
|
|
||||||
|
You can use the "patch" program to apply the diff to your sources.
|
||||||
|
(The "patch" program is available on prep.ai.mit.edu in directory
|
||||||
|
/pub/gnu/ if it isn't already installed on your system.)
|
||||||
|
|
||||||
|
(You might also want to take a look at the diff file, the format is
|
||||||
|
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)
|
||||||
|
(tcp-serve-port cop (open-input-string (format #<<END
|
||||||
|
220 GNU FTP server ready.
|
||||||
|
230-Due to U.S. Export Regulations, all cryptographic software on this
|
||||||
|
230-site is subject to the following legal notice:
|
||||||
|
230-
|
||||||
|
230- This site includes publicly available encryption source code
|
||||||
|
230- which, together with object code resulting from the compiling of
|
||||||
|
230- publicly available source code, may be exported from the United
|
||||||
|
230- States under License Exception "TSU" pursuant to 15 C.F.R. Section
|
||||||
|
230- 740.13(e).
|
||||||
|
230-
|
||||||
|
230-This legal notice applies to cryptographic software only. Please see
|
||||||
|
230-the Bureau of Industry and Security (www.bxa.doc.gov) for more
|
||||||
|
230-information about current U.S. regulations.
|
||||||
|
230 Login successful.
|
||||||
|
250-If you have problems downloading and are seeing "Access denied" or
|
||||||
|
250-"Permission denied", please make sure that you started your FTP client
|
||||||
|
250-in a directory to which you have write permission.
|
||||||
|
250-
|
||||||
|
250-Please note that all files ending in `.gz' are compressed with `gzip',
|
||||||
|
250-not with the unix `compress' program. Get the file below for more
|
||||||
|
250-info.
|
||||||
|
250-
|
||||||
|
250-For a list of mirrors and other ways of getting GNU software, FTP the
|
||||||
|
250-file /pub/gnu/GNUinfo/FTP from ftp.gnu.org or one of its mirror sites.
|
||||||
|
250-
|
||||||
|
250-Programs that are directly in this directory are actually GNU
|
||||||
|
250-programs, developed under the auspices of GNU.
|
||||||
|
250-
|
||||||
|
250-We do, however, distribute some non-GNU programs through our FTP
|
||||||
|
250-server, or provide pointers to where they are. We put these
|
||||||
|
250-programs/pointers in the subdirectory non-gnu since they are not
|
||||||
|
250-developed by the GNU project. They are, of course, part of the GNU
|
||||||
|
250-system. See:
|
||||||
|
250-http://www.gnu.org/philosophy/categories.html#TheGNUsystem
|
||||||
|
250 Directory successfully changed.
|
||||||
|
227 Entering Passive Mode (127,0,0,1,~a,~a)
|
||||||
|
200 Switching to Binary mode.
|
||||||
|
150 Here comes the directory listing.
|
||||||
|
226 Directory send OK.
|
||||||
|
227 Entering Passive Mode (127,0,0,1,~a,~a)
|
||||||
|
200 Switching to Binary mode.
|
||||||
|
150 Opening BINARY mode data connection for =README-about-.diff-files (745 bytes).
|
||||||
|
226 File send OK.
|
||||||
|
221 Goodbye.
|
||||||
|
|
||||||
|
END
|
||||||
|
pasv1-port-maj pasv1-port-min
|
||||||
|
pasv2-port-maj pasv2-port-min
|
||||||
|
))))
|
||||||
|
|
||||||
|
(define server "localhost")
|
||||||
|
(define port main-port)
|
||||||
|
(define user "anonymous")
|
||||||
|
(define passwd "nonny")
|
||||||
(define conn #f)
|
(define conn #f)
|
||||||
(define pth "=README-about-.diff-files")
|
(define pth "=README-about-.diff-files")
|
||||||
(define tmp-dir (make-temporary-file "ftp~a" 'directory))
|
(define tmp-dir (make-temporary-file "ftp~a" 'directory))
|
||||||
(test (ftp-connection? 1) => #f
|
(test (ftp-port-split 18291) => (values 71 115)
|
||||||
|
(ftp-connection? 1) => #f
|
||||||
(set! conn (ftp-establish-connection server port user passwd))
|
(set! conn (ftp-establish-connection server port user passwd))
|
||||||
(ftp-connection? conn)
|
(ftp-connection? conn)
|
||||||
|
(when (ftp-connection? conn)
|
||||||
|
(test
|
||||||
(ftp-cd conn "gnu")
|
(ftp-cd conn "gnu")
|
||||||
(for ([f (in-list (ftp-directory-list conn))])
|
(for ([f (in-list (ftp-directory-list conn))])
|
||||||
(match-define (list type ftp-date name) f)
|
(match-define (list type ftp-date name) f)
|
||||||
|
|
@ -21,7 +229,30 @@
|
||||||
(ftp-make-file-seconds ftp-date)))
|
(ftp-make-file-seconds ftp-date)))
|
||||||
|
|
||||||
(ftp-download-file conn tmp-dir pth)
|
(ftp-download-file conn tmp-dir pth)
|
||||||
|
|
||||||
|
(ftp-close-connection conn)
|
||||||
|
|
||||||
(delete-file (build-path tmp-dir pth))
|
(delete-file (build-path tmp-dir pth))
|
||||||
(delete-directory/files tmp-dir)
|
(delete-directory/files tmp-dir)
|
||||||
|
|
||||||
(ftp-close-connection conn)))
|
(thread-wait pasv1-thread)
|
||||||
|
(thread-wait pasv2-thread)
|
||||||
|
(thread-wait main-thread)
|
||||||
|
|
||||||
|
(get-output-string cop) =>
|
||||||
|
#<<END
|
||||||
|
USER anonymous
|
||||||
|
CWD gnu
|
||||||
|
PASV
|
||||||
|
TYPE I
|
||||||
|
LIST
|
||||||
|
PASV
|
||||||
|
TYPE I
|
||||||
|
RETR =README-about-.diff-files
|
||||||
|
QUIT
|
||||||
|
|
||||||
|
END
|
||||||
|
|
||||||
|
))))
|
||||||
|
|
||||||
|
(tests)
|
||||||
34
collects/tests/net/stress/websocket.rkt
Normal file
34
collects/tests/net/stress/websocket.rkt
Normal file
|
|
@ -0,0 +1,34 @@
|
||||||
|
#lang racket/base
|
||||||
|
(require tests/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))))))
|
||||||
|
|
||||||
|
(shutdown!)))
|
||||||
55
collects/tests/net/url-port.rkt
Normal file
55
collects/tests/net/url-port.rkt
Normal file
|
|
@ -0,0 +1,55 @@
|
||||||
|
#lang racket
|
||||||
|
(require net/url
|
||||||
|
mzlib/thread
|
||||||
|
tests/eli-tester)
|
||||||
|
|
||||||
|
(define ((make-tester url->port) response)
|
||||||
|
(define port-no 9001)
|
||||||
|
(define server-cust
|
||||||
|
(make-custodian))
|
||||||
|
(parameterize ([current-custodian server-cust])
|
||||||
|
(thread
|
||||||
|
(λ ()
|
||||||
|
(run-server port-no
|
||||||
|
(lambda (ip op)
|
||||||
|
(thread (λ () (port->string ip)))
|
||||||
|
(display response op)
|
||||||
|
(flush-output op))
|
||||||
|
+inf.0))))
|
||||||
|
(sleep 1)
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(port->string
|
||||||
|
(url->port
|
||||||
|
(url "http" #f "localhost" port-no
|
||||||
|
#t empty empty #f))))
|
||||||
|
(λ ()
|
||||||
|
(custodian-shutdown-all server-cust))))
|
||||||
|
|
||||||
|
(define get-pure
|
||||||
|
(make-tester get-pure-port))
|
||||||
|
(define get-impure
|
||||||
|
(make-tester get-impure-port))
|
||||||
|
|
||||||
|
(test
|
||||||
|
(get-pure
|
||||||
|
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
|
||||||
|
=>
|
||||||
|
"This is the data in the first chunk and this is the second one"
|
||||||
|
|
||||||
|
(get-pure
|
||||||
|
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
|
||||||
|
=>
|
||||||
|
"This is the data in the first chunk and this is the second one"
|
||||||
|
|
||||||
|
(get-impure
|
||||||
|
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n")
|
||||||
|
=>
|
||||||
|
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n"
|
||||||
|
|
||||||
|
(get-impure
|
||||||
|
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n")
|
||||||
|
=>
|
||||||
|
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n"
|
||||||
|
)
|
||||||
98
collects/tests/net/websocket.rkt
Normal file
98
collects/tests/net/websocket.rkt
Normal 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)))))
|
||||||
36
collects/tests/net/websocket/example.rkt
Normal file
36
collects/tests/net/websocket/example.rkt
Normal file
|
|
@ -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)
|
||||||
|
(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))
|
||||||
25
collects/tests/net/websocket/index.html
Normal file
25
collects/tests/net/websocket/index.html
Normal file
|
|
@ -0,0 +1,25 @@
|
||||||
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||||
|
<html xmlns="http://www.w3.org/1999/xhtml">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
|
||||||
|
<title>Websocket Test</title>
|
||||||
|
<link rel="stylesheet" href="style.css" type="text/css"/>
|
||||||
|
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.1/jquery.min.js"></script>
|
||||||
|
<script src="script.js"></script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<div id="body">
|
||||||
|
<div id="inbox">
|
||||||
|
</div>
|
||||||
|
<div id="input">
|
||||||
|
<form action="#" method="post" id="commandForm" onSubmit="return newCommand()">
|
||||||
|
<fieldset>
|
||||||
|
<legend>Command</legend>
|
||||||
|
<input id="commandInput" type="text" style="width:500px" />
|
||||||
|
<input id="submit" type="submit" value="Send" />
|
||||||
|
</fieldset>
|
||||||
|
</form>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
72
collects/tests/net/websocket/script.js
Normal file
72
collects/tests/net/websocket/script.js
Normal file
|
|
@ -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 = $("<p>" + message + "</p>");
|
||||||
|
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;
|
||||||
|
};
|
||||||
48
collects/tests/net/websocket/style.css
Normal file
48
collects/tests/net/websocket/style.css
Normal file
|
|
@ -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;
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user