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