add ftp, ftp.server

TODO: ftp.server

extra/ftp/client/client.factor

@@ -3,18 +3,10 @@
 USING: accessors arrays classes.singleton combinators
 continuations io io.encodings.binary io.encodings.ascii
 io.files io.sockets kernel io.streams.duplex math
-math.parser sequences splitting namespaces strings fry ;
+math.parser sequences splitting namespaces strings fry ftp ;
 IN: ftp.client
 
 TUPLE: ftp-client host port user password mode ;
-TUPLE: ftp-response n strings parsed ;
-
-SINGLETON: active
-SINGLETON: passive
-
-: <ftp-response> ( -- ftp-response )
-    ftp-response new
-        V{ } clone >>strings ;
 
 : <ftp-client> ( host -- ftp-client )
     ftp-client new
@@ -23,6 +15,12 @@ SINGLETON: passive
         "anonymous" >>user
         "ftp@my.org" >>password ;
 
+TUPLE: ftp-response n strings parsed ;
+
+: <ftp-response> ( -- ftp-response )
+    ftp-response new
+        V{ } clone >>strings ;
+
 : add-response-line ( ftp-response string -- ftp-response )
     over strings>> push ;
 
@@ -44,12 +42,10 @@ SINGLETON: passive
     [ fourth CHAR: - = ] tri
     [ read-response-loop ] when ;
 
-: ftp-send ( string -- )
-    write "\r\n" write flush ;
-
 : ftp-command ( string -- ftp-response )
     ftp-send read-response ;
 
+
 : ftp-user ( ftp-client -- ftp-response )
     user>> "USER " prepend ftp-command ;
 

extra/ftp/ftp.factor

@@ -0,0 +1,9 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors io kernel math.parser sequences ;
+IN: ftp
+
+SINGLETON: active
+SINGLETON: passive
+
+: ftp-send ( string -- ) write "\r\n" write flush ;

extra/ftp/server/server.factor

@@ -0,0 +1,83 @@
+USING: accessors combinators io io.encodings.8-bit
+io.server io.sockets kernel sequences ftp
+io.unix.launcher.parser unicode.case ;
+IN: ftp.server
+
+TUPLE: ftp-server port ;
+
+: <ftp-server> ( -- ftp-server )
+    ftp-server new
+        21 >>port ;
+
+TUPLE: ftp-client-command string tokenized ;
+: <ftp-client-command> ( -- obj )
+    ftp-client-command new ;
+
+: read-client-command ( -- ftp-client-command )
+    <ftp-client-command> readln
+    [ >>string ] [ tokenize-command >>tokenized ] bi ;
+
+: server>client ( string -- ftp-client-command )
+    ftp-send read-client-command ;
+
+: send-banner ( -- ftp-client-command )
+    "220 Welcome to " host-name append server>client ;
+
+: handle-client-loop ( ftp-client-command -- )
+    <ftp-client-command> readln
+    [ >>string ] [ tokenize-command >>tokenized ] bi
+    first >upper {
+        ! { "USER" [ ] }
+        ! { "PASS" [ ] }
+        ! { "ACCT" [ ] }
+        ! { "CWD" [ ] }
+        ! { "CDUP" [ ] }
+        ! { "SMNT" [ ] }
+
+        ! { "REIN" [ ] }
+        ! { "QUIT" [ ] }
+
+        ! { "PORT" [ ] }
+        ! { "PASV" [ ] }
+        ! { "MODE" [ ] }
+        ! { "TYPE" [ ] }
+        ! { "STRU" [ ] }
+
+        ! { "ALLO" [ ] }
+        ! { "REST" [ ] }
+        ! { "STOR" [ ] }
+        ! { "STOU" [ ] }
+        ! { "RETR" [ ] }
+        ! { "LIST" [ ] }
+        ! { "NLST" [ ] }
+        ! { "LIST" [ ] }
+        ! { "APPE" [ ] }
+        ! { "RNFR" [ ] }
+        ! { "RNTO" [ ] }
+        ! { "DELE" [ ] }
+        ! { "RMD" [ ] }
+        ! { "MKD" [ ] }
+        ! { "PWD" [ ] }
+        ! { "ABOR" [ ] }
+
+        ! { "SYST" [ ] }
+        ! { "STAT" [ ] }
+        ! { "HELP" [ ] }
+
+        ! { "SITE" [ ] }
+        ! { "NOOP" [ ] }
+    } case ;
+
+: handle-client ( -- ftp-response )
+    "" [
+        send-banner handle-client-loop
+    ] with-directory ;
+
+: ftpd ( port -- )
+    internet-server "ftp.server"
+    latin1 [ handle-client ] with-server ;
+
+: ftpd-main ( -- )
+    2100 ftpd ;
+
+MAIN: ftpd-main