## rbl check via dig with scoring system by leprechau@EFnet
## initial release no support or documentation other than provided herein

if {[namespace exists ::rblchk]} {namespace delete ::rblchk}
namespace eval ::rblchk {
	namespace export dig check score

	## begin settings ##

	variable digbin [lindex [split [exec which dig]] 0]
	## location of dig binary including path (default should work on most systems)

	variable rbls; array set rbls {
		http.dnsbl.sorbs.net {{Open HTTP Proxy} +2.0}
		socks.dnsbl.sorbs.net {{Open SOCKS Proxy} +2.0}
		misc.dnsbl.sorbs.net {{Open Misc Proxy} +2.0}
		ircbl.ahbl.org {{Abusive Hosts} +2.0}
		blackholes.us {{Problematic Countries} +1.0}
		blackholes.five-ten-sg.com {{Spam Sources, Relays, Dialups, DSL} +1.0}
		cbl.abuseat.org {{Open Proxies and Trojans} +2.0}
		wpbl.dnsbl.net.au {{Weighted Private Block List} +2.0}
		dul.dnsbl.sorbs.net {{Dynamic IPs} -1.0}
	}
	## array of rbls, descriptions, and a score for each
	## format: rblname {{description to show offenders} score}
	## scores must be numeric, but can be either + or - and whole or decimal numbes

	## end settings ##
	variable version 0.8

	proc dig {host args} {
		foreach opt {ns type callback} {
			if {[set i [lsearch -glob $args \-$opt\*]] != -1} {set [set opt] "[lindex $args [expr {$i +1}]]"; set args [lreplace $args $i [expr {$i +1}]]}
		}
		if {![info exists type]} {set type A}; if {![info exists ns]} {set ns {}} else {set ns "@$ns "}
		if {[catch {set lookup [split [read [set cid [open "|$::rblchk::digbin $ns$host $type" r]]] \n];close $cid} open_error] != 0} {
			return -code error "Error opening command pipe ($::rblchk::digbin $ns$host $type): $open_error"
		}
		set lookup [lrange $lookup [expr {[lsearch -glob $lookup {*ANSWER SECTION*}]+1}] [expr {[lsearch -glob $lookup {*AUTHORITY SECTION*}]-1}]]
		foreach line $lookup {
			switch -- [lindex $line 3] {
				A {lappend ips [lindex $line end]}
				TXT {lappend txts [lindex $line end]}
				default {continue}
			}
		}
		foreach var {ips txts} {if {![info exists [set var]]} {set [set var] NULL}}
		if {[info exists callback]} {
			switch -- $type {
				A {eval $callback $host [list $ips] $args}
				ANY {eval $callback $host [list $ips] [list $txts] $args}
			}
		} else {
			switch -- $type {
				A {return "$host $ips"}
				ANY {return "$host $ips $txts"}
			}
		}
	}

	proc check {host rbl args} {
		if {![regexp {^([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])$} $host]} {
			set host [lindex [lindex [::rblchk::dig $host] 1] 0]
		}
		for {set i 0} {$i < 4} {incr i} {lappend rip [lindex [split $host {.}] end-$i]}
		if {[set i [lsearch -glob $args \-callback\*]] != -1} {set callback "[lindex $args [expr {$i +1}]]"; set args [lreplace $args $i [expr {$i +1}]]}
		if {[info exists callback]} {
			eval $callback $host [list [::rblchk::dig [join $rip {.}].$rbl -type ANY]] $args
		} else {return "$host [::rblchk::dig [join $rip {.}].$rbl -type ANY]"}
	}

	proc score {host args} {
		set total 0; set details [list]
		foreach rbl [array names ::rblchk::rbls] {
			if {(![string equal {NULL} [lindex [set check [::rblchk::check $host $rbl]] 2]]) && (![string equal {NULL} [lindex $check 3]])} {
				set total [expr [subst {$total [set score [lindex $::rblchk::rbls($rbl) end]]}]]
				lappend details [list $score $rbl [lindex $::rblchk::rbls($rbl) 0] [lindex $check end]]
			}
		}
		if {[set i [lsearch -glob $args \-callback\*]] != -1} {set callback "[lindex $args [expr {$i +1}]]"; set args [lreplace $args $i [expr {$i +1}]]}
		if {[info exists callback]} {eval $callback [lindex $check 0] [list $details] $total $args} else {return "[lindex $check 0] $details $total]"}
	}
}
package provide rblchk $::rblchk::version

## eggdrop extension designed to work with rblchk above both by me (leprechau@EFnet)
## initial release no support or documentation other than provided herein
## to enable this on a channel type: .chanset #channel +rblchk
## other options described below

if {[namespace exists ::eggrbl]} {namespace delete ::eggrbl}
namespace eval ::eggrbl {

	## begin settings ##

	variable scores; array set scores {
		warn 1.0
		kick 4.0
		kban 5.0
	}
	## points required for warning/kick/kick ban

	variable warntype "privmsg";
	## warning methond (privmsg or notice)
	## warnings only sent if channel is set +rblmsguser

	variable adminname "#admin";
	## nick of admin (or channel name) to send details of rblchecks to
	## only works if channel is set +rblchk and +rblmsgadmin

	variable usertxttrim "0";
	## setting to trim TXT records returned from RBL servers
	## 0 = do not trim
	## 1 = trim all before url
	## 2 = trim url from txt
	## 3 = do not display TXT field
	## There is no point in setting this to '2' for user notices

	variable admintxttrim "3";
	## same settings as 'usertxttrim' but applies to the admin notices

	variable exemptflags "";
	## users with the above flags are exempt from checks
	## set to "" to disable exemptions

	## end settings ##

	setudef flag rblchck
	setudef flag rblmsgadmin
	setudef flag rblmsguser
	variable version 0.6

	proc warn {details total uhost ip nick chan warn kick kban} {
		switch -exact -- $::eggrbl::warntype {
			privmsg {set type PRIVMSG}
			notice {set type NOTICE}
			default {set type PRIVMSG}
		}
		if {[channel get $chan rblmsguser]} {
			puthelp "$type $nick :[lindex [split $uhost {@}] end] \($ip\) appears in the following dns black list(s)."
			foreach line $details {
				foreach {score rbl desc txt} $line {
					switch -exact -- $::eggrbl::usertxttrim {
						1 {regsub -all -- {^.*http://} $txt {http://} txt}
						2 {regsub -all -- {http://.*$} $txt {} txt}
						3 {set txt {}}
					}
					puthelp "$type $nick :\002$score\002 $rbl \002$desc\002 $txt"
				}
			}
			puthelp "$type $nick :\002TOTAL\002: $total (warning $warn / kick $kick / kban $kban)"
		}
		if {[channel get $chan rblmsgadmin]} {
			puthelp "PRIVMSG $::eggrbl::adminname :RBL \002$nick!$uhost\002 \($ip\) in \002$chan\002 scored \002$total\002 point(s)."
			foreach line $details {
				foreach {score rbl desc txt} $line {
					switch -exact -- $::eggrbl::admintxttrim {
						1 {regsub -all -- {^.*http://} $txt {http://} txt}
						2 {regsub -all -- {http://.*$} $txt {} txt}
						3 {set txt {}}
					}
					puthelp "PRIVMSG $::eggrbl::adminname :\002$score\002 $rbl \002$desc\002 $txt"
				}
			}
		}
	}

	proc getscore {ip details total uhost nick chan} {
		foreach name [array names ::eggrbl::scores] { set [set name] $::eggrbl::scores($name) }
		if {($total == 0) || ($total < $warn)} {return} elseif {($total >= $warn) && ($total < $kick)} {
			putlog "RBL \002$nick!$uhost\002 \($ip\) scored \002$total\002 points in \002$chan\002 \(warn $warn kick $kick kban $kban\)"
			::eggrbl::warn $details $total $uhost $ip $nick $chan $warn $kick $kban
		} elseif {($total >= $kick) && ($total < $kban)} {
			putlog "RBL \002$nick!$uhost\002 \($ip\) scored \002$total\002 points in \002$chan\002 \(warn $warn kick $kick kban $kban\)"
			if {[isop $::botnick $chan]} {
				putserv "KICK $chan $nick :(rblchk) See notice/message for more information."
			} else {putlog "RBL Wanted to kick \002$nick!$uhost\002 on \002$chan\002 but I do not have ops there."}
			::eggrbl::warn $details $total $uhost $ip $nick $chan $warn $kick $kban
		} elseif {($total >= $kban)} {
			putlog "RBL \002$nick!$uhost\002 \($ip\) scored \002$total\002 points in \002$chan\002 \(warn $warn kick $kick kban $kban\)"
			if {[isop $::botnick $chan]} {
				putserv "MODE $chan -o+b $nick *!*@$uhost"; putserv "KICK $chan $nick :rblchk v$::rblchk::version + eggrbl v$::eggrbl::version"
			} else {putlog "RBL Wanted to kickban \002$nick!$uhost\002 on \002$chan\002 but I do not have ops there."}
			::eggrbl::warn $details $total $uhost $ip $nick $chan $warn $kick $kban
		} else { putlog "RBL ERROR: Cannot determine proper action from total score \($total\)"; return }
	}

	proc onjoin {nick uhost hand chan} {
		if {(![channel get $chan rblchck]) || ([string equal -nocase $nick $::botnick]) || \
		((![string equal {} $::eggrbl::exemptflags]) && ([matchattr $nick $::eggrbl::exemptflags $chan]))} {return}
		::rblchk::score [lindex [split $uhost {@}] end] -callback ::eggrbl::getscore $uhost $nick $chan
	}
	bind join - {* *!*@*} ::eggrbl::onjoin
}
package provide eggrbl $::eggrbl::version

putlog "rblchk v$::rblchk::version + eggrbl v$::eggrbl::version by leprechau@EFnet loaded!"
