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 {}
}