refactoring ftp client

extra/ftp/client/client.factor

@@ -19,21 +19,32 @@ TUPLE: ftp-response n strings ;
         "anonymous" >>user
         "lol@test.com" >>password ;
 
-: read-epsv ( stream -- port )
+: add-response-line ( ftp-response string -- ftp-response )
-    dup stream-readln dup print
+    over strings>> push ;
-    "|" split 2 tail* first string>number ;
 
-: read-until-command ( stream ftp-response -- n )
+: (ftp-response-code) ( str -- n )
+    3 head string>number ;
+
+: ftp-response-code ( string -- n/f )
+    dup fourth CHAR: - = [ drop f ] [ (ftp-response-code) ] if ;
+
+: last-code ( ftp-response -- n )
+    strings>> peek (ftp-response-code) ;
+
+: read-response-until ( stream ftp-response n -- ftp-response )
+    >r over stream-readln
+    [ add-response-line ] [ ftp-response-code ] bi
+    r> tuck = [ drop nip ] [ read-response-until ] if ;
+
+: read-response ( stream -- ftp-response )
+    <ftp-response>
     over stream-readln
-    " " split1 drop string>number dup number? [
+    [ add-response-line ] [ fourth CHAR: - = ] bi
-        nip
+    [ dup last-code read-response-until ]
-    ] [
+    [ nip ] if dup last-code >>n ;
-        drop read-until-command
-    ] if ;
 
 : ftp-read ( ftp-client -- ftp-response )
-    stream>> <ftp-response> [ read-until-command ] keep
+    stream>> read-response ;
-    dup strings>> peek " " split1 ;
 
 : ftp-send ( str ftp-client -- )
     stream>>
@@ -48,24 +59,29 @@ TUPLE: ftp-response n strings ;
 : ftp-user ( ftp-client -- n ) dup user>> "USER " prepend ftp-command ;
 : ftp-password ( ftp-client -- n ) dup password>> "PASS " prepend ftp-command ;
 : ftp-set-binary ( ftp-client -- n ) "TYPE I" ftp-command ;
-: ftp-set-ascii ( ftp-client -- n ) "TYPE A" ftp-command ;
+! : ftp-set-ascii ( ftp-client -- n ) "TYPE A" ftp-command ;
 : ftp-system ( ftp-client -- n ) "SYST" ftp-command ;
 : ftp-features ( ftp-client -- n ) "FEAT" ftp-command ;
 : ftp-pwd ( ftp-client -- n ) "PWD" ftp-command ;
 : ftp-list ( ftp-client -- n ) "LIST" ftp-command ;
 : ftp-quit ( ftp-client -- n ) "QUIT" ftp-command ;
-: ftp-epsv ( ftp-client -- n str ) "EPSV" ftp-command ;
 : ftp-cwd ( ftp-client directory -- n ) "CWD " prepend ftp-command ;
 : ftp-retr ( ftp-client filename -- n ) "RETR " prepend ftp-command ;
 
+: parse-epsv ( ftp-response -- port )
+    strings>> first
+    "|" split 2 tail* first string>number ;
+
+: ftp-epsv ( ftp-client -- n ) "EPSV" ftp-command ;
+
 M: ftp-client dispose ( ftp-client -- )
-    [ "QUIT" ftp-command ] [ stream>> dispose ] bi ;
+    [ "QUIT" ftp-command drop ] [ stream>> dispose ] bi ;
 
 ERROR: ftp-error got expected ;
-: ftp-assert ( m n -- )
+: ftp-assert ( ftp-response n -- )
-    2dup = [ 2drop ] [ ftp-error ] if ;
+    2dup >r n>> r> = [ 2drop ] [ ftp-error ] if ;
 
-: ftp-connect ( ftp-client -- stream )
+: ftp-connect ( ftp-client -- )
     dup
     [ host>> ] [ port>> ] bi <inet> ascii <client>
     >>stream drop ;
@@ -79,29 +95,17 @@ ERROR: ftp-error got expected ;
         [ ftp-set-binary 200 ftp-assert ]
     } cleave ;
 
-: list ( stream -- )
+: list ( ftp-client -- ftp-response )
-    dup ftp-epsv
+    dup ftp-epsv dup 229 ftp-assert
-    dup read-epsv
+    >r dup host>> r> parse-epsv <inet> ascii <client>
-    ! host get swap <inet> binary <client>
+    over ftp-list 150 ftp-assert
-    over ftp-list
+    lines <ftp-response> swap >>strings
-    over read-until-command drop
+    >r ftp-read 226 ftp-assert r> ;
-    contents write
-    read-until-command drop ;
 
-: ftp-get ( ftp-client filename -- )
+: ftp-get ( ftp-client filename -- ftp-response )
-    over ftp-epsv 229 ftp-assert
+    over ftp-epsv dup 229 ftp-assert
-    
+    pick host>> swap parse-epsv <inet> binary <client>
-    ;
+    swap tuck
-
+    [ dupd ftp-retr 150 ftp-assert ]
-! : ftp-get ( path stream -- )
+    [ binary <file-writer> stream-copy ] 2bi*
-    ! dup ftp-epsv
+    ftp-read dup 226 ftp-assert ;
-    ! dup read-epsv
-    ! ! host get swap <inet> binary <client>
-    ! >r [ ftp-retr ] 2keep dup read-until-command drop r>
-    ! rot binary <file-writer> stream-copy
-    ! read-until-command drop ;
-
-
-
-: ftp-interact ( stream -- )
-    readln over ftp-send read-until-command drop ;