diff --git a/extra/ftp/client/client.factor b/extra/ftp/client/client.factor index fc70f279ed..13cb21d7e4 100644 --- a/extra/ftp/client/client.factor +++ b/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 new - V{ } clone >>strings ; : ( 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 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 ; diff --git a/extra/ftp/ftp.factor b/extra/ftp/ftp.factor new file mode 100644 index 0000000000..565f5ce2ff --- /dev/null +++ b/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 ; diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor new file mode 100644 index 0000000000..9165fa08bd --- /dev/null +++ b/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 new + 21 >>port ; + +TUPLE: ftp-client-command string tokenized ; +: ( -- obj ) + ftp-client-command new ; + +: read-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 -- ) + 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