cleanup of ftp.client. remove the ls load error.

extra/ftp/client/client.factor

@@ -2,8 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays classes.singleton combinators
 continuations io io.encodings.binary io.encodings.utf8
-io.files io.sockets kernel io.streams.duplex math ls
+io.files io.sockets kernel io.streams.duplex math
-math.parser sequences splitting namespaces strings fry ftp ;
+math.parser sequences splitting namespaces strings fry ftp
+ftp.client.listing-parser urls ;
 IN: ftp.client
 
 : (ftp-response-code) ( str -- n )
@@ -24,145 +25,86 @@ IN: ftp.client
     [ fourth CHAR: - = ] tri
     [ read-response-loop ] when ;
 
+ERROR: ftp-error got expected ;
+
+: ftp-assert ( ftp-response n -- )
+    2dup [ n>> ] dip = [ 2drop ] [ ftp-error ] if ;
+
 : ftp-command ( string -- ftp-response )
     ftp-send read-response ;
 
-: ftp-user ( ftp-client -- ftp-response )
+: ftp-user ( url -- ftp-response )
-    user>> "USER " prepend ftp-command ;
+    username>> "USER " prepend ftp-command ;
 
-: ftp-password ( ftp-client -- ftp-response )
+: ftp-password ( url -- ftp-response )
     password>> "PASS " prepend ftp-command ;
 
-: ftp-set-binary ( -- ftp-response )
-    "TYPE I" ftp-command ;
-
-: ftp-pwd ( -- ftp-response )
-    "PWD" ftp-command ;
-
-: ftp-list ( -- ftp-response )
-    "LIST" ftp-command ;
-
-: ftp-quit ( -- ftp-response )
-    "QUIT" ftp-command ;
-
 : ftp-cwd ( directory -- ftp-response )
     "CWD " prepend ftp-command ;
 
 : ftp-retr ( filename -- ftp-response )
     "RETR " prepend ftp-command ;
 
-: parse-epsv ( ftp-response -- port )
+: ftp-set-binary ( -- ftp-response ) "TYPE I" ftp-command ;
-    strings>> first
-    "|" split 2 tail* first string>number ;
 
-TUPLE: remote-file
+: ftp-pwd ( -- ftp-response ) "PWD" ftp-command ;
-type permissions links owner group size month day time year
-name target ;
 
-: <remote-file> ( -- remote-file ) remote-file new ;
+: ftp-list ( -- )
+    "LIST" ftp-command 150 ftp-assert ;
 
-: parse-permissions ( remote-file str -- remote-file )
+: ftp-quit ( -- ftp-response ) "QUIT" ftp-command ;
-    [ first ch>type >>type ] [ rest >>permissions ] bi ;
-
-: parse-list-11 ( lines -- seq )
-    [
-        11 f pad-right
-        <remote-file> swap {
-            [ 0 swap nth parse-permissions ]
-            [ 1 swap nth string>number >>links ]
-            [ 2 swap nth >>owner ]
-            [ 3 swap nth >>group ]
-            [ 4 swap nth string>number >>size ]
-            [ 5 swap nth >>month ]
-            [ 6 swap nth >>day ]
-            [ 7 swap nth >>time ]
-            [ 8 swap nth >>name ]
-            [ 10 swap nth >>target ]
-        } cleave
-    ] map ;
-
-: parse-list-8 ( lines -- seq )
-    [
-        <remote-file> swap {
-            [ 0 swap nth parse-permissions ]
-            [ 1 swap nth string>number >>links ]
-            [ 2 swap nth >>owner ]
-            [ 3 swap nth >>size ]
-            [ 4 swap nth >>month ]
-            [ 5 swap nth >>day ]
-            [ 6 swap nth >>time ]
-            [ 7 swap nth >>name ]
-        } cleave
-    ] map ;
-
-: parse-list-3 ( lines -- seq )
-    [
-        <remote-file> swap {
-            [ 0 swap nth parse-permissions ]
-            [ 1 swap nth string>number >>links ]
-            [ 2 swap nth >>name ]
-        } cleave
-    ] map ;
-
-: parse-list ( ftp-response -- ftp-response )
-    dup strings>>
-    [ " " split harvest ] map
-    dup length {
-        { 11 [ parse-list-11 ] }
-        { 9 [ parse-list-11 ] }
-        { 8 [ parse-list-8 ] }
-        { 3 [ parse-list-3 ] }
-        [ drop ]
-    } case >>parsed ;
 
 : ftp-epsv ( -- ftp-response )
-    "EPSV" ftp-command ;
+    "EPSV" ftp-command dup 229 ftp-assert ;
 
-ERROR: ftp-error got expected ;
+: parse-epsv ( ftp-response -- port )
-: ftp-assert ( ftp-response n -- )
+    strings>> first "|" split 2 tail* first string>number ;
-    2dup [ n>> ] dip = [ 2drop ] [ ftp-error ] if ;
 
-: ftp-login ( ftp-client -- )
+: open-passive-client ( url protocol -- stream )
-    read-response 220 ftp-assert
+    [ host>> ftp-epsv parse-epsv <inet> ] dip <client> drop ;
-    [ ftp-user 331 ftp-assert ]
-    [ ftp-password 230 ftp-assert ] bi
-    ftp-set-binary 200 ftp-assert ;
 
-: open-remote-port ( -- port )
+: list ( url -- ftp-response )
-    ftp-epsv
+    utf8 open-passive-client
-    [ 229 ftp-assert ] [ parse-epsv ] bi ;
+    ftp-list
-
-: list ( ftp-client -- ftp-response )
-    host>> open-remote-port <inet> utf8 <client> drop
-    ftp-list 150 ftp-assert
     lines
     <ftp-response> swap >>strings
     read-response 226 ftp-assert
     parse-list ;
 
-: ftp-get ( filename ftp-client -- ftp-response )
+: (ftp-get) ( url path -- )
-    host>> open-remote-port <inet> binary <client> drop
+    [ binary open-passive-client ] dip
-    swap
     [ ftp-retr 150 ftp-assert drop ]
     [ binary <file-writer> stream-copy ] 2bi
-    read-response dup 226 ftp-assert ;
+    read-response 226 ftp-assert ;
 
-: ftp-connect ( ftp-client -- stream )
+: ftp-login ( url -- )
+    read-response 220 ftp-assert
+    [ ftp-user 331 ftp-assert ]
+    [ ftp-password 230 ftp-assert ] bi
+    ftp-set-binary 200 ftp-assert ;
+
+: ftp-connect ( url -- stream )
     [ host>> ] [ port>> ] bi <inet> utf8 <client> drop ;
 
-GENERIC: ftp-download ( path obj -- )
+: with-ftp-client ( url quot -- )
+    [ [ ftp-connect ] keep ] dip
+    '[ _ [ ftp-login ] _ bi ftp-quit drop ] with-stream ; inline
 
-: with-ftp-client ( ftp-client quot -- )
+: ensure-login ( url -- url )
-    dupd '[
+    dup username>> [
-        _ [ ftp-login ] [ @ ] bi
+        "anonymous" >>username
-        ftp-quit drop
+        "ftp-client" >>password
-    ] [ ftp-connect ] dip with-stream ; inline
+    ] unless ;
 
-M: ftp-client ftp-download ( path ftp-client -- )
+: >ftp-url ( url -- url' ) >url ensure-port ensure-login ;
-    [
+
-        [ drop parent-directory ftp-cwd drop ]
+: ftp-get ( url -- )
-        [ [ file-name ] dip ftp-get drop ] 2bi
+    >ftp-url [
+        dup path>>
+        [ nip parent-directory ftp-cwd drop ]
+        [ file-name (ftp-get) ] 2bi
     ] with-ftp-client ;
 
-M: string ftp-download ( path string -- )
+
-    <ftp-client> ftp-download ;
+
+

extra/ftp/client/listing-parser/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/ftp/client/listing-parser/listing-parser.factor

@@ -0,0 +1,89 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators io.files kernel math.parser
+sequences splitting ;
+IN: ftp.client.listing-parser
+
+: ch>file-type ( ch -- type )
+    {
+        { CHAR: b [ +block-device+ ] }
+        { CHAR: c [ +character-device+ ] }
+        { CHAR: d [ +directory+ ] }
+        { CHAR: l [ +symbolic-link+ ] }
+        { CHAR: s [ +socket+ ] }
+        { CHAR: p [ +fifo+ ] }
+        { CHAR: - [ +regular-file+ ] }
+        [ drop +unknown+ ]
+    } case ;
+
+: file-type>ch ( type -- string )
+    {
+        { +block-device+ [ CHAR: b ] }
+        { +character-device+ [ CHAR: c ] }
+        { +directory+ [ CHAR: d ] }
+        { +symbolic-link+ [ CHAR: l ] }
+        { +socket+ [ CHAR: s ] }
+        { +fifo+ [ CHAR: p ] }
+        { +regular-file+ [ CHAR: - ] }
+        [ drop CHAR: - ]
+    } case ;
+
+: parse-permissions ( remote-file str -- remote-file )
+    [ first ch>file-type >>type ] [ rest >>permissions ] bi ;
+
+TUPLE: remote-file
+type permissions links owner group size month day time year
+name target ;
+
+: <remote-file> ( -- remote-file ) remote-file new ;
+
+: parse-list-11 ( lines -- seq )
+    [
+        11 f pad-right
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>owner ]
+            [ 3 swap nth >>group ]
+            [ 4 swap nth string>number >>size ]
+            [ 5 swap nth >>month ]
+            [ 6 swap nth >>day ]
+            [ 7 swap nth >>time ]
+            [ 8 swap nth >>name ]
+            [ 10 swap nth >>target ]
+        } cleave
+    ] map ;
+
+: parse-list-8 ( lines -- seq )
+    [
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>owner ]
+            [ 3 swap nth >>size ]
+            [ 4 swap nth >>month ]
+            [ 5 swap nth >>day ]
+            [ 6 swap nth >>time ]
+            [ 7 swap nth >>name ]
+        } cleave
+    ] map ;
+
+: parse-list-3 ( lines -- seq )
+    [
+        <remote-file> swap {
+            [ 0 swap nth parse-permissions ]
+            [ 1 swap nth string>number >>links ]
+            [ 2 swap nth >>name ]
+        } cleave
+    ] map ;
+
+: parse-list ( ftp-response -- ftp-response )
+    dup strings>>
+    [ " " split harvest ] map
+    dup length {
+        { 11 [ parse-list-11 ] }
+        { 9 [ parse-list-11 ] }
+        { 8 [ parse-list-8 ] }
+        { 3 [ parse-list-3 ] }
+        [ drop ]
+    } case >>parsed ;

extra/ftp/ftp.factor

@@ -1,27 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs combinators io io.files kernel
-math.parser sequences strings ls ;
+math.parser sequences strings ;
 IN: ftp
 
 SINGLETON: active
 SINGLETON: passive
 
-TUPLE: ftp-client host port user password mode state
-command-promise ;
-
-: <ftp-client> ( host -- ftp-client )
-    ftp-client new
-        swap >>host
-        21 >>port
-        "anonymous" >>user
-        "ftp@my.org" >>password ;
-
-: reset-ftp-client ( ftp-client -- )
-    f >>user
-    f >>password
-    drop ;
-
 TUPLE: ftp-response n strings parsed ;
 
 : <ftp-response> ( -- ftp-response )
@@ -34,5 +19,3 @@ TUPLE: ftp-response n strings parsed ;
 : ftp-send ( string -- ) write "\r\n" write flush ;
 : ftp-ipv4 1 ; inline
 : ftp-ipv6 2 ; inline
-
-: directory-list ( -- seq ) "" ls ;

extra/ftp/server/server.factor

@@ -7,9 +7,15 @@ namespaces make sequences ftp io.unix.launcher.parser
 unicode.case splitting assocs classes io.servers.connection
 destructors calendar io.timeouts io.streams.duplex threads
 continuations math concurrency.promises byte-arrays
-io.backend sequences.lib tools.hexdump ;
+io.backend sequences.lib tools.hexdump io.files.listing ;
 IN: ftp.server
 
+TUPLE: ftp-client url mode state command-promise ;
+
+: <ftp-client> ( url -- ftp-client )
+    ftp-client new
+        swap >>url ;
+    
 SYMBOL: client
 
 : ftp-server-directory ( -- str )
@@ -143,7 +149,7 @@ M: ftp-list service-command ( stream obj -- )
     start-directory
     [
         utf8 encode-output
-        directory-list [ ftp-send ] each
+        directory. [ ftp-send ] each
     ] with-output-stream
     finish-directory ;