From 62e93cf2a49ca396f3bae784832be4d477b41377 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Mon, 15 Aug 2011 02:36:56 -0400 Subject: [PATCH] Heavily revise this test. - Simplify code - Remove bogus leftover (tests) in the end - Resolve deadlock that resulted from using `tcp-abandon-port' in `net/ftp' - Actually there's no need for threads, probably because of small size of data, so keep it. - Use scribble syntax instead of here-strings, and move the text out of the way. original commit: f297c98c1a497a71353c544b2613e4146eb6060d --- collects/tests/net/ftp.rkt | 456 ++++++++++++++++++------------------- 1 file changed, 217 insertions(+), 239 deletions(-) diff --git a/collects/tests/net/ftp.rkt b/collects/tests/net/ftp.rkt index bb34481257..7464f1defc 100644 --- a/collects/tests/net/ftp.rkt +++ b/collects/tests/net/ftp.rkt @@ -1,258 +1,236 @@ -#lang racket -(require net/ftp tests/eli-tester) +#lang at-exp racket/base -(define (tcp-serve-port cop tp) +(require net/ftp tests/eli-tester + racket/tcp racket/port racket/file racket/match) + +(define (tcp-serve dest text) (define listener (tcp-listen 0)) - (define-values (_1 the-port _2 _3) (tcp-addresses listener #t)) - (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 the-port (let-values ([(_1 p _2 _3) (tcp-addresses listener #t)]) p)) + (define (feed in out) + (if (input-port? in) (copy-port in out) (display in out)) + (flush-output out)) + (define (feeder) + (define-values [ip op] (tcp-accept listener)) + (for-each thread-wait + (list (thread (λ () (feed text op) (close-output-port op))) + (thread (λ () (feed ip dest) (close-input-port ip)))))) + (values (thread feeder) the-port)) -(define (ftp-port-split n) - (quotient/remainder n 256)) +(define (port->splitstr n) + (let-values ([(q r) (quotient/remainder n 256)]) (format "~a,~a" q r))) +(define (tcp-serve* dest text) + (define-values [thd port] (tcp-serve dest text)) + (values thd (port->splitstr port))) (provide tests) (define (tests) (define cop (open-output-string)) - (define-values (pasv1-thread pasv1-port) - (tcp-serve-port (current-output-port) (open-input-string #< 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 #< (values 71 115) + (define tmp-dir (make-temporary-file "racket-ftp-test-~a" 'directory)) + (test (port->splitstr 18291) => "71,115" (ftp-connection? 1) => #f (set! conn (ftp-establish-connection server port user passwd)) (ftp-connection? conn) (when (ftp-connection? conn) - (test - (ftp-cd conn "gnu") - (for ([f (in-list (ftp-directory-list conn))]) - (match-define (list type ftp-date name) f) - (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) - - (thread-wait pasv1-thread) - (thread-wait pasv2-thread) - (thread-wait main-thread) - - (get-output-string cop) => - #< EXPECTED-USER-OUTPUT + )))) -END - - )))) +(define S string-append) -(tests) +(define DIRLIST @S{ + 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 + @||}) + +(define TEXT-FILE @S{ + 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! + @||}) + +(define (SERVER-OUTPUT pasv1-port pasv2-port) + @S{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,@pasv1-port) + 200 Switching to Binary mode. + 150 Here comes the directory listing. + 226 Directory send OK. + 227 Entering Passive Mode (127,0,0,1,@pasv2-port) + 200 Switching to Binary mode. + 150 Opening BINARY mode data connection for =README-about-.diff-files (745 bytes). + 226 File send OK. + 221 Goodbye. + @||}) + +(define EXPECTED-USER-OUTPUT + @(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){ + USER anonymous + CWD gnu + PASV + TYPE I + LIST + PASV + TYPE I + RETR =README-about-.diff-files + QUIT + @||})