David Easton 21 Oct 2004 - Here is a simple TFTP client written purely in Tcl, but requiring TclUDP and Snit. It supports octet (binary) and nearly supports netascii (ascii) - see limitations below.
It has been tested by running it on Windows (Tcl 8.4.6) with TFTP Server.
Limitations:
See:
Feel free to fix/improve this and use it however you wish.
################################################################################
#
# Package: tftp
#
# Description:
# Implements a tftp client
#
# Provides the following functions:
#
# tftp create <name> - Create a tftp handle with name <name>
# tftp create %AUTO% - Create a tftp handle
# tftp list - List all open tftp handles
#
# <handle> connect <host> [<port>] - Change destination host [and port]
# <handle> mode [ascii|binary] - Set or query mode
# <handle> ascii - Change mode to netascii
# <handle> binary - Change mode to octet
# <handle> put <filename> - TFTP put
# <handle> get <filename> - TFTP get
# <handle> destroy - Destroy handle
#
# <handle> verbose - Toggle verbose mode
# <handle> trace - Toggle packet tracing
# <handle> rexmt <time> - Set per-packet retransmission timeout (seconds)
# <handle> timeout <time> - Set total retransmission timeout (seconds)
#
# Author: David Easton
# Date: Oct 2004
#
################################################################################
package provide tftp 1.0
namespace eval tftp {
package require snit
package require udp
snit::type tftp {
typevariable tftpList [list]
typemethod list {} {
return $tftpList
}
# Define variable in which to store the tftp information
variable data
constructor {args} {
$self configurelist $args
lappend tftpList $self
set data(host) 127.0.0.1
set data(port) 69
set data(tid) 69
set data(sock) ""
set data(mode) binary
set data(verbose) true
set data(trace) true
set data(rexmt) 5000
set data(timeout) 25000
}
destructor {
if {[set i [lsearch $tftpList $self]] != -1} {
set tftpList [lreplace $tftpList $i $i]
}
$self closeSock
}
#
# Private methods
#
method pverbose {message} {
if { $data(verbose) } {
puts $message
}
}
method ptrace {message} {
if { $data(trace) } {
puts $message
}
}
method getmode {} {
if { "$data(mode)" == "ascii" } {
return "netascii"
} else {
return "octet"
}
}
method sendRrq {sock filename} {
set mode [$self getmode]
$self ptrace "RRQ --> (file $filename, mode $data(mode))"
puts -nonewline $sock [binary format xca*xa*x 1 $filename $mode]
set data(pktAfterId) [after $data(rexmt) [list $self sendRrq $sock $filename]]
}
method sendWrq {sock filename} {
set mode [$self getmode]
$self ptrace "WRQ --> (file $filename, mode $data(mode))"
puts -nonewline $sock [binary format xca*xa*x 2 $filename $mode]
set data(pktAfterId) [after $data(rexmt) [list $self sendWrq $sock $filename]]
}
method sendData {sock block} {
# If all blocks have been sent then finish
if { $block > $data(lastblock) } {
$self closeSock
$self pverbose "Completed"
} else {
# This could be a resend, so seek to correct place in file
seek $data(fid) [expr {($block - 1) * 512}] start
set filedata [read $data(fid) 512]
set len [string length $filedata]
# Mark as last block if less than 512 bytes
if { $len < 512 } {
set data(lastblock) $block
}
$self ptrace "DATA --> (block $block, $len bytes)"
puts -nonewline $sock [binary format xcSa* 3 $block $filedata]
set data(pktAfterId) [after $data(rexmt) [list $self sendData $sock $block]]
}
}
method sendAck {sock block} {
$self ptrace "ACK --> (block $block)"
puts -nonewline $sock [binary format xcS 4 $block]
set data(pktAfterId) [after $data(rexmt) [list $self sendAck $sock $block]]
}
method sendError {sock errCode errMsg } {
$self ptrace "ERROR --> ($errMsg $errCode)"
puts -nonewline $sock [binary format xcxca*x 5 $errCode $errMsg]
}
method cancelTimeouts {} {
foreach id [list $data(pktAfterId) $data(timAfterId)] {
catch {after cancel $id}
}
}
method startTimeout {} {
set data(timAfterId) [after $data(timeout) [list $self timeout]]
}
method timeout {} {
$self pverbose "Timed out"
$self cancelTimeouts
$self closeSock
}
method receive {sock} {
set pkt [read $sock]
foreach {thishost thisport} [udp_conf $sock -peer] {break}
# Check that packet is from the correct host
if { "$thishost" != "$data(host)" } {
$self ptrace "Pkt received from $thishost, should be $data(host)"
$self sendError $sock 5 "Unknown transfer ID"
return
}
# If $data(lastblock) is 0, destination port should change
# to the one received from the destination
if { $data(tid) == $data(port) } {
set data(tid) $thisport
udp_conf $sock $data(host) $data(tid)
}
if { "$thisport" != "$data(tid)" } {
$self ptrace "Pkt received from $thishost:$thisport, should be $data(host):$data(tid)"
$self sendError $sock 5 "Unknown transfer ID"
return
}
$self cancelTimeouts
$self startTimeout
# 1st 2 bytes determine the packet type
set type ???
binary scan $pkt xc type
switch -- $type {
1 -
2 { # Error - should not get RRQ/WRQ here
$self sendError $sock 4 "Illegal TFTP operation"
$self closeSock
}
3 { # DATA
binary scan $pkt xxSa* block filedata
set size [string length $filedata]
$self ptrace "<-- DATA (block $block, $size bytes)"
if { $block == $data(lastblock) } {
# Already received, resend ACK
$self sendAck $sock $block
} elseif { $block == $data(lastblock) + 1 } {
# New data, save to file and send ACK
puts -nonewline $data(fid) $filedata
incr data(lastblock)
$self sendAck $sock $block
} else {
# Unexpected block, send error
$self sendError 4 "Illegal TFTP operation, incorrect block number: $block"
$self closeSock
}
# Stop if $size < 512
if { $size < 512 } {
$self pverbose "File transfer complete"
$self closeSock
}
}
4 { # ACK
binary scan $pkt xxS block
$self ptrace "<-- ACK (block $block)"
# Send the next block of data
incr block
$self sendData $sock $block
}
5 { # ERROR
binary scan xxxca* errCode errMsg
$self ptrace "<-- ERROR ($errCode $errMsg)"
$self closeSock
}
default {
return
}
}
}
method openSock {} {
# Create our new sending port
set sock [udp_open]
udp_conf $sock $data(host) $data(port)
fconfigure $sock -buffering none -translation binary
fileevent $sock readable [list $self receive $sock]
return $sock
}
method closeSock {} {
$self cancelTimeouts
catch {close $data(sock)}
catch {close $data(fid)}
}
method startPut {lfile rfile} {
if { ![file exists $lfile] } {
return "File $lfile does not exist"
} elseif {[catch {open $lfile r} fid]} {
return "Error opening file: $fid"
} else {
if { $data(mode) == "binary" } {
fconfigure $fid -translation binary -buffersize 512
}
set data(sock) [$self openSock]
set data(fid) $fid
set data(lastblock) 65025 ;# 255*255
set data(tid) $data(port)
$self startTimeout
$self sendWrq $data(sock) $rfile
}
return
}
method startGet {rfile lfile} {
if { [file exists $lfile] } {
return "File $lfile already exists"
} elseif {[catch {open $lfile w} fid]} {
return "Error opening file: $fid"
} else {
if { $data(mode) == "binary" } {
fconfigure $fid -translation binary -buffersize 512
}
set data(sock) [$self openSock]
set data(fid) $fid
set data(lastblock) 0 ;# Record last block received
set data(tid) $data(port)
$self startTimeout
$self sendRrq $data(sock) $rfile
}
return
}
#
# Public methods
#
method connect {args} {
set nargs [llength $args]
if {$nargs < 1 || $nargs > 2} {
set message "wrong # args: should be \"$self connect <host> ?port?\""
return -code error $message
} else {
set data(host) [lindex $args 0]
if {$nargs == 2} {
set data(port) [lindex $args 1]
}
}
}
method mode {args} {
set nargs [llength $args]
if {$nargs > 1} {
set message "wrong # args: should be \"$self mode ?ascii|binary?\""
return -code error $message
} elseif {$nargs == 1} {
set mode [lindex $args 0]
switch -- $mode {
"ascii" {
set data(mode) ascii
}
"binary" {
set data(mode) binary
}
default {
set message "mode should be \"ascii\" or \"binary\""
return -code error $message
}
}
}
return $data(mode)
}
method ascii {} {
set data(mode) ascii
return $data(mode)
}
method binary {} {
set data(mode) binary
return $data(mode)
}
method verbose {} {
if { "$data(verbose)" == "true" } {
set data(verbose) false
} else {
set data(verbose) true
}
return $data(verbose)
}
method trace {} {
if { "$data(trace)" == "true" } {
set data(trace) false
} else {
set data(trace) true
}
return $data(trace)
}
method show {} {
parray data
}
method put {args} {
set nargs [llength $args]
if {$nargs < 1 || $nargs > 2} {
set message "wrong # args: should be \"$self put <localfile> ?remotefile?\""
return -code error $message
}
set lfile [lindex $args 0]
if { $nargs == 1 } {
set rfile $lfile
} else {
set rfile [lindex $args 1]
}
puts "Sending $lfile to $data(host):$data(port) as $rfile"
$self startPut $lfile $rfile
}
method get {args} {
set nargs [llength $args]
if {$nargs < 1 || $nargs > 2} {
set message "wrong # args: should be \"$self get <remotefile> ?localfile?\""
return -code error $message
}
set rfile [lindex $args 0]
if { $nargs == 1 } {
set lfile $rfile
} else {
set lfile [lindex $args 1]
}
puts "Getting $lfile from $data(host):$data(port) as $rfile"
$self startGet $rfile $lfile
}
}
}To use it, ensure that TclUDP and Snit are available and then:
package require tftp # Create a handle #tftp::tftd create myHandle tftp::tftp create myHandle # Specify the destination host (and port if not the default of 69). myHandle connect <host> <port> # Upload a file myHandle put test.txt # Download the same file to a different name myHandle get test2.txt # Destroy the handle myHandle destroy
mocallins - 2015-11-22 08:37:33
I'm getting an error trying to use this package.
tftp::tftp create myHandle
can't read "data(pktAfterId)": no such variable