Tcl Library Source Code

# Handle timeouts
# 
# Arguments:
#  -
#
proc ::ftp::Timeout {s} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    if {$VERBOSE} { DisplayMsg $s Waiting|Timeout! }

    after cancel $ftp(Wait)
    set ftp(state.control) 1

    DisplayMsg "" "Timeout of control connection after $ftp(Timeout) sec.!" error
    Command $ftp(Command) timeout
    return

# 
# Arguments:
#  -		
#

proc ::ftp::WaitOrTimeout {s} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    set retvar 1

    if { ![string length $ftp(Command)] && [info exists ftp(state.control)] } {

	if {$VERBOSE} { DisplayMsg $s Waiting|$ftp(Timeout)|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# }

        set ftp(Wait) [after [expr {$ftp(Timeout) * 1000}] [list [namespace current]::Timeout $s]]

        vwait ::ftp::ftp${s}(state.control)
        set retvar $ftp(state.control)

	if {$VERBOSE} { DisplayMsg $s Waiting|Done|\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\#\# }
    }

    if {$ftp(Error) != ""} {
        set errmsg $ftp(Error)
        set ftp(Error) ""
        DisplayMsg $s $errmsg error
    }

    if {$VERBOSE} { DisplayMsg $s Waiting|OK|$retvar }
    return $retvar
}

#############################################################################
#
# WaitComplete --
#

#			the socket channel identifier.

proc ::ftp::StateHandler {s {sock ""}} {
    upvar ::ftp::ftp$s ftp
    variable DEBUG 
    variable VERBOSE

    if {$VERBOSE} { DisplayMsg $s StateHandler/$s/$sock/================================================ }

    # disable fileevent on control socket, enable it at the and of the state machine
    # fileevent $ftp(CtrlSock) readable {}
		
    # there is no socket (and no channel to get) if called from a procedure

    set rc "   "
    set msgtext {}

            if {![string equal $ftp(State) "quit_sent"]} {
		set ftp(Error) "Service not available!"
	    }
            CloseDataConn $s
            WaitComplete $s 0
	    Command $ftp(Command) terminated
            catch {unset ftp(State)}

	    if {$VERBOSE} { DisplayMsg $s EOF/Control }
            return
        } else {
	    # Fix SF bug #466746: Incomplete line, do nothing.
	    if {$VERBOSE} { DisplayMsg $s Incomplete/Line }
	    return	   
	}
    } 
	
    if { $DEBUG } {
        DisplayMsg $s "-> rc=\"$rc\" -> msgtext=\"$msgtext\" -> state=\"$ftp(State)\""
    }

    # In asynchronous mode, should we move on to the next state?
    set nextState 0
	
    # system status replay
    if { [string equal $rc "211"] } {
	if {$VERBOSE} { DisplayMsg $s Ignore/211 }
        return
    }

    # use only the first digit 
    regexp -- "^\[0-9\]?" $rc rc

    if {$VERBOSE} { DisplayMsg $s StateBegin////////($ftp(State)) }

    switch -exact -- $ftp(State) {
        user { 
            switch -exact -- $rc {
                2 {
                    PutsCtrlSock $s "USER $ftp(User)"
                    set ftp(State) passwd
		    Command $ftp(Command) user

                }
            }
        }
        put_close {
            switch -exact -- $rc {
		1 {
		    # Keep going
		    if {$VERBOSE} { DisplayMsg $s put_close/1--continue }
		    return
		}
                2 {
                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) put $ftp(RemoteFilename)
                }

            }
        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }

    if {$VERBOSE} { DisplayMsg $s ////////StateDone }

    # finish waiting 
    if { [info exists complete_with] } {
	if {$VERBOSE} { DisplayMsg $s WaitBegin////////($complete_with) }

        WaitComplete $s $complete_with

	if {$VERBOSE} { DisplayMsg $s ////////WaitDone }
    }

    # display control channel message
    if { [info exists buffer] } {
        if { $VERBOSE } {
            foreach line [split $buffer \n] {
                DisplayMsg $s "C: $line" control

    }

    # If operating asynchronously, commence next state
    if {$nextState && [info exists ftp(NextState)] && [llength $ftp(NextState)]} {
	# Pop the head of the NextState queue
	set ftp(State) [lindex $ftp(NextState) 0]
	set ftp(NextState) [lreplace $ftp(NextState) 0 0]

	if {$VERBOSE} { DisplayMsg $s Recurse/StateHandler }
	StateHandler $s
    }

    # enable fileevent on control socket again
    #fileevent $ftp(CtrlSock) readable [list ::ftp::StateHandler $ftp(CtrlSock)]

    if {$VERBOSE} { DisplayMsg $s ======/HandlerDone }
    return
}

#############################################################################
#
# Type --
#
# REPRESENTATION TYPE - Sets the file transfer type to ascii or binary.

# Arguments:
# dir - 		directory to list 
# 
# Returns:
# sorted list of files or {} if listing fails

proc ::ftp::NList {s { dir ""}} {
    variable VERBOSE
    upvar ::ftp::ftp$s ftp

    if {$VERBOSE} { DisplayMsg $s NList($s)($dir)~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }

    if { ![info exists ftp(State)] } {
        if { ![string is digit -strict $s] } {
            DisplayMsg $s "Bad connection name \"$s\"" error
        } else {
            DisplayMsg $s "Not connected!" error
        }
        return {}
    }

    set ftp(List) {}
    if { $dir == "" } {
        set ftp(Dir) ""
    } else {
        set ftp(Dir) " $dir"
    }

    # save current type and force ascii mode
    set old_type $ftp(Type)
    if { $ftp(Type) != "ascii" } {
	if {$VERBOSE} { DisplayMsg $s NList/ForceAscii }

	if {[string length $ftp(Command)]} {
	    set ftp(NextState) [list nlist_$ftp(Mode) type_change list_last]
	    set ftp(type:changeto) $old_type
	    Type $s ascii
	    return {}
	}
        Type $s ascii
    }

    set ftp(State) nlist_$ftp(Mode)

    if {$VERBOSE} { DisplayMsg $s NList/Process~~~~~~~~~~~~~~~~~~~ }
    StateHandler $s

    if {$VERBOSE} { DisplayMsg $s NList/Processed~~~~~~~~~~~~~~~~~ }

    # wait for synchronization
    set rc [WaitOrTimeout $s]

    # restore old type
    if {$VERBOSE} { DisplayMsg $s NList/RestoreType~~~~~~~~~~~~~~~~~~~~~ }
    if { [Type $s] != $old_type } {
        Type $s $old_type
    }

    unset ftp(Dir)
    if { $rc } {
	if {$VERBOSE} { DisplayMsg $s NList/ReturnData~~~~~~~~~~~~~~~~~~~~~~~ }

	return [lsort [split [string trim $ftp(List) \n] \n]]
    } else {
	if {$VERBOSE} { DisplayMsg $s NList/CDC~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }

        CloseDataConn $s
        return {}
    }

    if {$VERBOSE} { DisplayMsg $s ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~NList/Done }
}

#############################################################################
#
# List --
#
# LIST - This command causes a list to be sent from the server

# addr -		the address, in network address notation, 
#			of the client's host,
# port -		the client's port number

proc ::ftp::InitDataConn {s sock addr port} {
    upvar ::ftp::ftp$s ftp
    variable VERBOSE

    if { $VERBOSE } {
        DisplayMsg $s "D: New Connection from $addr:$port" data
    }

    # If the new channel is accepted, the dummy channel will be closed

    catch {close $ftp(DummySock); unset ftp(DummySock)}

    set ftp(state.data) 0

        }
	default {
	    error "Unknown state \"$ftp(State)\""
	}
    }

    if { $VERBOSE } {
        DisplayMsg $s "D: ... Connection from $addr:$port ... initialized" data
    }
    return
}

#############################################################################
#
# OpenActiveConn --