Posted to tcl by schelte at Sun Mar 03 20:48:54 GMT 2013view raw

  1. proc dns::message {name {type 1} {class 1}} {
  2. variable id; variable servers
  3. # Header
  4. # QR = 0, Opcode = 0, AA = 0, TC = 0, RD = 0, RA = 0, Z = 0, RCODE = 0
  5. set flags [expr {1 << 8}]
  6. set qdcnt 1
  7. set ancnt 0
  8. set nscnt 0
  9. set arcnt 0
  10. set msg [binary format SSSSSS $id $flags $qdcnt $ancnt $nscnt $arcnt]
  11. # Query
  12. set name [string trimright $name .].
  13. foreach n [split $name .] {
  14. append msg [binary format ca* [string length $n] $n]
  15. }
  16. append msg [binary format SS $type $class]
  17.  
  18. if {[llength $servers] == 0} resolvconf
  19.  
  20. foreach server $servers {
  21. set duft [duft create $server 53]
  22. duft send $duft $msg
  23. duft configure $duft \
  24. -receiver [list [info coroutine] result] -listen 1 -buffersize 4096
  25. lassign [yieldm] state response info
  26. if {$state eq "result"} {
  27. # Get segmentation fault if the duft is closed immediately
  28. # duft close $duft
  29. after 0 [list duft close $duft]
  30. return [parse $response]
  31. }
  32. }
  33. return {}
  34. }