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

If ftp clients send a path starting with /, treat it as a path relative to the serving directory. Expose absolute-path? and append-path-naive in io.pathnames to implement this change.

db4
Doug Coleman 2010-09-04 22:16:57 -05:00
parent d3992ff611
commit 0ec1a89f54
2 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/ftp/server/server.factor
View File

@ -1,14 +1,14 @@
! 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 assocs byte-arrays calendar classes combinators USING: accessors calendar calendar.format classes combinators
combinators.short-circuit concurrency.promises continuations combinators.short-circuit concurrency.promises continuations
destructors ftp io io.backend io.directories io.encodings destructors ftp io io.directories io.encodings
io.encodings.binary tools.files io.encodings.utf8 io.files io.encodings.8-bit.latin1 io.encodings.binary io.encodings.utf8
io.files.info io.pathnames io.servers.connection io.sockets io.files io.files.info io.files.types io.pathnames
io.streams.duplex io.streams.string io.timeouts kernel make math io.servers.connection io.sockets io.streams.string io.timeouts
math.bitwise math.parser namespaces sequences splitting threads kernel logging math math.bitwise math.parser namespaces
unicode.case logging calendar.format strings io.files.links sequences simple-tokenizer splitting strings threads
io.files.types io.encodings.8-bit.latin1 simple-tokenizer ; tools.files unicode.case ;
IN: ftp.server IN: ftp.server
SYMBOL: server SYMBOL: server
@ -281,8 +281,20 @@ ERROR: no-directory-permissions ;
: directory-change-failed ( -- ) : directory-change-failed ( -- )
"Failed to change directory." 553 server-response ; "Failed to change directory." 553 server-response ;
: make-path-relative? ( path -- ? )
{
[ absolute-path? ]
[ drop server get serving-directory>> ]
} 1&& ;
: fixup-relative-path ( string -- string' )
dup make-path-relative? [
[ server get serving-directory>> ] dip append-path-naive
] when ;
: handle-CWD ( obj -- ) : handle-CWD ( obj -- )
tokenized>> 1 swap ?nth [ tokenized>> 1 swap ?nth [
fixup-relative-path
dup can-serve-directory? [ dup can-serve-directory? [
set-current-directory set-current-directory
directory-change-success directory-change-success
@ -350,3 +362,5 @@ M: ftp-server handle-client* ( server -- )
<ftp-server> start-server ; <ftp-server> start-server ;
! sudo tcpdump -i en1 -A -s 10000 tcp port 21 ! sudo tcpdump -i en1 -A -s 10000 tcp port 21
! [2010-09-04T22:07:58-05:00] DEBUG server-response: 500:Unrecognized command: EPRT |2|0:0:0:0:0:0:0:1|59359|

11
core/io/pathnames/pathnames.factor
View File

@ -76,6 +76,8 @@ ERROR: no-parent-directory path ;
[ f ] [ f ]
} cond ; } cond ;
PRIVATE>
: absolute-path? ( path -- ? ) : absolute-path? ( path -- ? )
{ {
{ [ dup empty? ] [ f ] } { [ dup empty? ] [ f ] }
@ -85,7 +87,9 @@ ERROR: no-parent-directory path ;
[ f ] [ f ]
} cond nip ; } cond nip ;
PRIVATE> : append-path-naive ( path1 path2 -- path )
[ trim-tail-separators ]
[ trim-head-separators ] bi* "/" glue ;
: append-path ( path1 path2 -- path ) : append-path ( path1 path2 -- path )
{ {
@ -101,10 +105,7 @@ PRIVATE>
{ [ over absolute-path? over first path-separator? and ] [ { [ over absolute-path? over first path-separator? and ] [
[ 2 head ] dip append [ 2 head ] dip append
] } ] }
[ [ append-path-naive ]
[ trim-tail-separators ]
[ trim-head-separators ] bi* "/" glue
]
} cond ; } cond ;
: prepend-path ( path1 path2 -- path ) : prepend-path ( path1 path2 -- path )