Attachment "ftp_geturl.patch" to
ticket [476804ffff]
added by
patthoyts
2002-01-12 04:47:36.
Here is a patch that works for my win32 based ftp server. I'm suspect it would
be better to fix the ParseList proc rather than avoid it but it's difficult to
be sure of parsing ls -l output from different platforms (I'm thinking VMS
could be _really_ different).
*** ftp_geturl.tcl.orig Fri Nov 16 23:37:00 2001
--- ftp_geturl.tcl Fri Jan 11 21:39:42 2002
***************
*** 17,27 ****
# Returns the contents of the requested url.
proc ftp::geturl {url} {
! # FUTURE: -validate to validate existence of url, but no download of contents.
array set urlparts [uri::split $url]
! set fdc [ftp::Open $urlparts(host) anonymous [email protected]]
if {$fdc < 0} {
return -code error "Cannot reach host for url \"$url\""
}
--- 17,39 ----
# Returns the contents of the requested url.
proc ftp::geturl {url} {
! # FUTURE: -validate to validate existence of url, but no download
! # of contents.
array set urlparts [uri::split $url]
! if {$urlparts(user) == {}} {
! set urlparts(user) "anonymous"
! }
! if {$urlparts(pwd) == {}} {
! set urlparts(pwd) "[email protected]"
! }
! if {$urlparts(port) == {}} {
! set urlparts(port) 21
! }
!
! set fdc [ftp::Open $urlparts(host) $urlparts(user) $urlparts(pwd) \
! -port $urlparts(port)]
if {$fdc < 0} {
return -code error "Cannot reach host for url \"$url\""
}
***************
*** 42,53 ****
return -code error "Cannot reach directory of url \"$url\""
}
# The result of List is a list of entries in the given directory.
# Note that it is in 'ls -l format. We parse that into a more
# readable array.
! array set flist [ftp::ParseList [ftp::List $fdc ""]]
! if {![info exists flist($ftp_file)]} {
ftp::Close $fdc
return -code error "Cannot reach item of url \"$url\""
}
--- 54,73 ----
return -code error "Cannot reach directory of url \"$url\""
}
+ # Fix for the tkcon List enhancements in ftp.tcl
+ set List ::ftp::List_org
+ if {[info command $List] == {}} {
+ set List ::ftp::List
+ }
+
# The result of List is a list of entries in the given directory.
# Note that it is in 'ls -l format. We parse that into a more
# readable array.
! #array set flist [ftp::ParseList [$List $fdc ""]]
! #if {![info exists flist($ftp_file)]} {}
! set flist [$List $fdc $ftp_file]
! if {$flist == {}} {
ftp::Close $fdc
return -code error "Cannot reach item of url \"$url\""
}
***************
*** 58,73 ****
# Link : For now we do not follow the link but return the
# meta information, i.e. the path it is pointing to.
! switch -exact -- [lindex $flist($ftp_file) 0] {
! file {
ftp::Get $fdc $ftp_file -variable contents
}
! dir {
! set contents [ftp::ParseList [ftp::List $fdc $ftp_file]]
}
! link {
! set contents $flist($ftp_file)
}
}
ftp::Close $fdc
--- 78,98 ----
# Link : For now we do not follow the link but return the
# meta information, i.e. the path it is pointing to.
! #switch -exact -- [lindex $flist($ftp_file) 0] {}
! switch -exact -- [string index [lindex $flist 0] 0] {
! - {
ftp::Get $fdc $ftp_file -variable contents
}
! d {
! set contents [ftp::NList $fdc $ftp_file]
}
! l {
! set contents $flist
}
+ default {
+ ftp::Close $fdc
+ return -code error "File information \"$flist\" not recognised"
+ }
}
ftp::Close $fdc
