##################
 ## Module Name     --  resolv.tcl
 ## Original Author --  Emmanuel Frecon - [email protected]
 ## Description:
 ##
 ##   A super module on top of the dns module for host name resolution.
 ##   There are two services provided on top of the regular Tcl library:
 ##   Firstly, this module attempts to automatically discover the default
 ##   DNS server that is setup on the machine that it is run on.  This
 ##   server will be used in all further host resolutions.  Secondly, this
 ##   module offers a rudimentary cache.  The cache is rudimentary since it
 ##   has no expiration on host name resolutions, but this is probably
 ##   enough for short lived applications.
 ##
 ##################
 
 package provide resolv 1.0
 
 package require dns
 
 namespace eval ::resolv {
     namespace export resolve init ignore
 
     array set R {
         initdone   0
         dns        ""
         dnsdefault ""
     }
 }
 
 
 
 # Command Name     --  ignore
 # Original Author  --  Emmanuel Frecon - [email protected]
 #
 # Remove a host name resolution from the cache, if present, so that the
 # next resolution will query the DNS server again.
 #
 # Arguments:
 #    hostname        - Name of host to remove from the cache.
 proc ::resolv::ignore { hostname } {
     global ::resolv::Cache
 
     catch "unset ::resolv::Cache($hostname)"
 }
 
 
 # Command Name     --  init
 # Original Author  --  Emmanuel Frecon - [email protected]
 #
 # Initialise this module with a known host name.  This host (not mandatory)
 # will become the default if the library was not able to find a DNS server.
 # This command can be called several times, its effect is double: actively
 # looking for the default DNS server setup on the running machine; and 
 # emptying the host name resolution cache.
 #
 # Arguments:
 #    defaultdns        - Default DNS server
 proc ::resolv::init { { defaultdns "" } } {
     global ::resolv::R ::resolv::Cache
 
     catch "unset ::resolv::Cache"
     
     set ::resolv::R(dnsdefault) $defaultdns
 
     set res [catch "exec nslookup 127.0.0.1" lkup]
     if { $res == 0 } {
         set l [split $lkup]
         set nl ""
         foreach e $l {
             if { [string length $e] > 0 } {
                 lappend nl $e
             }
         }
         
         set hostname ""
         set len [llength $nl]
         for { set i 0 } { $i < $len } { incr i } {
             set e [lindex $nl $i]
             if { [string match -nocase "*server*" $e] } {
                 set hostname [lindex $nl [expr $i + 1]]
                 break
             }
         }
         
         if { $hostname != "" } {
             set ::resolv::R(dns) $hostname
         } else {
             set ::resolv::R(dns) $::resolv::R(dnsdefault)
         }
     }
 
     set ::resolv::R(initdone) 1
 
     return $::resolv::R(dns)
 }
 
 
 # Command Name     --  resolve
 # Original Author  --  Emmanuel Frecon - [email protected]
 #
 # Resolve a host name to an IP address.  This is a wrapping procedure around
 # the basic services of the dns library.
 #
 # Arguments:
 #    hostname        - Name of host
 proc ::resolv::resolve { hostname } {
     global ::resolv::R
     global ::resolv::Cache
 
     # Initialise if not already done. Auto initialisation cannot take
     # any known DNS server (known to the caller)
     if { ! $::resolv::R(initdone) } {
         ::resolv::init
     }
 
     # Check whether this is not simply a raw IP address. What about
     # IPv6 ??
     if { [regexp "\\d+\\.\\d+\\.\\d+\\.\\d+" $hostname] } {
         return $hostname
     }
 
     # Look for hostname in the cache, if found return.
     if { [array names ::resolv::Cache $hostname] != "" } {
         return $::resolv::Cache($hostname)
     }
 
     # Scream if we don't have any DNS server setup, since we cannot do
     # anything in that case.
     if { $::resolv::R(dns) == "" } {
         error "No dns server provided"
     }
 
     # Now resolve in a clean way
     set t [::dns::resolve $hostname -server $::resolv::R(dns)]
     set ip [lindex [::dns::address $t] 0]
     ::dns::cleanup $t
 
     # And store the result of resolution in our cache for further use.
     set ::resolv::Cache($hostname) $ip
 
     return $ip
 }