Posted to tcl by schelte at Sun Mar 03 20:48:54 GMT 2013view pretty
proc dns::message {name {type 1} {class 1}} { variable id; variable servers # Header # QR = 0, Opcode = 0, AA = 0, TC = 0, RD = 0, RA = 0, Z = 0, RCODE = 0 set flags [expr {1 << 8}] set qdcnt 1 set ancnt 0 set nscnt 0 set arcnt 0 set msg [binary format SSSSSS $id $flags $qdcnt $ancnt $nscnt $arcnt] # Query set name [string trimright $name .]. foreach n [split $name .] { append msg [binary format ca* [string length $n] $n] } append msg [binary format SS $type $class] if {[llength $servers] == 0} resolvconf foreach server $servers { set duft [duft create $server 53] duft send $duft $msg duft configure $duft \ -receiver [list [info coroutine] result] -listen 1 -buffersize 4096 lassign [yieldm] state response info if {$state eq "result"} { # Get segmentation fault if the duft is closed immediately # duft close $duft after 0 [list duft close $duft] return [parse $response] } } return {} }