steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add file parsing to ftp.client

db4
Doug Coleman 2008-05-11 22:05:53 -05:00
parent cc390dd53a
commit 69e144245d
1 changed files with 71 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
extra/ftp/client/client.factor
View File

@ -1,12 +1,13 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.singleton combinators continuations USING: accessors arrays classes.singleton combinators
io io.encodings.binary io.encodings.ascii io.files io.sockets continuations io io.encodings.binary io.encodings.ascii
kernel math math.parser sequences splitting namespaces strings ; io.files io.sockets kernel math math.parser sequences
splitting namespaces strings ;
IN: ftp.client IN: ftp.client
TUPLE: ftp-client host port stream user password mode ; TUPLE: ftp-client host port stream user password mode ;
TUPLE: ftp-response n strings ; TUPLE: ftp-response n strings parsed ;
SINGLETON: active SINGLETON: active
SINGLETON: passive SINGLETON: passive
@ -86,6 +87,70 @@ SINGLETON: passive
strings>> first strings>> first
"|" split 2 tail* first string>number ; "|" split 2 tail* first string>number ;
: ch>attribute ( ch -- symbol )
{
{ CHAR: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] }
{ CHAR: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
TUPLE: remote-file
type permissions links owner group size month day time year name ;
: <remote-file> ( -- remote-file ) remote-file new ;
: parse-permissions ( remote-file str -- remote-file )
[ first ch>attribute >>type ] [ rest >>permissions ] bi ;
: parse-list-9 ( lines -- seq )
[
<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 ]
} 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 [ empty? not ] filter ] map
dup length {
{ 9 [ parse-list-9 ] }
{ 8 [ parse-list-8 ] }
{ 3 [ parse-list-3 ] }
[ drop ]
} case >>parsed ;
: ftp-epsv ( ftp-client -- ftp-response ) : ftp-epsv ( ftp-client -- ftp-response )
>r "EPSV" r> ftp-command ; >r "EPSV" r> ftp-command ;
@ -117,7 +182,8 @@ ERROR: ftp-error got expected ;
dup [ host>> ] [ start-2nd ] bi <inet> ascii <client> dup [ host>> ] [ start-2nd ] bi <inet> ascii <client>
over ftp-list 150 ftp-assert over ftp-list 150 ftp-assert
lines <ftp-response> swap >>strings lines <ftp-response> swap >>strings
>r ftp-read 226 ftp-assert r> ; >r ftp-read 226 ftp-assert r>
parse-list ;
: ftp-get ( filename ftp-client -- ftp-response ) : ftp-get ( filename ftp-client -- ftp-response )
dup [ host>> ] [ start-2nd ] bi <inet> binary <client> dup [ host>> ] [ start-2nd ] bi <inet> binary <client>