1# resolv.tcl - Copyright (c) 2002 Emmanuel Frecon <emmanuel@sics.se>
2#
3# Original Author --  Emmanuel Frecon - emmanuel@sics.se
4# Modified by Pat Thoyts <patthoyts@users.sourceforge.net>
5#
6#  A super module on top of the dns module for host name resolution.
7#  There are two services provided on top of the regular Tcl library:
8#  Firstly, this module attempts to automatically discover the default
9#  DNS server that is setup on the machine that it is run on.  This
10#  server will be used in all further host resolutions.  Secondly, this
11#  module offers a rudimentary cache.  The cache is rudimentary since it
12#  has no expiration on host name resolutions, but this is probably
13#  enough for short lived applications.
14#
15# -------------------------------------------------------------------------
16# See the file "license.terms" for information on usage and redistribution
17# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
18# -------------------------------------------------------------------------
19#
20# $Id: resolv.tcl,v 1.9 2004/01/25 07:29:39 andreas_kupries Exp $
21
22package require dns 1.0;                # tcllib 1.3
23
24namespace eval ::resolv {
25    variable version 1.0.3
26    variable rcsid {$Id: resolv.tcl,v 1.9 2004/01/25 07:29:39 andreas_kupries Exp $}
27
28    namespace export resolve init ignore hostname
29
30    variable R
31    if {![info exists R]} {
32        array set R {
33            initdone   0
34            dns        ""
35            dnsdefault ""
36            ourhost    ""
37            search     {}
38        }
39    }
40}
41
42# -------------------------------------------------------------------------
43# Command Name     --  ignore
44# Original Author  --  Emmanuel Frecon - emmanuel@sics.se
45#
46# Remove a host name resolution from the cache, if present, so that the
47# next resolution will query the DNS server again.
48#
49# Arguments:
50#    hostname	- Name of host to remove from the cache.
51#
52proc ::resolv::ignore { hostname } {
53    variable Cache
54    catch {unset Cache($hostname)}
55    return
56}
57
58# -------------------------------------------------------------------------
59# Command Name     --  init
60# Original Author  --  Emmanuel Frecon - emmanuel@sics.se
61#
62# Initialise this module with a known host name.  This host (not mandatory)
63# will become the default if the library was not able to find a DNS server.
64# This command can be called several times, its effect is double: actively
65# looking for the default DNS server setup on the running machine; and
66# emptying the host name resolution cache.
67#
68# Arguments:
69#    defaultdns	- Default DNS server
70#
71proc ::resolv::init { {defaultdns ""} {search {}}} {
72    variable R
73    variable Cache
74
75    # Clean the resolver cache
76    catch {unset Cache}
77
78    # Record the default DNS server and search list.
79    set R(dnsdefault) $defaultdns
80    set R(search) $search
81
82    # Now do some intelligent lookup.  We do this on the current
83    # hostname to get a chance to get back some (full) information on
84    # ourselves.  A previous version was using 127.0.0.1, not sure
85    # what is best.
86    set res [catch {open "/etc/resolv.conf" "r"} f]
87    if { $res == 0 } {
88	set lkup [read $f]
89	close $f
90	set l [split $lkup]
91	set nl ""
92	foreach e $l {
93	    if { [string length $e] > 0 } {
94		lappend nl $e
95	    }
96	}
97
98        # Now, a lot of mixture to arrange so that hostname points at the
99        # DNS server that we should use for any further request.
100        set hostname ""
101	set len [llength $nl]
102	for { set i 0 } { $i < $len } { incr i } {
103	    set e [lindex $nl $i]
104	    if { [string match -nocase "nameserver" $e] } {
105		set hostname [lindex $nl [expr {$i + 1}]]
106                if { [string match -nocase "UnKnown" $hostname] } {
107                    set hostname ""
108                }
109		break
110	    }
111	}
112
113	if { $hostname != "" } {
114	    set R(dns) $hostname
115	} else {
116	    set R(dns) "127.0.0.1"
117	}
118    }
119
120    if {$R(dns) == ""} {
121        set R(dns) $R(dnsdefault)
122    }
123
124
125    set R(ourhost) [info hostname]
126
127
128    set R(initdone) 1
129
130    return $R(dns)
131}
132
133# -------------------------------------------------------------------------
134# Command Name     --  resolve
135# Original Author  --  Emmanuel Frecon - emmanuel@sics.se
136#
137# Resolve a host name to an IP address.  This is a wrapping procedure around
138# the basic services of the dns library.
139#
140# Arguments:
141#    hostname	- Name of host
142#
143proc ::resolv::resolve { hostname } {
144    variable R
145    variable Cache
146
147    # Initialise if not already done. Auto initialisation cannot take
148    # any known DNS server (known to the caller)
149    if { ! $R(initdone) } { init }
150
151    # Check whether this is not simply a raw IP address. What about
152    # IPv6 ??
153    # - We don't have sockets in Tcl for IPv6 protocols - [PT]
154    #
155    if { [regexp {\d+\.\d+\.\d+\.\d+} $hostname] } {
156	return $hostname
157    }
158
159    # Look for hostname in the cache, if found return.
160    if { [array names ::resolv::Cache $hostname] != "" } {
161	return $::resolv::Cache($hostname)
162    }
163
164    # Scream if we don't have any DNS server setup, since we cannot do
165    # anything in that case.
166    if { $R(dns) == "" } {
167	return -code error "No dns server provided"
168    }
169
170    set R(retries) 0
171    set ip [Resolve $hostname]
172
173    # And store the result of resolution in our cache for further use.
174    set Cache($hostname) $ip
175
176    return $ip
177}
178
179# Description:
180#  Attempt to resolve hostname via DNS. If the name cannot be resolved then
181#  iterate through the search list appending each domain in turn until we
182#  get one that succeeds.
183#
184proc ::resolv::Resolve {hostname} {
185    variable R
186    set t [::dns::resolve $hostname -server $R(dns)]
187    ::dns::wait $t;                       # wait with event processing
188    set status [dns::status $t]
189    if {$status == "ok"} {
190        set ip [lindex [::dns::address $t] 0]
191        ::dns::cleanup $t
192    } elseif {$status == "error"
193              && [::dns::errorcode $t] == 3
194              && $R(retries) < [llength $R(search)]} {
195        ::dns::cleanup $t
196        set suffix [lindex $R(search) $R(retries)]
197        incr R(retries)
198        set new [lindex [split $hostname .] 0].[string trim $suffix .]
199        set ip [Resolve $new]
200    } else {
201        set err [dns::error $t]
202        ::dns::cleanup $t
203        return -code error "dns error: $err"
204    }
205    return $ip
206}
207
208# -------------------------------------------------------------------------
209
210package provide resolv $::resolv::version
211
212# -------------------------------------------------------------------------
213# Local Variables:
214#   indent-tabs-mode: nil
215# End:
216