Merge branch 'master' of factorcode.org:/git/factor
Eduardo Cavazos
commit
6eb3b6b4f7
extra/ftp
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -1,15 +1,13 @@
|
|||
USING: accessors combinators io io.encodings.8-bit
|
||||
io.server io.sockets kernel sequences ftp
|
||||
io.unix.launcher.parser unicode.case ;
|
||||
io.files io.server io.sockets kernel math.parser
|
||||
namespaces sequences ftp io.unix.launcher.parser
|
||||
unicode.case ;
|
||||
IN: ftp.server
|
||||
|
||||
TUPLE: ftp-server port ;
|
||||
|
||||
: <ftp-server> ( -- ftp-server )
|
||||
ftp-server new
|
||||
21 >>port ;
|
||||
SYMBOL: client
|
||||
|
||||
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 )
|
||||
ftp-send read-client-command ;
|
||||
: send-response ( ftp-response -- )
|
||||
[ 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 )
|
||||
"220 Welcome to " host-name append server>client ;
|
||||
: server-response ( n string -- )
|
||||
<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
|
||||
first >upper {
|
||||
! { "USER" [ ] }
|
||||
! { "PASS" [ ] }
|
||||
[ >>string ]
|
||||
[ tokenize-command >>tokenized ] bi
|
||||
dup tokenized>> first >upper {
|
||||
{ "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 ( -- )
|
||||
2100 ftpd ;
|
||||
: ftpd-main ( -- ) 2100 ftpd ;
|
||||
|
||||
MAIN: ftpd-main
|
||||
|
||||
! sudo tcpdump -i en1 -A -s 10000 tcp port 21
|
||||
|
|
|
|||
Loading…
Reference in New Issue