add a couple unit tests to ftp

db4
Doug Coleman 2009-02-18 15:29:06 -06:00
parent 966627a1e2
commit 30e639ae39
4 changed files with 52 additions and 8 deletions

View File

@ -93,7 +93,7 @@ ERROR: ftp-error got expected ;
: ensure-login ( url -- url )
dup username>> [
"anonymous" >>username
"ftp-client" >>password
"ftp-client@factorcode.org" >>password
] unless ;
: >ftp-url ( url -- url' ) >url ensure-port ensure-login ;

View File

@ -16,7 +16,3 @@ TUPLE: ftp-response n strings parsed ;
over strings>> push ;
: ftp-send ( string -- ) write "\r\n" write flush ;
CONSTANT: ftp-ipv4 1
CONSTANT: ftp-ipv6 2

View File

@ -0,0 +1,50 @@
USING: calendar ftp.server io.encodings.ascii io.files
io.files.unique namespaces threads tools.test kernel
io.servers.connection ftp.client accessors urls
io.pathnames io.directories sequences fry ;
IN: ftp.server.tests
: test-file-contents ( -- string )
"Files are so boring anymore." ;
: create-test-file ( -- path )
test-file-contents
"ftp.server" "test" make-unique-file
[ ascii set-file-contents ] keep canonicalize-path ;
: test-ftp-server ( quot -- )
'[
current-temporary-directory get 0
<ftp-server>
[ start-server* ]
[
sockets>> first addr>> port>>
<url>
swap >>port
"ftp" >>protocol
"localhost" >>host
create-test-file >>path
_ call
]
[ stop-server ] tri
] with-unique-directory drop ; inline
[ t ]
[
[
unique-directory [
[ ftp-get ] [ path>> file-name ascii file-contents ] bi
] with-directory
] test-ftp-server test-file-contents =
] unit-test
[
[
"/" >>path
unique-directory [
[ ftp-get ] [ path>> file-name ascii file-contents ] bi
] with-directory
] test-ftp-server test-file-contents =
] must-fail

View File

@ -61,11 +61,9 @@ C: <ftp-disconnect> ftp-disconnect
normalize-path server get serving-directory>> head? ;
: can-serve-directory? ( path -- ? )
canonicalize-path
{ [ exists? ] [ file-info directory? ] [ serving? ] } 1&& ;
: can-serve-file? ( path -- ? )
canonicalize-path
{
[ exists? ]
[ file-info type>> +regular-file+ = ]
@ -351,7 +349,7 @@ M: ftp-server handle-client* ( server -- )
: <ftp-server> ( directory port -- server )
ftp-server new-threaded-server
swap >>insecure
swap >>serving-directory
swap canonicalize-path >>serving-directory
"ftp.server" >>name
5 minutes >>timeout
latin1 >>encoding ;