- Security - Update tftpd::securityCheckRead and tftpd::securityCheckWrite to add security checking based on hostname or filename. The default is set to only allow the local machine (127.0.0.1).
- 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.
package provide tftpd 1.0
namespace eval tftpd {
package require udp
namespace export tftpd
variable S
set S(rexmt) 5000 ;# Per-packet timeout (ms)
set S(timeout) 25000 ;# Total timeout (ms)
set S(listenPort) 69 ;# TFTPD port
set S(verbose) 2 ;# Print output (2=high, 1=medium, 0=low)
}
# Returns: 0 - Passed security check
# 1 - Failed security check
proc tftpd::securityCheckRead {host file} {
verbose 1 "Running security check on sending $file to $host"
if { $host != "127.0.0.1" } {
return 1
} else {
return 0
}
}
# Returns: 0 - Passed security check
# 1 - Failed security check
proc tftpd::securityCheckWrite {host file} {
verbose 1 "Running security check on writing $file from $host"
if { $host != "127.0.0.1" } {
return 1
} else {
return 0
}
}
proc tftpd::verbose {level message} {
variable S
if { $level <= $S(verbose) } {
puts "$message"
}
}
proc tftpd::tftpd {} {
variable S
# Open listening port
set sock [udp_open $S(listenPort)]
fconfigure $sock -buffering none -translation binary
fileevent $sock readable [list tftpd::tftpdReceive $sock]
verbose 1 "Listening on UDP port: [udp_conf $sock -myport], sock: $sock"
}
proc tftpd::tftpdReceive {sock} {
set pkt [read $sock]
foreach {host port} [udp_conf $sock -peer] {break}
set type "???"
# Get packet type from 2nd byte
binary scan $pkt xc type
verbose 2 "Received type $type packet from $host:$port on port [udp_conf $sock -myport]"
if { $type == 1 || $type == 2 } {
binary scan $pkt xxa* str
if {[regexp {([^\000]+)\000([^\000]+)\000} $str - filename mode]} {
if { $mode != "octet" && $mode != "netascii" } {
sendError $sock 0 "Unsupported mode $mode"
} elseif { $type == 1 } {
verbose 2 "<-- RRQ $host:$port (file $filename, mode $mode)"
startRead $sock $filename $mode $host $port
} else {
verbose 2 "<-- WRQ $host:$port (file $filename, mode $mode)"
startWrite $sock $filename $mode $host $port
}
} else {
verbose 2 "<-- RRQ/WRQ $host:$port (Invalid packet)"
sendError $sock 0 "Invalid packet format"
}
} else {
verbose 2 "<-- Unexpected type $type $host:$port ([string length $pkt] bytes)"
sendError $sock 4 "Illegal TFTP operation"
}
}
proc tftpd::sockReceive {sock host port} {
variable S
set pkt [read $sock]
# Check that host and port are as expected
foreach {thishost thisport} [udp_conf $sock -peer] {break}
if { "$thishost" != "$host" || "$thisport" != "$port" } {
sendError $sock 5 "Unknown transfer ID"
return
}
cancelTimeout $sock
set S($sock,timAfterId) [after $S(timeout) [list tftpd::timeout $sock]]
# 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
verbose 2 "RRQ/WRQ received on port [udp_conf $sock -myport]"
sendError $sock 4 "Illegal TFTP operation"
closeSock $sock
}
3 { # DATA
binary scan $pkt xxSa* block data
set size [string length $data]
verbose 2 "<-- DATA (block $block, $size bytes)"
if { $block == $S($sock,lastblock) } {
# Already received, resend ACK
sendAck $sock $block
} elseif { $block == $S($sock,lastblock) + 1 } {
# New data, save to file and send ACK
puts -nonewline $S($sock,fid) $data
incr S($sock,lastblock)
sendAck $sock $block
} else {
# Unexpected block, send error
sendError 4 "Illegal TFTP operation, incorrect block number: $block"
}
# Stop if $size < 512
if { $size < 512 } {
verbose 1 "Receipt of $S($sock,file) complete"
closeSock $sock
}
}
4 { # ACK
binary scan $pkt xxS block
verbose 2 "<-- ACK (block $block)"
# Send the next block of data
incr block
sendData $sock $block
}
5 { # ERROR
binary scan $pkt xxxca* errCode errMsg
verbose 1 "<-- ERROR ($errCode $errMsg)"
closeSock $sock
}
default {
verbose 2 "<-- Unknown type ([string length $pkt] bytes) received on port [udp_conf $sock -myport]"
closeSock $sock
}
}
}
proc tftpd::timeout {sock} {
variable S
if {[info exists S($sock,file)]} {
verbose 1 "Timed out for file $S($sock,file)"
} else {
verbose 1 "Timed out"
}
closeSock $sock
}
proc tftpd::cancelTimeout {sock} {
variable S
catch {after cancel $S($sock,timAfterId)}
catch {after cancel $S($sock,pktAfterId)}
}
proc tftpd::closeSock {sock} {
variable S
verbose 2 "Closing port [udp_conf $sock -myport]"
cancelTimeout $sock
catch {close $sock}
catch {close $S($sock,fid)}
array unset S "$sock,*"
}
proc tftpd::startRead {sock filename mode host port} {
variable S
if {[securityCheckRead $host $filename]} {
sendError $sock 2 "Access violation"
} elseif { ![file exists $filename] } {
sendError $sock 1 "File $filename not found"
} elseif {[catch {open $filename r} fid]} {
sendError $sock 0 "Error opening file: $fid"
} else {
verbose 1 "Sending $filename, mode $mode to $host:$port"
if { $mode == "octet" } {
fconfigure $fid -translation binary -buffersize 512
}
# Create our new sending port
set newsock [udp_open]
udp_conf $newsock $host $port
fconfigure $newsock -buffering none -translation binary
# Listen for more replies
fileevent $newsock readable [list tftpd::sockReceive $newsock $host $port]
set S($newsock,fid) $fid
set S($newsock,file) $filename
set S($newsock,lastblock) 65025 ;# This is 255*255
set S($newsock,timAfterId) [after $S(timeout) [list tftpd::timeout $newsock]]
sendData $newsock 1
}
}
proc tftpd::startWrite {sock filename mode host port} {
variable S
if {[securityCheckWrite $host $filename]} {
sendError $sock 2 "Access violation"
} elseif { [file exists $filename] } {
sendError $sock 6 "File $filename already exists"
} elseif {[catch {open $filename w} fid]} {
sendError $sock 0 "Error opening file: $fid"
} else {
verbose 1 "Receiving $filename, mode $mode from $host:$port"
if { $mode == "octet" } {
fconfigure $fid -translation binary -buffersize 512
}
# Create our new sending port
set newsock [udp_open]
udp_conf $newsock $host $port
fconfigure $newsock -buffering none -translation binary
# Listen for more replies
fileevent $newsock readable [list tftpd::sockReceive $newsock $host $port]
set S($newsock,fid) $fid
set S($newsock,file) $filename
set S($newsock,lastblock) 0 ;# Record last block received
set S($newsock,timAfterId) [after $S(timeout) [list tftpd::timeout $newsock]]
sendAck $newsock 0
}
}
proc tftpd::sendData {sock block} {
variable S
# See if all block have been sent
if { $block > $S($sock,lastblock) } {
verbose 1 "Send $S($sock,file) complete"
closeSock $sock
return
}
# This could be a resend, so seek to correct place in file
seek $S($sock,fid) [expr {($block - 1) * 512}] start
set data [read $S($sock,fid) 512]
set len [string length $data]
# Mark as last block if less than 512 bytes
if { $len < 512 } {
set S($sock,lastblock) $block
}
verbose 2 "DATA --> (block $block, $len bytes)"
puts -nonewline $sock [binary format xcSa* 3 $block $data]
set S($sock,pktAfterId) [after $S(rexmt) [list tftpd::sendData $sock $block]]
}
proc tftpd::sendAck {sock block} {
variable S
verbose 2 "ACK --> (block $block)"
puts -nonewline $sock [binary format xcS 4 $block]
set S($sock,pktAfterId) [after $S(rexmt) [list tftpd::sendAck $sock $block]]
}
proc tftpd::sendError {sock errCode errMsg } {
verbose 1 "ERROR --> ($errCode $errMsg)"
puts -nonewline $sock [binary format xcxca*x 5 $errCode $errMsg]
}To use it, ensure that TclUDP is available and then:
package require tftpd tftpd::tftpd
Jeff Smith '3 March 2005' Just gave the server a try, backing up the configuration file from a cisco router. I got part of the file transfered to the server but the router threw some errors. I was wondering if I was running into one of the limitations you mentioned above or am I doing something wrong.The output from the router is
Router#copy run tftp Address or name of remote host []? 10.8.201.1 Destination filename [Router-confg]? mttd.cfg ! TFTP: unexpected packet with unknown opcode.! TFTP: unexpected packet with unknown opcode.. TFTP: unexpected packet with unknown opcode.! TFTP: unexpected packet with unknown opcode.. TFTP: unexpected packet with unknown opcode.. TFTP: unexpected packet with unknown opcode. %Error writing tftp://10.8.201.1/mttd.cfg (Write error). TFTP: unexpected packet with unknown opcode.! Router#The output from the TFTP server is
(udp1.0.6) 5 % tftpd::tftpd Listening on UDP port: 69, sock: sock364 Received type 2 packet from 10.9.181.3:53657 on port 69 <-- WRQ 10.9.181.3:53657 (file mttd.cfg, mode octet) Running security check on writing mttd.cfg from 10.9.181.3 Receiving mttd.cfg, mode octet from 10.9.181.3:53657 ACK --> (block 0) <-- DATA (block 1, 512 bytes) ACK --> (block 1) <-- DATA (block 1, 512 bytes) ACK --> (block 1) <-- DATA (block 2, 512 bytes) ACK --> (block 2) <-- DATA (block 2, 512 bytes) ACK --> (block 2) <-- DATA (block 2, 512 bytes) ACK --> (block 2) <-- DATA (block 2, 512 bytes) ACK --> (block 2) <-- DATA (block 3, 512 bytes) ACK --> (block 3) <-- DATA (block 3, 512 bytes) ACK --> (block 3) <-- DATA (block 3, 512 bytes) ACK --> (block 3) <-- DATA (block 3, 512 bytes) ACK --> (block 3) <-- DATA (block 3, 512 bytes) ACK --> (block 3) <-- DATA (block 3, 0 bytes) ACK --> (block 3) Receipt of mttd.cfg complete Closing port 1357 (udp1.0.6) 6 %David Easton 3 March 2005 This is not a problem that I'm aware of. The Cisco router is not recognising many of the ACK messages and so is resending the same data blocks several times. However, it obviously does sometimes recognise them as sometimes it sends the next data block - weird. The security is OK as it starts to send the file. The TFTP server thinks it is in octet mode and so it is not a netascii problem. All I can think of is to check that the Cisco router thinks it is using octet (binary) mode. Perhaps someone else will have other ideas.Jeff Smith 8 March 2005 I had luck with the Cisco router when I added a "-nonewline" after the "puts" statement in the "sendAck" procedure.David Easton 8 March 2005 I've tested "-nonewline" with the HP-UX 11i tftp client and that works, so I've added it to the above code in both the "sendAck" and "sendError" procedure. Thanks for the improvement.[Vidar Johannessen] 4 July 2008 When transferring a binary file: For each 512 sized packet sent, there is also sent a “Malformed packet” with one data byte = 0a (line feed). Adding -nonewline in procedure tftpd::sendData right after puts solved the problem.David Easton 4 July 2008 I've changed the "sendData" proc to add in this improvement. Thank you.[WimLeflere] 2013-09-18 To allow reads and writes from IPv4 addresses in the private ranges change the security check to the following:
if { [::ip::type $host] eq "private" } {
return 0
} else {
return 1
}ip package from tcllib requiredpackage require ip
[WimLeflere] - 2013-09-18 08:50:56
Installation instructions
For ActiveTcl 8.5.11 on Windows XPFind out where Tcl looks for packages with the following command:set auto_pathCreate a folder (ex. tftpd) in one of the directories (ex. C:\Tcl\lib) and save David's code to a file (ex. tftpd.tcl) in that folder.Create a pkgIndex.tcl file with the pkg_mkIndex command, this file tells Tcl how to load your package.
pkg_mkIndex C:/Tcl/lib/tftpdInstall TclUDP
teacup install udpTo run the server, execute the following code:
package require tftpd tftpd::tftpd vwait __forever__
