Don't allow access through symlinks leading out of the ftp.server serving directory

diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor
index 251a99115efaa31dcecf204172002f7ac35e13e4..1077aebf079f954bcf61cc794b9c6f61db6bc683 100644 (file)
--- a/basis/ftp/server/server.factor
+++ b/basis/ftp/server/server.factor
@@ -58,7 +58,7 @@ C: <ftp-disconnect> ftp-disconnect
     send-response ;
 
 : serving? ( path -- ? )
-    normalize-path server get serving-directory>> head? ;
+    resolve-symlinks server get serving-directory>> head? ;
 
 : can-serve-directory? ( path -- ? )
     { [ exists? ] [ file-info directory? ] [ serving? ] } 1&& ;
@@ -343,7 +343,7 @@ M: ftp-server handle-client* ( server -- )
 : <ftp-server> ( directory port -- server )
     latin1 ftp-server new-threaded-server
         swap >>insecure
-        swap normalize-path >>serving-directory
+        swap resolve-symlinks >>serving-directory
         "ftp.server" >>name
         5 minutes >>timeout ;