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: f297c98c1a
This commit is contained in:
Eli Barzilay
parent
b342b9b044
commit
62e93cf2a4
|
|
@ -1,38 +1,62 @@
|
|||
#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))))
|
||||
(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))
|
||||
|
||||
(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))
|
||||
(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 #<<END
|
||||
(define-values [pasv1-thd pasv1-port] (tcp-serve* (current-output-port) DIRLIST))
|
||||
(define-values [pasv2-thd pasv2-port] (tcp-serve* (current-output-port) TEXT-FILE))
|
||||
(define-values [main-thd main-port] (tcp-serve cop (SERVER-OUTPUT pasv1-port pasv2-port)))
|
||||
(define server "127.0.0.1")
|
||||
(define port main-port)
|
||||
(define user "anonymous")
|
||||
(define passwd "nonny")
|
||||
(define conn #f)
|
||||
(define pth "=README-about-.diff-files")
|
||||
(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 ?size) 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-thd)
|
||||
(thread-wait pasv2-thd)
|
||||
(thread-wait main-thd)
|
||||
(get-output-string cop) => EXPECTED-USER-OUTPUT
|
||||
))))
|
||||
|
||||
(define S string-append)
|
||||
|
||||
(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
|
||||
|
|
@ -127,17 +151,14 @@ 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
|
||||
@||})
|
||||
|
||||
(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
|
||||
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
|
||||
|
|
@ -149,17 +170,13 @@ You can use the "patch" program to apply the diff to your sources.
|
|||
/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. ;-)
|
||||
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.
|
||||
(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-
|
||||
|
|
@ -194,53 +211,19 @@ END
|
|||
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)
|
||||
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,~a,~a)
|
||||
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.
|
||||
@||})
|
||||
|
||||
END
|
||||
pasv1-port-maj pasv1-port-min
|
||||
pasv2-port-maj pasv2-port-min
|
||||
))))
|
||||
|
||||
(define server "127.0.0.1")
|
||||
(define port main-port)
|
||||
(define user "anonymous")
|
||||
(define passwd "nonny")
|
||||
(define conn #f)
|
||||
(define pth "=README-about-.diff-files")
|
||||
(define tmp-dir (make-temporary-file "ftp~a" 'directory))
|
||||
(test (ftp-port-split 18291) => (values 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) =>
|
||||
#<<END
|
||||
(define EXPECTED-USER-OUTPUT
|
||||
@(lambda xs (regexp-replace* #rx"\n" (apply S xs) "\r\n")){
|
||||
USER anonymous
|
||||
CWD gnu
|
||||
PASV
|
||||
|
|
@ -250,9 +233,4 @@ PASV
|
|||
TYPE I
|
||||
RETR =README-about-.diff-files
|
||||
QUIT
|
||||
|
||||
END
|
||||
|
||||
))))
|
||||
|
||||
(tests)
|
||||
@||})
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user