make a variable to set the ftp serving directory. fix changing directories so you can't escape the serving directory. requires ls vocab now

db4
Doug Coleman 2008-11-13 19:33:29 -06:00
parent 89a5957033
commit 617a433706
3 changed files with 19 additions and 35 deletions

View File

@ -2,7 +2,7 @@
! 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
io.files io.sockets kernel io.streams.duplex math ls
math.parser sequences splitting namespaces strings fry ftp ;
IN: ftp.client

View File

@ -1,7 +1,7 @@
! 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 ;
math.parser sequences strings ls ;
IN: ftp
SINGLETON: active
@ -32,35 +32,7 @@ TUPLE: ftp-response n strings parsed ;
over strings>> push ;
: ftp-send ( string -- ) write "\r\n" write flush ;
: ftp-ipv4 1 ; inline
: ftp-ipv6 2 ; inline
: ch>type ( ch -- type )
{
{ CHAR: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] }
{ CHAR: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
: type>ch ( type -- string )
{
{ +directory+ [ CHAR: d ] }
{ +symbolic-link+ [ CHAR: l ] }
{ +regular-file+ [ CHAR: - ] }
[ drop CHAR: - ]
} case ;
: file-info>string ( file-info name -- string )
[
[
[ type>> type>ch 1string ]
[ drop "rwx------" append ] bi
]
[ size>> number>string 15 CHAR: \s pad-left ] bi
] dip 3array " " join ;
: directory-list ( -- seq )
"" directory-files
[ [ link-info ] keep file-info>string ] map ;
: directory-list ( -- seq ) "" ls ;

View File

@ -6,12 +6,16 @@ io.encodings.utf8 io.files io.sockets kernel math.parser
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 sequences.lib
hexdump ;
continuations math concurrency.promises byte-arrays
io.backend sequences.lib hexdump ;
IN: ftp.server
SYMBOL: client
: ftp-server-directory ( -- str )
\ ftp-server-directory get-global "resource:temp" or
normalize-path ;
TUPLE: ftp-command raw tokenized ;
: <ftp-command> ( -- obj )
@ -238,10 +242,16 @@ M: ftp-put service-command ( stream obj -- )
! : handle-LPRT ( obj -- ) tokenized>> "," split ;
ERROR: not-a-directory ;
ERROR: no-permissions ;
: handle-CWD ( obj -- )
[
tokenized>> second dup directory? [
tokenized>> second dup normalize-path
dup ftp-server-directory head? [
no-permissions
] unless
file-info directory? [
set-current-directory
250 "Directory successully changed." server-response
] [
@ -256,6 +266,7 @@ ERROR: not-a-directory ;
: handle-client-loop ( -- )
<ftp-command> readln
USE: prettyprint global [ dup . flush ] bind
[ >>raw ]
[ tokenize-command >>tokenized ] bi
dup tokenized>> first >upper {
@ -313,7 +324,7 @@ TUPLE: ftp-server < threaded-server ;
M: ftp-server handle-client* ( server -- )
drop
[
"" [
ftp-server-directory [
host-name <ftp-client> client set
send-banner handle-client-loop
] with-directory
@ -323,6 +334,7 @@ M: ftp-server handle-client* ( server -- )
ftp-server new-threaded-server
swap >>insecure
"ftp.server" >>name
5 minutes >>timeout
latin1 >>encoding ;
: ftpd ( port -- )