Vadtec

######################################################################
#Begin config

set db "domain-stats.sql.db"
set resolve 1
set debug 1

#End config
######################################################################

set mydir "/home/vadtec/tcl/"
lappend auto_path $mydir

package require dns
package require ip
package require sqlite3

# sql DB
sqlite3 dbs $db

bind msgm - "!resolve*" cm_resolve 

proc cm_resolve { nick uhost handle text } {
	global resolve

	set sql "SELECT id, domain FROM domain WHERE ip = \"\" AND longip ISNULL ORDER BY id;"
	output "log" $sql
	set result [dbs eval $sql]
	output "log" $result
	
	if {$resolve} {
		set i 0
		
		foreach r [split $result " "] {
			if {[string is integer -strict $r]} {
				set i $r
			} else {
				set status ""
				set ipver [ip::version $r]
				
				output "log" ">>> 1 >> 1 > id: $i domain $r ipver: $ipver"
				
				if {$ipver == 4} {
					set longip [ip::toInteger $r]
					output "log" ">>> 1 >> 2 > ipver: $ipver ip: $r longip: $longip"
					set sql "UPDATE domain SET ip = '$r', longip = $longip WHERE id = $i"
					dbs eval $sql
				}
				
				if {$ipver == 6} {
					set longip "0"
					catch {[set longip [ip::toInteger $r]]}
					output "log" ">>> 1 >> 3 > ipver: $ipver ip: $r longip: $longip"
					set sql "UPDATE domain SET ip = '$r', longip = $longip WHERE id = $i"
					dbs eval $sql
				}
				
				if {$ipver == -1} {
					set tok [dns::resolve $r]
					set status [dns::status $tok]
					output "log" ">>> 1 >> 4 > ipver: $ipver ip: $r status: $status"
				}
				
				if {$status eq "ok"} {
					set ip [dns::address $tok]
					if {[llength $ip] != 1} {
						set temp [split $ip]
						set ip [lindex $temp 0]
					}
					set longip [ip::toInteger $ip]
					output "log" ">>> 1 >> 5 > id: $i ipver: $ipver ip: $ip longip: $longip"
					set sql "UPDATE domain SET ip = '$ip', longip = $longip WHERE id = $i"
					dbs eval $sql
				}
			}
		}
	}
}

proc output { where text } {
	global debug
	
	if {$debug} {
		if {$where eq "log"} {
			putlog $text
		} else {
			putmsg $where $text
		}
	}
}