Merge branch 'master' of factorcode.org:/git/factor

extra/ftp/client/client.factor

@@ -6,24 +6,6 @@ io.files io.sockets kernel io.streams.duplex math
 math.parser sequences splitting namespaces strings fry ftp ;
 IN: ftp.client
 
-TUPLE: ftp-client host port user password mode ;
-
-: <ftp-client> ( host -- ftp-client )
-    ftp-client new
-        swap >>host
-        21 >>port
-        "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 ;
-
 : (ftp-response-code) ( str -- n )
     3 head string>number ;
 

extra/ftp/ftp.factor

@@ -6,4 +6,22 @@ IN: ftp
 SINGLETON: active
 SINGLETON: passive
 
+TUPLE: ftp-client host port user password mode state ;
+
+: <ftp-client> ( host -- ftp-client )
+    ftp-client new
+        swap >>host
+        21 >>port
+        "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 ;
+
 : ftp-send ( string -- ) write "\r\n" write flush ;

extra/ftp/server/server.factor

@@ -1,15 +1,13 @@
 USING: accessors combinators io io.encodings.8-bit
-io.server io.sockets kernel sequences ftp
+io.files io.server io.sockets kernel math.parser
-io.unix.launcher.parser unicode.case ;
+namespaces sequences ftp io.unix.launcher.parser
+unicode.case ;
 IN: ftp.server
 
-TUPLE: ftp-server port ;
+SYMBOL: client
-
-: <ftp-server> ( -- ftp-server )
-    ftp-server new
-        21 >>port ;
 
 TUPLE: ftp-client-command string tokenized ;
+
 : <ftp-client-command> ( -- obj )
     ftp-client-command new ;
 
@@ -17,25 +15,56 @@ TUPLE: ftp-client-command string tokenized ;
     <ftp-client-command> readln
     [ >>string ] [ tokenize-command >>tokenized ] bi ;
 
-: server>client ( string -- ftp-client-command )
+: send-response ( ftp-response -- )
-    ftp-send read-client-command ;
+    [ n>> ] [ strings>> ] bi
+    2dup
+    but-last-slice [
+        [ number>string write "-" write ] [ ftp-send ] bi*
+    ] with each
+    first [ number>string write bl ] [ ftp-send ] bi* ;
 
-: send-banner ( -- ftp-client-command )
+: server-response ( n string -- )
-    "220 Welcome to " host-name append server>client ;
+    <ftp-response>
+        swap add-response-line
+        swap >>n
+    send-response ;
 
-: handle-client-loop ( ftp-client-command -- )
+: send-banner ( -- )
+    220 "Welcome to " host-name append server-response ;
+
+: send-PASS-request ( -- )
+    331 "Please specify the password." server-response ;
+
+: parse-USER ( ftp-client-command -- )
+    tokenized>> second client get swap >>user drop ;
+
+: send-login-response ( -- )
+    ! client get
+    230 "Login successful" server-response ;
+
+: parse-PASS ( ftp-client-command -- )
+    tokenized>> second client get swap >>password drop ;
+
+: send-quit-response ( ftp-client-command -- )
+    drop 221 "Goodbye." server-response ;
+
+: unimplemented-command ( ftp-client-command -- )
+    500 "Unimplemented command: " rot string>> append server-response ;
+
+: handle-client-loop ( -- )
     <ftp-client-command> readln
-    [ >>string ] [ tokenize-command >>tokenized ] bi
+    [ >>string ]
-    first >upper {
+    [ tokenize-command >>tokenized ] bi
-        ! { "USER" [ ] }
+    dup tokenized>> first >upper {
-        ! { "PASS" [ ] }
+        { "USER" [ parse-USER send-PASS-request t ] }
+        { "PASS" [ parse-PASS send-login-response t ] }
         ! { "ACCT" [ ] }
         ! { "CWD" [ ] }
         ! { "CDUP" [ ] }
         ! { "SMNT" [ ] }
 
         ! { "REIN" [ ] }
-        ! { "QUIT" [ ] }
+        { "QUIT" [ send-quit-response f ] }
 
         ! { "PORT" [ ] }
         ! { "PASV" [ ] }
@@ -66,10 +95,17 @@ TUPLE: ftp-client-command string tokenized ;
 
         ! { "SITE" [ ] }
         ! { "NOOP" [ ] }
-    } case ;
 
-: handle-client ( -- ftp-response )
+        ! { "EPRT" [ ] }
+        ! { "LPRT" [ ] }
+        ! { "EPSV" [ ] }
+        ! { "LPSV" [ ] }
+        [ drop unimplemented-command t ]
+    } case [ handle-client-loop ] when ;
+
+: handle-client ( -- )
     "" [
+        host-name <ftp-client> client set
         send-banner handle-client-loop
     ] with-directory ;
 
@@ -77,7 +113,8 @@ TUPLE: ftp-client-command string tokenized ;
     internet-server "ftp.server"
     latin1 [ handle-client ] with-server ;
 
-: ftpd-main ( -- )
+: ftpd-main ( -- ) 2100 ftpd ;
-    2100 ftpd ;
 
 MAIN: ftpd-main
+
+! sudo tcpdump -i en1 -A -s 10000  tcp port 21