From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 3 Jul 2003 15:56:23 +0000 (+0000)
Subject: ftpvfs multiple port support
X-Git-Tag: vfs-1-3~15
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=7a89ad5ac68e7ff974884b552cccd5b2ad445be0;p=tclvfs

ftpvfs multiple port support
---

diff --git a/ChangeLog b/ChangeLog
index cccb5ce..c27cc94 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2003-06-16  Vince Darley <vincentdarley@sourceforge.net>
+
+	* library/ftpvfs.tcl: added support for ports other than 21,
+	patch from msofer -- thanks.
+	
 2003-06-16  Vince Darley <vincentdarley@sourceforge.net>
 
 	* library/ftpvfs.tcl: added '-output ::vfs::log' to ftp
diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 784d930..779910b 100644
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -7,32 +7,32 @@ package require ftp
 namespace eval vfs::ftp {}
 
 proc vfs::ftp::Mount {dirurl local} {
+    set dirurl [string trim $dirurl]
     ::vfs::log "ftp-vfs: attempt to mount $dirurl at $local"
     if {[string index $dirurl end] != "/"} {
 	::vfs::log "ftp-vfs: adding missing directory delimiter to mount point"
 	append dirurl "/"
     }
     
-    if {![regexp {(ftp://)?(([^:]*)(:([^@]*))?@)?([^/]*)(/(.*/)?([^/]*))?$} \
-      $dirurl junk junk junk user junk pass host "" path file]} {
+    set urlRE {(?:ftp://)?(?:([^@:]*)(?::([^@]*))?@)?([^/:]+)(?::([0-9]*))?/(.*/)?$} 
+    if {![regexp $urlRE $dirurl - user pass host port path]} {
 	return -code error "Sorry I didn't understand\
 	  the url address \"$dirurl\""
     }
     
-    if {[string length $file]} {
-	return -code error "Can only mount directories, not\
-	  files (perhaps you need a trailing '/' - I understood\
-	  a path '$path' and file '$file')"
-    }
-    
     if {![string length $user]} {
 	set user anonymous
     }
     
-    set fd [::ftp::Open $host $user $pass -output ::vfs::log]
+    if {![string length $port]} {
+	set port 21
+    }
+    
+    set fd [::ftp::Open $host $user $pass -port $port -output ::vfs::log]
     if {$fd == -1} {
 	error "Mount failed"
     }
+    
     if {$path != ""} {
 	if {[catch {
 	    ::ftp::Cd $fd $path