add a couple unit tests to ftp

diff --git a/basis/ftp/client/client.factor b/basis/ftp/client/client.factor
index ac21bb8f78b39aa1d1a824e2b2de656cc3f102a0..14877110d35a87a82a7116ce183a33d1ffb2207e 100644 (file)
--- a/basis/ftp/client/client.factor
+++ b/basis/ftp/client/client.factor
@@ -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 ;

diff --git a/basis/ftp/ftp.factor b/basis/ftp/ftp.factor
index 27eebc59461bf16ba6b6404694f76af25d2ffc36..eea98c01721be9f5c5951c15c135dbc4ddb92b41 100644 (file)
--- a/basis/ftp/ftp.factor
+++ b/basis/ftp/ftp.factor
@@ -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

diff --git a/basis/ftp/server/server-tests.factor b/basis/ftp/server/server-tests.factor
new file mode 100644 (file)
index 0000000..d7d9d83
--- /dev/null
+++ b/basis/ftp/server/server-tests.factor
@@ -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

diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor
index ffe16b2f4c6a8d801b58dc1266168f2315c3882f..5247b824fa51c6b7b75faee9be49d7c9246bf89b 100644 (file)
--- a/basis/ftp/server/server.factor
+++ b/basis/ftp/server/server.factor
@@ -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 ;