#  jlibdns.tcl --
#  
#      This file is part of the jabberlib. It provides support for
#      Jabber Client SRV DNS records (RFC 3920) and
#      DNS TXT Resource Record Format (XEP-0156).
#      
#  Copyright (c) 2006 Sergei Golovan <sgolovan@nes.ru>
#  
# $Id: jlibdns.tcl 1244 2007-10-06 07:53:04Z sergei $
#
#  SYNOPSIS
#      jlibdns::get_addr_port domain
#  RETURNS list of {hostname port} pairs
#
#  SYNOPSIS
#      jlibdns::get_http_poll_url domain
#  RETURNS URL for HTTP-poll connect method (XEP-0025)
#

##########################################################################

package require dns
package require idna

if {$::tcl_platform(platform) == "windows"} {
    package require registry
}

package provide jlibdns 1.0

##########################################################################

namespace eval jlibdns {}

##########################################################################

proc jlibdns::get_addr_port {domain} {
    set name _xmpp-client._tcp.[idna::domain_toascii $domain]

    if {[catch { resolve $name SRV } res]} {
	return {}
    }

    set results {}
    foreach reply $res {
	array unset rr1
	array set rr1 $reply
	if {![info exists rr1(rdata)]} continue

	array unset rr
	if {[catch { array set rr $rr1(rdata) }]} continue

	if {$rr(target) == "."} continue

	if {[info exists rr(priority)] && [check $rr(priority)] && \
		[info exists rr(weight)] && [check $rr(weight)] && \
		[info exists rr(port)] && [check $rr(port)] && \
		[info exists rr(target)]} {
	    if {$rr(weight) == 0} {
		set n 0
	    } else {
		set n [expr {($rr(weight) + 1) * rand()}]
	    }
	    lappend results [list [expr {$rr(priority) * 65536 - $n}] \
				  $rr(target) $rr(port)]
	}
    }

    set replies {}
    foreach hp [lsort -real -index 0 $results] {
	lappend replies [list [lindex $hp 1] [lindex $hp 2]]
    }
    return $replies
}

proc jlibdns::check {val} {
    if {[string is integer -strict $val] && $val >= 0 && $val < 65536} {
	return 1
    } else {
	return 0
    }
}

##########################################################################

proc jlibdns::get_http_poll_url {domain} {
    set name _xmppconnect.[idna::domain_toascii $domain]

    if {![catch { resolve $name TXT } res]} {
	foreach reply $res {
	    array set rr $reply
	    if {[regexp {_xmpp-client-httppoll=(.*)} $rr(rdata) -> url]} {
		return $url
	    }
	}
    }
    return ""
}

##########################################################################

proc jlibdns::resolve {name type} {
    set nameservers [get_nameservers]

    foreach ns $nameservers {
	set token [dns::resolve $name -type $type -nameserver $ns]
	dns::wait $token
	set status [dns::status $token]

	if {$status == "ok"} {
	    set res [dns::result $token]
	    dns::cleanup $token
	    return $res
	} else {
	    set err [dns::error $token]
	    dns::cleanup $token
	}
    }
    return -code error "DNS error: $err"
}

##########################################################################

proc jlibdns::get_nameservers {} {
    global tcl_platform

    switch -- $tcl_platform(platform) {
	unix {
	    set resolv "/etc/resolv.conf"
	    if {![file readable $resolv]} {
		return {127.0.0.1}
	    } else {
		set fd [open $resolv]
		set lines [split [read $fd] "\r\n"]
		close $fd
		set ns {}
		foreach line $lines {
		    if {[regexp {^nameserver\s+(\S+)} $line -> ip]} {
			lappend ns $ip
		    }
		}
		if {$ns == {}} {
		    return {127.0.0.1}
		} else {
		    return $ns
		}
	    }
	}
	windows {
	    set services_key \
		"HKEY_LOCAL_MACHINE\\system\\CurrentControlSet\\Services"
	    set win9x_key "$services_key\\VxD\\MSTCP"
	    set winnt_key "$services_key\\TcpIp\\Parameters"
	    set interfaces_key "$winnt_key\\Interfaces"

	    # Windows 9x
	    if {![catch { registry get $win9x_key "NameServer" } ns]} {
		return [join [split $ns ,] " "]
	    }

	    # Windows NT/2000/XP
	    if {![catch { registry get $winnt_key "NameServer" } ns] && \
		    $ns != {}} {
		return [join [split $ns ,] " "]
	    }
	    if {![catch { registry get $winnt_key "DhcpNameServer" } ns] && \
		    $ns != {}} {
		return $ns
	    }
            foreach key [registry keys $interfaces_key] {
		if {![catch {
			  registry get "$interfaces_key\\$key" \
				       "NameServer"
		      } ns] && $ns != {}} {
		    return [join [split $ns ,] " "]
		}
		if {![catch {
			  registry get "$interfaces_key\\$key" \
				       "DhcpNameServer"
		      } ns] && $ns != {}} {
		    return $ns
		}
            }
	    return {}
	}
    }
}

##########################################################################

