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

                }
            }
        }
        list_close {
            switch -exact -- $rc {
                1 {}
		2 {
		    # Sync control sequencer to active data connection
		    # before stepping out
		    WaitDataConn $s

		    set nextState 1
		    if {[info exists ftp(NextState)] && ![llength $ftp(NextState)]} {
			Command $ftp(Command) list [ListPostProcess $ftp(List)]
		    } else {
			set complete_with 1
		    }
                }

                }
            }
        }
        put_close {
            switch -exact -- $rc {
		1 {
		    # Keep going
		    if {$VERBOSE} { DisplayMsg $s put_close/1--continue }
		    return
		}
                2 {
		    # Sync control sequencer to active data connection
		    # before stepping out
		    WaitDataConn $s

                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) put $ftp(RemoteFilename)
                }
                default {
		    DisplayMsg $s "rc = $rc msgtext = \"$msgtext\""
                    set errmsg "Error storing file \"$ftp(RemoteFilename)\" due to \"$msgtext\""

		    Command $ftp(Command) error $errmsg
                }
            }
        }
        append_close {
            switch -exact -- $rc {
                2 {
		    # Sync control sequencer to active data connection
		    # before stepping out
		    WaitDataConn $s

                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) append $ftp(RemoteFilename)
                }
                default {
                    set errmsg "Error storing file \"$ftp(RemoteFilename)\"!"
                    set complete_with 0

		    Command $ftp(Command) error $errmsg
                }
            }
        }
        reget_close {
            switch -exact -- $rc {
                2 {
		    # Sync control sequencer to active data connection
		    # before stepping out
		    WaitDataConn $s

                    set complete_with 1
		    set nextState 1
		    Command $ftp(Command) get $ftp(RemoteFilename):$ftp(From):$ftp(To)
		    unset ftp(From) ftp(To)
                }
                default {
                    set errmsg "Error retrieving file \"$ftp(RemoteFilename)\"!"

		    Command $ftp(Command) error $errmsg
                }
            }
        }
        get_close {
            switch -exact -- $rc {
                2 {
		    # Sync control sequencer to active data connection
		    # before stepping out
		    WaitDataConn $s

                    set complete_with 1
		    set nextState 1
		    if {$ftp(inline)} {
			upvar #0 $ftp(get:varname) returnData
			set returnData $ftp(GetData)
			Command $ftp(Command) get $ftp(GetData)
		    } else {

            }
        }
	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

    # from the caller. Closing it is not our responsibility.

    if {[info exists ftp(get:channel)]} {
	catch {unset ftp(get:channel)}
	catch {unset ftp(DestCI)}
    }

    catch { unset ftp(AC) }
    catch {after cancel $ftp(Wait)}
    catch {fileevent $ftp(DataSock) readable {}}
    catch {close $ftp(DataSock); unset ftp(DataSock)}
    catch {close $ftp(DestCI); unset ftp(DestCI)} 
    catch {close $ftp(SourceCI); unset ftp(SourceCI)}
    catch {close $ftp(DummySock); unset ftp(DummySock)}
    return

# 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
    }

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

#############################################################################
#
# WaitDataConn --
# Arguments: The ftp connection handle
# Returns:   None
#
# Synchronizes the control sequencer to the data connection (active
# mode). This must be placed at the end of all state sequences,
# i.e. the last state of each sequence, dealing with a data
# connection. Without the sync the control sequencer may step to the
# next command causing a very late-coming data connection to encounter
# an unknown state, and failing to establish what to do.
#
# Sync is achieved through the state field AC, in cooperation with the
# procedures OpenActiveConn and InitDataConn.
#
# Missing field => Not an active connection - Ignore
# AC == 0       => OAC has run, IDC not     - Wait for IDC, then cleanup
# AC == 1       => OAC has run, IDC as well - No waiting, just cleanup.

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

    if {$VERBOSE} { DisplayMsg $s WDC|$s|Begin|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ }

    # Passive connection, nothing to do
    if {![info exists ftp(AC)]} {
	if {$VERBOSE} { DisplayMsg $s WDC|$s|Passive|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ }
	return
    }

    # InitDataConn has not run yet. Wait!
    if {!$ftp(AC)} {
	if {$VERBOSE} { DisplayMsg $s WDC|$s|Sync|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ }
	vwait ::ftp::ftp${s}(AC)
	# assert ftp(AC) == 1
	if {$VERBOSE} { DisplayMsg $s WDC|$s|Synced|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ }
    } ; # else: Was run already

    if {$VERBOSE} { DisplayMsg $s WDC|$s|Cleanup|@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ }
    # InitDataConn has run, clean up and continue
    unset ftp(AC)
    return
}

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

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

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

#############################################################################
#
# OpenPassiveConn --
#