#!/usr/local/bin/wish8.0
#####################################################################
# X-Files FTP v1.04beta        Date: 27.05.98        (c) Juha Forsten  
# ===================================================================
#  
#####################################################################
#
# TODO:
# =====
#
# 1) Do something to '++ ADD' -cases !!
#
# 2) How about put/get when not enough disk space ?
#
# 3) Is get_ascii bullet-proof ?
#
#####################################################################
package provide FTP 1.0

#####################################################################
# Define return-codes for success (OK) and failure (ERROR).
set ftp(return_OK) 1
set ftp(return_ERROR) -1

####################################################################
# FTP_LoadPackage:
#
#   Call this procedure to explicity load the FTP-package!
#   It's only a dummy procedure!!
#
proc FTP_LoadPackage {} {
}

####################################################################
# FTP_Log:
#
#   Replace this proc with something usefull or comment the 
#   "puts $str" for quite-mode..
#
proc FTP_Log {str} {
    # Get the name of calling procedure
    set procName [lindex [info level [expr {[info level] -1}]] 0]

    # Get the first argument of the calling procedure 
    # (usually the name of the commSock)
    set arg1     [lindex [info level [expr {[info level] -1}]] 1]

    # Puts "all-too-much" debug-info
    puts "$procName<$arg1>: $str"
}


####################################################################
# FTP_UnsetVariables:
#
#   Use after closing the commSock. Unsets the variables that have 
#   been used in just closed session..
#
proc FTP_UnsetVariables {sock} {
    global ftp
    foreach i [array names ftp $sock.*] {
	#puts "unset ftp($i)"
	unset ftp($i)
    }
}

####################################################################
# FTP_ReadSocket: [INTERNAL]
#
#   Reads data form socket. 
#
proc FTP_ReadSocket {sock} {
    global ftp
    if {[eof $sock]} {
	catch {close $sock}
	set ftp($sock.close) 1
	FTP_Log "CLOSED!"
    } {
	if {[catch {set line [gets $sock]}]} {
	    FTP_Log "ERROR READING SOCKET!"
	    return $ftp(return_ERROR)
	}
	while {![string match {[0-9][0-9][0-9] *} $line]} {
	    if {[eof $sock]} {
		FTP_Log "ERROR - SOCKET CLOSED!!"
		break
	    }
	    set line [gets $sock]
	}
	if {[string match "421 *" $line]} {
	    catch {close $sock}
	    FTP_Log "CONNECTION CLOSED!"
	    set ftp($sock.reply) "$line"
	    eval  "$ftp($sock.timeoutcmd) $sock"
	    return $ftp(return_ERROR)
	}
	if {$ftp($sock.append)} {
	    if {$line != ""} {
		set ftp($sock.reply) "$ftp($sock.reply)\n$line"
	    } {
		set ftp($sock.strobe) 1
	    }
	} {
	    set ftp($sock.reply) $line
	    set ftp($sock.strobe) 1
	    FTP_Log "<< $ftp($sock.reply)"
	}
    }
}

####################################################################
# FTP_ReadSocketASCII: [INTERNAL]
#
#   Reads data form socket. 
#
proc FTP_ReadSocketASCII {sock} {
    global ftp
    if {[eof $sock]} {
	catch {close $sock}
	set ftp($sock.close) 1
	FTP_Log "CLOSED!"
    } {
	set line [gets $sock]
	if {$line != ""} {
	    set ftp($sock.reply) "$ftp($sock.reply)\n$line"
	    incr ftp($sock.rows) 
	} {
	    set ftp($sock.strobe) 1
	}
    }
}

####################################################################
# FTP_OpenSocket: [INTERNAL]
#
proc FTP_OpenSocket {host port timeoutval} {
    global ftp 
    if {[catch {set sock [socket $host $port]} err]} {
	set ftp($ftp(return_ERROR).reply) $err
	return $ftp(return_ERROR)
    }
    set ftp($sock.append) 0
    fileevent  $sock readable [list FTP_ReadSocket $sock]
    fconfigure $sock -buffering line -blocking on
    return $sock
}

####################################################################
# FTP_OpenDataSocket: [INTERNAL]
#
proc FTP_OpenDataSocket {commSock {active 0}} {
    global ftp
    set ftp($commSock.datasockOK) 0
    if {$active} {
	FTP_Log "Opening active dataSocket.."
	# Active
	## ADD SOME ERROR-CHECKING!!
	set serv    [socket -server "FTP_DataAccept $commSock" 0]
	set ownip   [lindex [fconfigure $commSock -sockname] 0]
	set ownport [lindex [fconfigure $serv -sockname] 2]
	set ownportP "[expr {$ownport / 256}],[expr {$ownport % 256}]" 
	regsub -all "\[.\]" $ownip "," ownipP
	puts $commSock "PORT $ownipP,$ownportP"
	FTP_Log ">> PORT $ownipP,$ownportP"
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
	
	if {[string match "5??*" $ftp($commSock.reply)]} {
	    # Error
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}
    } {
	# Passive
	FTP_Log "Opening passive dataSocket.."
	puts $commSock "PASV"
	FTP_Log ">> PASV"
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
	
	if {[string match "5??*" $ftp($commSock.reply)]} {
	    # Error
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}

	# Get the IP-address
	regexp {([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+),([0-9]+)}\
		$ftp($commSock.reply) junk h1 h2 h3 h4 p1 p2
	set host "$h1.$h2.$h3.$h4"
	set port [expr {$p1*256 + $p2}]
	## ADD SOME ERROR-CHECKING!!
	set dataSock [socket -myport 20 $host $port]
	set ftp($dataSock.append) 0
	fconfigure $dataSock -buffering none -blocking off
	set ftp($commSock.datasock) $dataSock
	FTP_Log "Passive dataSocket <$dataSock>"
	set ftp($commSock.datasokOK) 1
    }
    return $ftp(return_OK)
}

####################################################################
# FTP_DataAccept: [INTERNAL]
#
#   Called from socket-server in active mode
#
proc FTP_DataAccept {commSock sock addr port} {
    global ftp
    set ftp($commSock.datasock)   $sock
    set ftp($commSock.datasockOK) 1
    FTP_Log "$sock $addr $port"
}

####################################################################
# FTP_TimeOutVWait: [INTERNAL]
#
#   Vwait with timeout.
#
proc FTP_TimeOutVWait {sock variable} {
    global ftp
    set afterid [after [expr {$ftp($sock.timeoutval) *1000}] \
	    "catch {set $variable $ftp(return_ERROR)}"] 
    vwait $variable
    if {[set $variable] == $ftp(return_ERROR)} {
	# Can't get connection, close everything...
	FTP_Log "$variable: [set $variable]"
	FTP_Log "CLIENT SIDE TIMEOUT! - Closing connection..."
	set ftp($sock.timeout) 1
	catch {close $ftp($sock.datasock)}
	catch {close $sock}
	return $ftp(return_ERROR)
    } {
	# OK!
	FTP_Log "-> Triggered '$variable' = [set $variable]"
	after cancel $afterid
	return $ftp(return_OK)
    }
}

####################################################################
# FTP_TimeOutProc: [INTERNAL]
#
#   Called when server-side timeout has occured.
#   You can replase this with your own procedure.
# 
proc FTP_TimeOutProc {sock} {
    global ftp
    set ftp($sock.timeout) 1
    set ftp($sock.strobe)  1
    set ftp($sock.close)   1
    FTP_Log " << $ftp($sock.reply)"
}

####################################################################
# FTP_Open:
#
#   Starts the ftp-session
#
proc FTP_Open {host user pass {port 21} {chunk 4096}\
	{timeoutval 60} {timeoutcmd FTP_TimeOutProc}} {
    global ftp
    FTP_Log "Trying to connect ..."
    set commSock [FTP_OpenSocket $host $port $timeoutval]
    if {$commSock == $ftp(return_ERROR)} {
	set ftp($ftp(return_ERROR).timeout) 0
	set ftp($ftp(return_ERROR).reply)   "$ftp($commSock.reply)"
	set ftp($ftp(return_ERROR).status)  "ERROR: $ftp($commSock.reply)"
	FTP_Log "ERROR - $ftp($commSock.reply)"
	return $ftp(return_ERROR)
    }
    set ftp($commSock.status) "Busy: OPEN_FTP"    

    ## Initializing variables ..
    set ftp($commSock.totalsize)  0
    set ftp($commSock.currsize)   0
    set ftp($commSock.starttime)  0
    set ftp($commSock.stoptime)   0
    set ftp($commSock.totaltime)  0
    set ftp($commSock.transrate)  0
    set ftp($commSock.abort)      0
    set ftp($commSock.chunk)      $chunk
    set ftp($commSock.timeout)    0
    set ftp($commSock.timeoutval) $timeoutval
    set ftp($commSock.timeoutcmd) $timeoutcmd
    # initialize the special variable for open-errors (timeout!)
    set ftp($ftp(return_ERROR).status)  "ERROR: TIMEOUT!"

    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {![string match "220 *" $ftp($commSock.reply)]} {
	# Error in logging
	set ftp($ftp(return_ERROR).reply)  "$ftp($commSock.reply)"
	set ftp($ftp(return_ERROR).status) "ERROR: $ftp($commSock.reply)"
	FTP_Log "ERROR - $ftp($commSock.reply)"
	catch {close $commSock}
	FTP_UnsetVariables $commSock
	return $ftp(return_ERROR)
    }
    FTP_Log ">> USER $user"
    puts $commSock "USER $user"

    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {[string match "331 *" $ftp($commSock.reply)]} {
	FTP_Log ">> PASS 'password'"
	puts $commSock "PASS $pass"

	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
    }

    if {![string match "230 *" $ftp($commSock.reply)]} {
	# Error in login. Close connection..
	set ftp($ftp(return_ERROR).timeout) 0
	set ftp($ftp(return_ERROR).reply)   "$ftp($commSock.reply)"
	set ftp($ftp(return_ERROR).status)  "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed)           ""

	FTP_Log "ERROR - $ftp($commSock.reply)"
	catch {close $commSock}
	FTP_UnsetVariables $commSock
	return $ftp(return_ERROR)
    }
    # OK! FTP opened.
    unset ftp($ftp(return_ERROR).status)
    set ftp($commSock.close)      0
    set ftp($commSock.status)     "Ok"
    FTP_Log "Opened ($commSock) to $host"
    return $commSock
}

####################################################################
# FTP_GET_ASCII:
#
#   Get ascii file.
#   Read data in variable <TBD>
#
proc FTP_GET_ASCII {commSock {type 0} {active 0} {dir {}} {file {}}} {
    global ftp
    FTP_Log "type=$type, active=$active, dir=$dir, file=$file "    
    if {$file==""} {
	if {$type} {
	    # MKi
	    # to get rid of dotfiles, we need -A, to get filetype we need -F
	    set com "NLST -FA"
	} {
	    # get rid of . and .. we need -A
	    set com "LIST"
	}
	if {$dir!=""} {
	    set com "$com $dir"
	}
	
    } {
	set com "RETR $file"
    }
    if {$active} {
	# Active
	FTP_Log "ACTIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 1] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	FTP_Log ">> $com"
	puts $commSock $com
	FTP_Log "Waiting response.."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}

	if {![string match "1??*" $ftp($commSock.reply)]} {
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}
	FTP_Log "Active datasocket($ftp($commSock.datasock)) opened!"
	set dataSock $ftp($commSock.datasock)
	set ftp($dataSock.rows)   0
	set ftp($dataSock.append) 1
	set ftp($dataSock.reply)  ""
	fileevent $dataSock readable [list FTP_ReadSocketASCII $dataSock]
	FTP_Log "Waiting datasocket($ftp($commSock.datasock)) to close.."
	vwait ftp($dataSock.close)
    } {
	# Passive
	FTP_Log "PASSIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 0] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	set dataSock $ftp($commSock.datasock)
	set ftp($dataSock.rows)   0
	set ftp($dataSock.close)  0
	set ftp($commSock.abort)  0
	set ftp($dataSock.append) 1
	set ftp($dataSock.reply)  ""
	fileevent $dataSock readable [list FTP_ReadSocketASCII $dataSock]
	FTP_Log ">> $com"
	puts $commSock $com
	FTP_Log "Waiting response.."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
	
	if {![string match "1??*" $ftp($commSock.reply)]} {
	    # Error
	    set ftp($commSock.readed) ""
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    return $ftp(return_ERROR)
	}

	FTP_Log "Waiting response..."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}

	if {![string match "226 *" $ftp($commSock.reply)]} {
	    # Error 
	    set ftp($commSock.readed) ""
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    return $ftp(return_ERROR)
	}

	# For safety, checking the situation..
	# ++ ADD TIMEOUT (?) - NO USER ABORT POSSIBLE
	if {!$ftp($dataSock.close)}  {
	    FTP_Log "Waiting close..."
	    vwait ftp($dataSock.close)
	} {
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	}
    }
    if {![string match "\[2-5\]*" "$ftp($commSock.reply)"]} {
	FTP_Log "Waiting response.."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
    }
    set ftp($commSock.readed) $ftp($dataSock.reply)
    FTP_UnsetVariables $dataSock
    FTP_Log "RETURN OK!"
    return $ftp(return_OK)
}

####################################################################
# FTP_READ_FILE:
#
#   Read ascii file. Fron-end to 'FTP_GET_ASCII'.
#   Read data in variable <TBD>
#
proc FTP_READ_FILE {commSock file {active 0}} {
    global ftp
    FTP_Log "file=$file, active=$active"
    set ftp($commSock.status) "Busy: READ_FILE"
    if {[FTP_GET_ASCII $commSock 0 $active {} $file] != $ftp(return_OK)} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }
    set ftp($commSock.status) "Ok"
    FTP_Log "RETURN OK!"
    return $ftp(return_OK)
}

####################################################################
# FTP_LIST:
#
#   Get the directory listing or file attributes.
#
proc FTP_LIST {commSock {type 0} {active 0} {dir {}}} {
    global ftp
    FTP_Log "type=$type, active=$active, dir=$dir"
    set ftp($commSock.status) "Busy: LIST"

    # ++ ADD ERROR CHECKING 
    if {[FTP_GET_ASCII $commSock $type $active $dir]\
	    == $ftp(return_ERROR)} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	return $ftp(return_ERROR)
    } {
	set ftp($commSock.status) "Ok"
	FTP_Log "RETURN OK!"
	return $ftp(return_OK)
    }
}

####################################################################
# FTP_GET:
#
#   Copies file from the remote host to current directory.
#
proc FTP_GET {commSock file {tofile ""} {active 0}} {
    global ftp
    FTP_Log "file=$file, tofile=$tofile, active=$active"
    set ftp($commSock.status) "Busy: GET"
    set ftp($commSock.abort)  0
    set ftp($commSock.close)  0
    if {$tofile == ""} {
	set tofile $file
    }
    # Set type to binary.. 
    puts $commSock "TYPE I"
    FTP_Log ">> TYPE I"
    FTP_Log "Waiting response..."
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    # ++ ADD ERROR CHECKING !

    if {$active} {
	# Active
	FTP_Log "ACTIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 1] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	FTP_Log ">> RETR $file"
	puts $commSock "RETR $file"
	FTP_Log "Waiting response..."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}

	if {[string match "5??*" $ftp($commSock.reply)]} {
	    # Error
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}
	FTP_Log "Active datasocket($ftp($commSock.datasock)) opened!"
	set dataSock $ftp($commSock.datasock)
    } {
	# Passive
	FTP_Log "PASSIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 0] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	set dataSock $ftp($commSock.datasock)
    }

    set outfile [open $tofile w]
    fconfigure $outfile -blocking 0 -buffering none -translation binary
    fconfigure $dataSock -translation binary -buffering none -blocking 0
    if {!$active} {
	# Passive
	FTP_Log ">> RETR $file"
	puts $commSock "RETR $file"
	FTP_Log "Waiting response.."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}

	if {[string match "5??*" $ftp($commSock.reply)]} {
	    # Error
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}
    }
    set ftp($commSock.currsize)  0
    set ftp($commSock.starttime) [clock seconds]
    set ftp($dataSock.close) 0

    # Disable any eventhandlers
    fileevent $dataSock readable {} 

    fcopy $dataSock $outfile -command \
	    [list FTP_CopyMore $commSock $dataSock \
	    $outfile $ftp($commSock.chunk)] \
	    -size $ftp($commSock.chunk)

    FTP_Log "Waiting transfer to complete..."
    
    # Timeout-vwait
    #if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
    #	    == $ftp(return_ERROR)} {
    #	return $ftp(return_ERROR)
    #}

    # No timeout-vwait. User can abort the transfer by him/herself
    vwait ftp($commSock.strobe)

    ## Check #1, that  variable exists
    if {![info exists ftp($commSock.abort)]} {
	return $ftp(return_ERROR)
    }

    ## Check if aborted...
    if {$ftp($commSock.abort) == 1} {
	set ftp($commSock.status) "Transfer aborted!!"
	return $ftp(return_ERROR)
    }

    # ++ ADD 'ABORTED' -CHECK(?)
    if {[string match "5??*" $ftp($commSock.reply)]} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }
    if {$ftp($dataSock.close) == 0} {
	FTP_Log "Waiting close..."
	vwait ftp($dataSock.close)
    }	

    ## Check #2, that  variable exists
    if {![info exists ftp($commSock.abort)]} {
	return $ftp(return_ERROR)
    }

    ## Check if aborted...
    if {$ftp($commSock.abort) == 1} {
	set ftp($commSock.status) "Transfer aborted!!"
	return $ftp(return_ERROR)
    }

    # Calculate transfer performance...
    set ftp($commSock.stoptime) [clock seconds]
    set ftp($commSock.totaltime) \
	    [expr {$ftp($commSock.stoptime) - $ftp($commSock.starttime)}]
    if {$ftp($commSock.totaltime) == 0} {set ftp($commSock.totaltime) 0.01}
    set ftp($commSock.transrate) \
	    [expr {$ftp($commSock.currsize) / $ftp($commSock.totaltime)}]
    FTP_Log "<$ftp($commSock.currsize) bytes> \
	    Time: $ftp($commSock.totaltime) s => \
	    [expr {$ftp($commSock.transrate) / 1000}] KBytes/s"

    set ftp($commSock.status) "Ok"
    FTP_Log "RETURN OK!"
    FTP_UnsetVariables $dataSock
    return $ftp(return_OK)
}

####################################################################
# FTP_PUT:
#
#   Copies file to the remote host
#
proc FTP_PUT {commSock file tofile {active 0}} {
    global ftp
    FTP_Log "file=$file, tofile=$tofile, active=$active"
    set ftp($commSock.status) "Busy: PUT"
    set ftp($commSock.abort)  0

    FTP_Log ">> TYPE I"
    puts $commSock "TYPE I"
    FTP_Log "Waiting response..."
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {$active} {
	# Active
	FTP_Log "ACTIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 1] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	FTP_Log ">> STOR $tofile"
	puts $commSock "STOR $tofile"
	FTP_Log "Waiting response..."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}

	if {[string match "5?? *" $ftp($commSock.reply)]} {
	    # Error
	    FTP_Log "ERROR - $ftp($commSock.reply)"
	    set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	    set ftp($commSock.readed) ""
	    return $ftp(return_ERROR)
	}
	set dataSock $ftp($commSock.datasock)
    } {
	#PASSIVE
	FTP_Log "PASSIVE DATASOCK"
	if {[FTP_OpenDataSocket $commSock 0] == $ftp(return_ERROR)} {
	    # Error
	    return $ftp(return_ERROR)
	}
	set dataSock $ftp($commSock.datasock)
    }
    if {[file exists $file]} {
	set infile [open $file r]
    } {
	# Error
	set ftp($commSock.status) "Can't find file '$file'"
	FTP_Log "ERROR - $ftp($commSock.status)"
	catch {close $dataSock}
	return $ftp(return_ERROR)
    }

    fconfigure $infile -blocking 0 -buffering none -translation {binary}
    fconfigure $dataSock -translation {binary} -buffering none -blocking 0

    if {!$active} {
	FTP_Log ">> STOR $tofile"
	puts $commSock "STOR $tofile"
	FTP_Log "Waiting response.."
	
	# Timeout-vwait
	if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
		== $ftp(return_ERROR)} {
	    return $ftp(return_ERROR)
	}
    }
    
    set ftp($dataSock.close)     0
    set ftp($commSock.currsize)  0
    set ftp($commSock.starttime) [clock seconds]

    fcopy $infile $dataSock -command  \
	    [list FTP_CopyMore $commSock $infile \
	    $dataSock $ftp($commSock.chunk)] \
	    -size $ftp($commSock.chunk)

    # ++ ADD ERROR CHECKING !

    FTP_Log "Waiting transfer complete..."
    
    # Timeout-vwait
    #if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
    #	    == $ftp(return_ERROR)} {
    #	return $ftp(return_ERROR)
    #}

    # No timeout-vwait. User can abort the transfer by him/herself
    vwait ftp($commSock.strobe)

    ## Check #1, that  variable exists
    if {![info exists ftp($commSock.abort)]} {
	return $ftp(return_ERROR)
    }
    
    ## Check if aborted...
    if {$ftp($commSock.abort) == 1} {
	set ftp($commSock.status) "Transfer aborted!!"
	return $ftp(return_ERROR)
    }

    if {[string match "5??*" $ftp($commSock.reply)]} {
        # Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
        set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
        set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }
    if {$ftp($dataSock.close) == 0} {
 	FTP_Log "Waiting close..."
        vwait ftp($dataSock.close)
    }
    
    ## Check if aborted...
    if {$ftp($commSock.abort) == 1} {
	set ftp($commSock.status) "Transfer aborted!!"
	return $ftp(return_ERROR)
    }

    ## Check #2, that  variable exists
    if {![info exists ftp($commSock.abort)]} {
	return $ftp(return_ERROR)
    }

    # Calculate transfer performance...
    set ftp($commSock.stoptime) [clock seconds]
    set ftp($commSock.totaltime) \
	    [expr {$ftp($commSock.stoptime) - $ftp($commSock.starttime)}]
    if {$ftp($commSock.totaltime) == 0} {set ftp($commSock.totaltime) 0.01}
    set ftp($commSock.transrate) \
	    [expr {$ftp($commSock.currsize) / $ftp($commSock.totaltime)}]

    FTP_Log "<$ftp($commSock.currsize) bytes> \
	    Time: $ftp($commSock.totaltime) s => \
	    [expr {$ftp($commSock.transrate) / 1000}] KBytes/s"

    set ftp($commSock.status) "Ok"
    FTP_Log "RETURN OK!"
    FTP_UnsetVariables $dataSock
    return $ftp(return_OK)
}

####################################################################
# FTP_All_Read: [INTERNAL]
#
#   Obsolate proc - I'll quess there is no need for this anymore..
#   but keep it here just in case.. :-) 
#
proc FTP_All_Read {sock bytes} {
    global ftp
    set ftp($sock.strobe) 1
    catch {close $sock}
    set ftp($sock.close) 1
}

####################################################################
# FTP_CopyMore: [INTERNAL]
#
#   Do the background binary transfer.
#
proc FTP_CopyMore {sock in out chunk bytes {error {}}} {
    global ftp pb
    incr ftp($sock.currsize) $bytes       
    
    if {([string length $error] != 0) ||\
	    [eof $in]                 ||\
	    ($ftp($sock.abort) == 1)} {
	# Transfer completed!
	
	# Close streams
	close $in
	close $out
    
	set dsock $ftp($sock.datasock)
	set ftp($dsock.close) 1
	
	#if {$ftp($sock.abort) == 1} {
	    #set ftp($sock.strobe) 1
	#}
	
    } else {
	# Copy chunck in background
	fcopy $in $out -command [list FTP_CopyMore $sock $in $out $chunk] \
		-size $chunk
    }
}

####################################################################
# FTP_CMD:
#
#   Sends ftp commands to the server.
#
proc FTP_CMD {commSock cmd} {
    global ftp
    FTP_Log "cmd=$cmd"
    set ftp($commSock.status) "Busy: CMD($cmd)"

    FTP_Log ">> $cmd"
    puts $commSock "$cmd"
    FTP_Log "Waiting response..." 
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {![string match "2??*" $ftp($commSock.reply)]} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }
    set ftp($commSock.status) "Ok"
    FTP_Log "RETURN OK!"
    return $ftp(return_OK)
}


####################################################################
# FTP_ABORT:
#
#   NOTE: Abort DO NOT work like "ABOR"-command in ftp protocoll.
#
#   There is three different cases: 
#   - if there is currently PUT-operation running, it stops
#     that nicely, and returns OK
#   - if there is GET-operation running, it _only_ returns ERROR,
#     so you have to close the commSock of your own and maybe
#     reconnect automaically..
#   - in any other cases it _only_ return OK
#
#   Reason for this is, that in tcl you cannot send "urget" (oob) 
#   tcp-packets, for requesting abort the transfer...
#
proc FTP_ABORT {commSock} {
    global ftp

    if {$ftp($commSock.status) == "Busy: GET"} {
	#cahnges...
	set dsock $ftp($commSock.datasock)
	set ftp($commSock.abort) 1
	close $dsock
	FTP_Log "DATA-SOCKET CLOSED!!"

	close $commSock
	FTP_Log "COMM-SOCKET CLOSED!!"
	set ftp($commSock.strobe) 1
	set ftp($dsock.close) 1
	#
	return $ftp(return_ERROR)
    }
    set ftp($commSock.abort) 1
    return $ftp(return_OK)
}

####################################################################
# FTP_QUIT:
#
#   Closes the ftp-session
#
proc FTP_QUIT {commSock} {
    global ftp
    FTP_Log "Quitting..."
    if {$ftp($commSock.timeout) == 1} {
	FTP_Log "TIMEOUT!"
	return $ftp(return_OK)
    }

    # Abort any get/put transfer
    FTP_ABORT $commSock

    # If command-socket terminated, there's nothing to do anymore...
    if {[catch {eof $commSock}]} {
	return $ftp(return_OK)
    }

    set ftp($commSock.status) "Busy: QUIT"

    FTP_Log ">> QUIT" 
    if {[catch {puts $commSock "QUIT"}]} {
	# Error
	FTP_Log "ERROR - network unreachable"
	set ftp($commSock.status) "ERROR: network unreachable"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }
	
    FTP_Log "Waiting response.." 
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {[string match "500 *" $ftp($commSock.reply)]} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }

    set ftp($commSock.status) "Ok"
    catch {close $commSock}
    FTP_Log "RETURN OK!"
    return $ftp(return_OK)
}

####################################################################
# FTP_RENAME:
#
#   Rename remote-file
#
proc FTP_RENAME {commSock from to} {
    global ftp
    FTP_Log "from=$from, to=$to"
    set ftp($commSock.status) "Busy: RENAME"
    FTP_Log ">> RNFR $from"
    puts $commSock "RNFR $from"
    FTP_Log "Waiting response..."
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    if {[string match "5??*" $ftp($commSock.reply)]} {
	# Error
	FTP_Log "ERROR - $ftp($commSock.reply)"
	set ftp($commSock.status) "ERROR: $ftp($commSock.reply)"
	set ftp($commSock.readed) ""
	return $ftp(return_ERROR)
    }

    if {[string match "350*" $ftp($commSock.reply)]} {
	set ftp($commSock.status) "WARNING: File exists"
	FTP_Log "WARNING - $ftp($commSock.status)"
    }
    FTP_Log ">> RNTO $to"
    puts $commSock "RNTO $to"
    FTP_Log "Waiting response..."
    
    # Timeout-vwait
    if {[FTP_TimeOutVWait $commSock ftp($commSock.strobe)] \
	    == $ftp(return_ERROR)} {
	return $ftp(return_ERROR)
    }

    # ++ ADD ERROR CHECKING !
    set ftp($commSock.status) "Ok"
    FTP_Log "RETURN OK!"
    return $ftp(return_OK)
}

####################################################################
# FTP_STATUS:
#
#   Obsolete proc - propably not working, because can't
#   send this in oob-mode (urgent)
# 
proc FTP_STATUS {commSock} {
    global ftp
    if {$ftp($commSock.statallowed)} {
	puts $commSock "STAT"
	set ftp($commSock.statallowed) 0
    }
    if {$ftp($commSock.statenable)} {
	after 100 {FTP_STATUS $commSock}
    }
}

####################################################################
# FTP_TestRun: [TESTING]
#
#   Login to server and quit. Then cleans used vars
#
proc FTP_TestRun {} {
    global ftp
    set commSock [FTP_Open localhost ftp ftp@ftp]
    FTP_QUIT $commSock
    FTP_UnsetVariables $commSock
    FTP_Log "OK!"
}

#FTP_TestRun
