Tcl Library Source Code

[comment {-*- tcl -*- doctools manpage}]
[vset PACKAGE_VERSION 2.5]
[manpage_begin ftp n [vset PACKAGE_VERSION]]
[see_also ftpd]
[see_also mime]
[see_also pop3]
[see_also smtp]
[keywords ftp]
[keywords internet]

# PutData         Data to move when inline
# SourceCI        Channel to read from, "Put"
# ---------------------------------------------
#

package require Tcl 8.2
package require log     ; # tcllib/log, general logging facility.
package require ip      ; # tcllib/dns, ip address checking, classification, and manipulation.

namespace eval ::ftp {
    namespace export DisplayMsg Open Close Cd Pwd Type List NList \
	    FileSize ModTime Delete Rename Put Append Get Reget \
	    Newer Quote MkDir RmDir

    variable serial  0

	type_change {
	    set ftp(Type) $ftp(type:changeto)
	    set ftp(State) type
	    StateHandler $s
	}
        nlist_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) nlist_open
            } else {
                set errmsg "Error setting port!"
            }
        }
        nlist_passive {
            RequestPort $s
            set ftp(State) nlist_open
        }
        nlist_open {
            switch -exact -- $rc {
                1 {}
		2 {
                    if { [string equal $ftp(Mode) "passive"] } {

                    set complete_with 0
		    Command $ftp(Command) error $errmsg
                }
            }
        }
        list_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) list_open
            } else {
                set errmsg "Error setting port!"
		Command $ftp(Command) error $errmsg
            }
        }
        list_passive {
            RequestPort $s
            set ftp(State) list_open
        }
        list_open {
            switch -exact -- $rc {
                1 {}
		2 {
                    if { [string equal $ftp(Mode) "passive"] } {

                    set complete_with 0
		    Command $ftp(Command) error $errmsg
                }
            }
        }
        put_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) put_open
            } else {
                set errmsg "Error setting port!"
		Command $ftp(Command) error $errmsg
            }
        }
        put_passive {
            RequestPort $s
            set ftp(State) put_open
        }
        put_open {
            switch -exact -- $rc {
                1 -
		2 {
                    if { [string equal $ftp(Mode) "passive"] } {

                    set complete_with 0
		    Command $ftp(Command) error $errmsg
                }
            }
        }
        append_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) append_open
            } else {
                set errmsg "Error setting port!"
		Command $ftp(Command) error $errmsg
            }
        }
        append_passive {
            RequestPort $s
            set ftp(State) append_open
        }
        append_open {
            switch -exact -- $rc {
		1 -
                2 {
                    if { [string equal $ftp(Mode) "passive"] } {

                    set complete_with 0
		    Command $ftp(Command) error $errmsg
                }
            }
        }
        reget_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) reget_restart
            } else {
                set errmsg "Error setting port!"
		Command $ftp(Command) error $errmsg
            }
        }
        reget_passive {
            RequestPort $s
            set ftp(State) reget_restart
        }
        reget_restart {
            switch -exact -- $rc {
                2 { 
                    if { [string equal $ftp(Mode) "passive"] } {
                        if { ![OpenPassiveConn $s $buffer] } {

                    set complete_with 0
		    Command $ftp(Command) error $errmsg
                }
            }
        }
        get_active {
            if { [OpenActiveConn $s] } {
                OpenPort $s
                set ftp(State) get_open
            } else {
                set errmsg "Error setting port!"
		Command $ftp(Command) error $errmsg
            }
        } 
        get_passive {
            RequestPort $s
            set ftp(State) get_open
        }
        get_open {
            switch -exact -- $rc {
                1 -
		2 -
                3 {

	    set dest $source
	} else {
	    if {[file isdirectory $dest]} {
		set dest [file join $dest [file tail $source]]
	    }
	}
	if {![file exists [file dirname $dest]]} {
	    return -code error \
		-errorcode {FTP DESTINATION MISSING GET} \
		"ftp::Get, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist"
	}
	set ftp(LocalFilename) $dest
    }

    set ftp(RemoteFilename) $source

    if {$ftp(inline) == 2} {

    }

    if { $dest == "" } {
        set dest $source
    }
    if {![file exists [file dirname $dest]]} {
	return -code error \
	    -errorcode {FTP DESTINATION MISSING REGET} \
	    "ftp::Reget, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist"
    }

    set ftp(RemoteFilename) $source
    set ftp(LocalFilename) $dest
    set ftp(From) $from_bytes

    if { ![info exists ftp(State)] } {
        DisplayMsg $s "Not connected!" error
        return 0
    }

    if {[string length $ftp(Command)]} {
	return -code error \
	    -errorcode {FTP NOT-IMPLEMENTED ASYNC} \
	    "unable to retrieve file asynchronously (not implemented yet)"
    }

    if { $dest == "" } {
        set dest $source
    }
    if {![file exists [file dirname $dest]]} {
	return -code error \
	    -errorcode {FTP DESTINATION MISSING NEWER} \
	    "ftp::Newer, directory \"[file dirname $dest]\" for destination \"$dest\" does not exist"
    }

    set ftp(RemoteFilename) $source
    set ftp(LocalFilename) $dest

    # get remote modification time
    set rmt [ModTime $s $ftp(RemoteFilename)]

    
    set rc [catch {set ftp(DummySock) [socket -server [list [namespace current]::InitDataConn $s] 0]} msg]
    if { $rc != 0 } {
        DisplayMsg $s "$msg" error
        return 0
    }

    # prepare local ip address for PORT command
    # (convert pointed format to comma format)
    # IPv6 addresses are not changed by this.

    set ftp(LocalAddr) [lindex [fconfigure $ftp(CtrlSock) -sockname] 0]
    if {[IpVersion $s $ftp(LocalAddr)] == 4} {
	set ftp(LocalAddr) [string map {. ,} $ftp(LocalAddr)]
    }

    # get a new local port address for data transfer and convert it to
    # a format which is useable by the PORT (or EPRT) command.

    set p [lindex [fconfigure $ftp(DummySock) -sockname] 2]
    if { $VERBOSE } {
        DisplayMsg $s "D: Port is $p" data
    }

    switch -exact -- $ftp(IpVersion) {
	4 {
	    set ftp(DataPort) "[expr {$p / 256}],[expr {$p % 256}]"
	}
	6 {
	    set ftp(DataPort) $p
	}
    }

    # Marker for WaitDataConn
    set ftp(AC) 0
    return 1
}

proc ::ftp::OpenPort {s} {
    upvar ::ftp::ftp$s ftp
    # The array elements "IpVersion", "LocalAddr" and "DataPort" are
    # prepared by "OpenActiveConn", see above.
    switch -exact -- $ftp(IpVersion) {
	4 { PutsCtrlSock $s "PORT $ftp(LocalAddr),$ftp(DataPort)"	}
	6 { PutsCtrlSock $s "EPRT |2|$ftp(LocalAddr)|$ftp(DataPort)|"	}
    }
    # Extended Port command as per RFC 2428.
    return
}

#############################################################################
#
# OpenPassiveConn --
#
# Opens a ftp data connection
# 
# Arguments:
# buffer - returned line from server control connection 
# 
# Returns:
# 0 -			no connection
# 1 - 			connection established

proc ::ftp::OpenPassiveConn {s buffer} {
    upvar ::ftp::ftp$s ftp
    switch -exact -- $ftp(IpVersion) {
	4 {
	    # Port command response as per RFC 959.
	    if {![regexp -- {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)} $buffer all a1 a2 a3 a4 p1 p2] } {
		return 0
	    }
	    set ftp(LocalAddr) "$a1.$a2.$a3.$a4"
	    set ftp(DataPort) "[expr {$p1 * 256 + $p2}]"
	}
	6 {
	    # Extended Port command response as per RFC 2428.
	    if {![regexp -- {\((.)(.)(.)([0-9]+)(.)\)} $buffer all s1 s2 s3 p s4] ||
		($s1 != $s2) || ($s1 != $s3) || ($s1 != $s4)
	    } {
		return 0
	    }
	    set ftp(LocalAddr) $ftp(RemoteAddr)
	    set ftp(DataPort) $p
	}
    }

    # establish data connection for passive mode

    set rc [catch {set ftp(DataSock) [socket $ftp(LocalAddr) $ftp(DataPort)]} msg]
    if { $rc != 0 } {
	DisplayMsg $s "$msg" error
	return 0
    }

    InitDataConn $s $ftp(DataSock) $ftp(LocalAddr) $ftp(DataPort)
    return 1
}

proc ::ftp::RequestPort {s} {
    upvar ::ftp::ftp$s ftp
    if {![info exists ftp(IpVersion)]} {
	set ftp(RemoteAddr) [lindex [fconfigure $ftp(CtrlSock) -peername] 0]
	IpVersion $s $ftp(RemoteAddr)
    }
    switch -exact -- $ftp(IpVersion) {
	4 { PutsCtrlSock $s "PASV" }
	6 { PutsCtrlSock $s "EPSV" }
    }
    # Extended Port command as per RFC 2428.
    return
}

proc ::ftp::IpVersion {s addr} {
    upvar ::ftp::ftp$s ftp
    set v [ip::version $addr]
    switch -exact -- $v {
	4 - 6 {
	    set ftp(IpVersion) $v
	}
	default {
	    DisplayMsg "" "Unknown type of IP-address $addr!" error
	    return -code error \
		-errorcode {FTP IP-ADDRESS BAD-VERSION} \
		"Unknown type of IP-address $addr!"
	}
    }
    return $v
}

#############################################################################
#
# OpenControlConn --
#
# Opens a ftp control connection

    set ::ftp::VERBOSE 1
    set ::ftp::DEBUG 0
}

# ==================================================================
# At last, everything is fine, we can provide the package.

package provide ftp 2.5

if {![package vsatisfies [package provide Tcl] 8.2]} {return}
package ifneeded ftp         2.5    [list source [file join $dir ftp.tcl]]
package ifneeded ftp::geturl 0.2.1  [list source [file join $dir ftp_geturl.tcl]]