Index: modules/dns/dns.tcl ================================================================== --- modules/dns/dns.tcl +++ modules/dns/dns.tcl @@ -72,11 +72,12 @@ variable types array set types { A 1 NS 2 MD 3 MF 4 CNAME 5 SOA 6 MB 7 MG 8 MR 9 NULL 10 WKS 11 PTR 12 HINFO 13 MINFO 14 MX 15 TXT 16 - SPF 16 AAAA 28 SRV 33 IXFR 251 AXFR 252 MAILB 253 MAILA 254 + SPF 16 AAAA 28 SRV 33 NAPTR 35 + IXFR 251 AXFR 252 MAILB 253 MAILA 254 ANY 255 * 255 } variable classes array set classes { IN 1 CS 2 CH 3 HS 4 * 255} @@ -828,11 +829,11 @@ set state(status) error } catch {close $state(sock)} catch {after cancel $state(after)} if {[info exists state(-command)] && $state(-command) != {}} { - if {[catch {eval $state(-command) {$token}} err]} { + if {[catch {uplevel #0 [linsert $state(-command) end $token]} err]} { if {[string length $errormsg] == 0} { set state(error) [list $err $errorInfo $errorCode] set state(status) error } } @@ -1191,14 +1192,32 @@ lappend rdata weight [ReadUShort data $x off] incr x $off lappend rdata port [ReadUShort data $x off] incr x $off lappend rdata target [ReadName data $x off] - incr x $off } + NAPTR { + set x $index + set rdata [list order [ReadUShort data $x off]] + incr x $off + lappend rdata preference [ReadUShort data $x off] + incr x $off + lappend rdata flags [ReadString data $x off] + incr x $off + lappend rdata service [ReadString data $x off] + incr x $off + lappend rdata regex [ReadString data $x off] + incr x $off + lappend rdata replacement [ReadString data $x off] + } TXT { - set rdata [ReadString data $index $rdlength] + set x $index + set rdata "" + while {$x < $index + $rdlength} { + append rdata [ReadString data $x off] + incr x $off + } } SOA { set x $index set rdata [list MNAME [ReadName data $x off]] incr x $off @@ -1301,27 +1320,27 @@ } set used [expr {$index - $startindex}] return [join $r .] } -proc ::dns::ReadString {datavar index length} { +proc ::dns::ReadString {datavar index usedvar} { upvar $datavar data + upvar $usedvar used set startindex $index set r {} - set max [expr {$index + $length}] - while {$index < $max} { - binary scan [string range $data $index end] c len - set len [expr {$len & 0xFF}] - incr index + if {[binary scan [string range $data $index end] c len] == 1} { + set len [expr {$len & 0xFF}] + incr index - if {$len != 0} { - append r [string range $data $index [expr {$index + $len - 1}]] - incr index $len - } + if {$len != 0} { + set r [string range $data $index [expr {$index + $len - 1}]] + incr index $len + } } + set used [expr {$index - $startindex}] return $r } # ------------------------------------------------------------------------- @@ -1485,11 +1504,11 @@ # ------------------------------------------------------------------------- catch {dns::configure -nameserver [lindex [dns::nameservers] 0]} -package provide dns 1.4.1 +package provide dns 1.5.0 # ------------------------------------------------------------------------- # Local Variables: # indent-tabs-mode: nil # End: Index: modules/dns/pkgIndex.tcl ================================================================== --- modules/dns/pkgIndex.tcl +++ modules/dns/pkgIndex.tcl @@ -1,7 +1,7 @@ # pkgIndex.tcl - if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded dns 1.4.1 [list source [file join $dir dns.tcl]] +package ifneeded dns 1.5.0 [list source [file join $dir dns.tcl]] package ifneeded resolv 1.0.3 [list source [file join $dir resolv.tcl]] package ifneeded ip 1.4 [list source [file join $dir ip.tcl]] package ifneeded spf 1.1.1 [list source [file join $dir spf.tcl]]