Posted to tcl by schelte at Sun Mar 03 20:48:54 GMT 2013view raw
- 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 {}
- }