[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:'''
   * '''netascii mode''' does not translate end of line characters when receiving - this is because it needs to read the socket in binary mode to determine the number of bytes of data sent, but could do with reading it with -translation auto to automatically translate end of line characters. 'Is there a way to determine how many bytes were read from a socket prior to translation of end-of-line characters?' Another solution would be to send the data through another socket to translate it.

'''See:'''
   * [TFTP Server]
   * [TFTP]

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

 # 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
----
[[
[Category Internet]
]]