diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index 9a4858337e..cc51be8238 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2008 Doug Coleman. ! 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 -destructors ftp io io.backend io.directories io.encodings -io.encodings.binary tools.files io.encodings.utf8 io.files -io.files.info io.pathnames io.servers.connection io.sockets -io.streams.duplex io.streams.string io.timeouts kernel make math -math.bitwise math.parser namespaces sequences splitting threads -unicode.case logging calendar.format strings io.files.links -io.files.types io.encodings.8-bit.latin1 simple-tokenizer ; +destructors ftp io io.directories io.encodings +io.encodings.8-bit.latin1 io.encodings.binary io.encodings.utf8 +io.files io.files.info io.files.types io.pathnames +io.servers.connection io.sockets io.streams.string io.timeouts +kernel logging math math.bitwise math.parser namespaces +sequences simple-tokenizer splitting strings threads +tools.files unicode.case ; IN: ftp.server SYMBOL: server @@ -281,8 +281,20 @@ ERROR: no-directory-permissions ; : directory-change-failed ( -- ) "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 -- ) tokenized>> 1 swap ?nth [ + fixup-relative-path dup can-serve-directory? [ set-current-directory directory-change-success @@ -350,3 +362,5 @@ M: ftp-server handle-client* ( server -- ) start-server ; ! 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| + diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index b307128efb..a7036e00a4 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -76,6 +76,8 @@ ERROR: no-parent-directory path ; [ f ] } cond ; +PRIVATE> + : absolute-path? ( path -- ? ) { { [ dup empty? ] [ f ] } @@ -85,7 +87,9 @@ ERROR: no-parent-directory path ; [ f ] } cond nip ; -PRIVATE> +: append-path-naive ( path1 path2 -- path ) + [ trim-tail-separators ] + [ trim-head-separators ] bi* "/" glue ; : append-path ( path1 path2 -- path ) { @@ -101,10 +105,7 @@ PRIVATE> { [ over absolute-path? over first path-separator? and ] [ [ 2 head ] dip append ] } - [ - [ trim-tail-separators ] - [ trim-head-separators ] bi* "/" glue - ] + [ append-path-naive ] } cond ; : prepend-path ( path1 path2 -- path )