# valid.tcl
#
# ****************************************************************************
# Copyright (c) 2001 Digi International Inc., All Rights Reserved
# 
# This software contains proprietary and confidential information of Digi
# International Inc.  By accepting transfer of this copy, Recipient agrees
# to retain this software in confidence, to prevent disclosure to others,
# and to make no use of this software other than that for which it was
# delivered.  This is an unpublished copyrighted work of Digi International
# Inc.  Except as permitted by federal law, 17 USC 117, copying is strictly
# prohibited.
# 
# Restricted Rights Legend
#
# Use, duplication, or disclosure by the Government is subject to
# restrictions set forth in sub-paragraph (c)(1)(ii) of The Rights in
# Technical Data and Computer Software clause at DFARS 252.227-7031 or
# subparagraphs (c)(1) and (2) of the Commercial Computer Software -
# Restricted Rights at 48 CFR 52.227-19, as applicable.
#
# Digi International Inc. 11001 Bren Road East, Minnetonka, MN 55343
#
# ***************************************************************************
package provide Tools 1.0
namespace eval Valid {

##
## Check the argument. If it is an IP address, lookup the hostname, 
## else lookup the address.
##
proc nslook {arg} {
	package require Tnm
	
    if {[IPnum $arg]} {
        if {[catch {Tnm::dns name $arg} res]} {
            # Try the other lookup
            if {[catch {Tnm::netdb hosts name $arg} res]} {
                set res "failed"
            }
        }
    } else {
        if {[catch {Tnm::netdb hosts address $arg} res]} {
            # Try the other lookup
            if {[catch {Tnm::dns address $arg} res] || $res == $arg} {
                set res "failed"
            }
        }
    }
    return $res
}

proc IPnum {ip} {
	if { [info tclversion] < 8.1 } {
		return -code error "[namespace current]::IPnum requires tcl 8.1 or higher"
	}
	regexp {^([01]?[0-9]{1,2}|2[0-4][0-9]|25[0-5])(\.([01]?[0-9]{1,2}|2[0-4][0-9]|25[0-5])){3}$} $ip
}

proc IPname {name} {
	if {![regexp {^([a-z]|[A-Z])} $name]} {
		# First character was not alpha
		return 0
	}
	if {[nslook $name] == "failed"} {
		return 0
	} else {
		return 1
	}
}

## There may be a better way but...
proc DGping {strIP {numTO 5}} {
    set ret 0
    set ::Valid::Connected 0
    set numCount 0
    set numArbitraryPort 21711
    catch {set ::Valid::s [socket -async $strIP $numArbitraryPort]} 
    #fconfigure $::Valid::s -blocking false
    catch {fileevent $::Valid::s w [list Valid::cb $::Valid::s]} 
    while { $numCount < $numTO } {
        if { $::Valid::Connected } {
            if {[string match "*refused*" $::Valid::strCberr]} {
                ## "connection refused" means the host is there
                set ret 1
            } else {
                set ret 0
            }
                break
        }
        update
        after 1000
        incr numCount
}
    catch {close $::Valid::s}
    return $ret
}

proc cb {s} {
    fileevent $s w {}
    if {! $::Valid::Connected} {
        set ::Valid::strCberr [fconfigure $s -error]
    }
    set ::Valid::Connected 1
}
} ;# end namespace Valid