2016-04-13 16:06:05 -04:00
|
|
|
USING: accessors fry ftp.server io.encodings.ascii io.files
|
|
|
|
io.pathnames io.servers kernel tools.test urls ;
|
2009-05-16 01:29:21 -04:00
|
|
|
FROM: ftp.client => ftp-get ;
|
2009-02-18 16:29:06 -05:00
|
|
|
IN: ftp.server.tests
|
|
|
|
|
2010-09-19 14:38:02 -04:00
|
|
|
CONSTANT: test-file-contents "Files are so boring anymore."
|
2009-02-18 16:29:06 -05:00
|
|
|
|
|
|
|
: create-test-file ( -- path )
|
2016-04-13 16:06:05 -04:00
|
|
|
test-file-contents "ftp.server" [ ascii set-file-contents ] keep ;
|
2009-02-18 16:29:06 -05:00
|
|
|
|
2016-04-04 13:32:42 -04:00
|
|
|
: test-ftp-server ( quot: ( server path -- ) -- )
|
|
|
|
'[
|
|
|
|
"." 0 <ftp-server> [
|
|
|
|
"ftp://localhost" >url insecure-addr set-url-addr
|
|
|
|
"ftp" >>protocol
|
|
|
|
create-test-file >>path
|
|
|
|
@
|
|
|
|
] with-threaded-server
|
|
|
|
] with-test-directory ; inline
|
2009-02-18 16:29:06 -05:00
|
|
|
|
2016-04-04 13:32:42 -04:00
|
|
|
{ t } [
|
2009-02-18 16:29:06 -05:00
|
|
|
[
|
2016-04-15 18:52:06 -04:00
|
|
|
! give client its own directory so we don't overwrite the ftp server's file
|
|
|
|
[
|
|
|
|
[ ftp-get ]
|
|
|
|
[ path>> file-name ascii file-contents ] bi
|
|
|
|
] with-test-directory
|
2009-02-18 16:29:06 -05:00
|
|
|
] test-ftp-server test-file-contents =
|
|
|
|
] unit-test
|
|
|
|
|
|
|
|
[
|
2015-07-02 13:34:01 -04:00
|
|
|
|
2009-02-18 16:29:06 -05:00
|
|
|
[
|
2016-04-15 18:52:06 -04:00
|
|
|
! give client its own directory so we don't overwrite the ftp server's file
|
|
|
|
[
|
|
|
|
"/" >>path
|
|
|
|
[ ftp-get ]
|
|
|
|
[ path>> file-name ascii file-contents ] bi
|
|
|
|
] with-test-directory
|
2009-02-18 16:29:06 -05:00
|
|
|
] test-ftp-server test-file-contents =
|
|
|
|
] must-fail
|