##########################################################################################
## IpBL.tcl 1.2  (04/12/2022)  			                   		   	  												##
##                                                                        		   			  ##
##             	        					Copyright 2008 - 2022 @ WwW.TCLScripts.NET 	   				##
##          	   _   _   _   _   _   _   _   _   _   _   _   _   _   _          	   		##
##      	  / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \          	   				##
##              ( T | C | L | S | C | R | I | P | T | S | . | N | E | T )       	   		##
##      	  \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/         	   				##
##                                                                        		   				##
##                      				 ® BLaCkShaDoW Production ®                       	   	##
##                                                                         		   				##
##                              	 			 PRESENTS                                 	   	##
##									 		 																															® ##
######################################   IpBL TCL   ######################################
##									   																															    ##
##  DESCRIPTION: 							   		  																								  ##
##                                                                                      ##
##  Bans IP's that are listed as spam or have other incidents in folowing               ##
##  ip incidents databases : dnsbl.dronebl.org, cbl.abuseat.org                         ##
##  Have a chan command and a backchan support also.                                    ##
##					   		   		   																	                       			##
##  Tested on Eggdrop v1.9.2 (Debian Linux) Tcl version: 8.6.10             		   			##
##									   		   																														##
##########################################################################################
##								           																												    ##
##  INSTALLATION: 						           		   																				  ##
##  ++ Edit IpBL.tcl script & place it into your /scripts directory.		  				      ##
##  ++ add "source scripts/IpBL.tcl" to your eggdrop.conf & rehash. 	 	   			      	##
##  ++ package require http                                                             ##
##								           		   																										  ##
##		For the join scan to work use: .chanset/.set #chan +ipbl                		  		##
##    To setup a backchan use : .chanset/.set ipbl-backchan <#channel>                  ##
##											   																															##
##########################################################################################
## Commands:																																					  ##
##																																										  ##
## !ipbl <nick>/<host>/<ip> ; manual check                                              ##
##										   																														    ##
#########################################################################################
##											   																														 ##
##  		OFFICIAL LINKS:                                                        				 ##
##   		E-mail      : BLaCkShaDoW[at]tclscripts.net                             			 ##
##  		 Bugs report : http://www.tclscripts.net                               				 ##
##  		 GitHub page : https://github.com/tclscripts/ 			   												 ##
##   		Online help : irc://irc.undernet.org/tcl-help                           			 ##
##          		       #TCL-HELP / UnderNet        	                          				 ##
##          	 You can ask in english or romanian                       		   				 ##
##									  		   																												   ##
##    	 paypal.me/DanielVoipan = Please consider a donation. Thanks!        	   			 ##
##									  		 																													   ##
#########################################################################################
##									  		  																													 ##
##         	 You want a customised TCL Script for your eggdrop?          	   					 ##
##    		         Easy-peasy, just tell me what you need!                    	   		 ##
##  	I can create almost anything in TCL based on your ideas and donations.  	   		 ##
##   		Email blackshadow@tclscripts.net or info@tclscripts.net with your       			 ##
##    		request informations and I'll contact you as soon as possible.	   					 ##
##									 		   																														 ##
#########################################################################################
##								      		           																								 ##
## 		 PERSONAL AND NON-COMMERCIAL USE LIMITATION.                            				 ##
##                                                                        		   			 ##
##  	   This program is provided on an "as is" and "as available" basis,   	   			 ##
##  	   with ABSOLUTELY NO WARRANTY. Use it at your own risk.                  	   	 ##
##                                                                        		   			 ##
## 	   Use this code for personal and NON-COMMERCIAL purposes ONLY.           	   		 ##
##                                                                        		   			 ##
##  	   Unless otherwise specified, YOU SHALL NOT copy, reproduce, sublicense,        ##
##  	   distribute, disclose, create derivatives, in any way ANY PART OF        	     ##
##  	   THIS CONTENT, nor sell or offer it for sale.                            	     ##
##                                                                         		   			 ##
##  	   You will NOT take and/or use any screenshots of this source code for          ##
##  	   any purpose without the express written consent or knowledge of author.       ##
##                                                                       		   				 ##
## 	   You may NOT alter or remove any trademark, copyright or other notice         	 ##
##  	   from this source code.                                                        ##
##                                                                         		   			 ##
##       		       Copyright 2008 - 2022 @ WwW.TCLScripts.NET                					 ##
##                                                                         		   			 ##
#########################################################################################

###
#Default first char for command
set ipbl(char) "!"

###
#Flags needed to run command !ipbl <nick>/<host>/<ip>
set ipbl(flags) "nm|-"

##
#Except hostmasks (it will not be scanned)
set ipbl(except_hostmasks) {
  "*.undernet.org"
}

###
#Default banTime (minutes)
set ipbl(bantime) "60"

###
#Ban Reason
set ipbl(ban_reason) "-= IPBL =- Your ip %ip% was listed on (%source%) as blacklisted."

###
#Default ban type
#1 - *!*@$host
#2 - *!$ident@$host
#3 - $user!$ident@$host
#4 - $user!*@*
#5 - *!$ident@*
set ipbl(ban_type) "1"

###
#Default backchan announce ("" for disable)
set ipbl(backchan) ""

###
# FLOOD PROTECTION
#Set the number of minute(s) to ignore flooders, 0 to disable flood protection
###
set ipbl(ignore_prot) "1"

###
# FLOOD PROTECTION
#Set the number of requests within specifide number of seconds to trigger flood protection.
# By default, 3:10, which allows for upto 3 queries in 10 seconds. 3 or more quries in 10 seconds would cuase
# the forth and later queries to be ignored for the amount of time specifide above.
###
set ipbl(flood_prot) "3:5"

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

package require http

###
# Bindings
# - using commands
###
bind join - * ipbl:join
bind pub $ipbl(flags) $ipbl(char)ipbl ipbl:cmd

setudef flag ipbl
setudef str ipbl-backchan

###
proc ipbl:cmd {nick host hand chan arg} {
  global ipbl
  set flood_protect [ipbl:flood:prot $chan $host]
if {$flood_protect == "1"} {
    return
}
  set who [lindex [split $arg] 0]
if {$who == ""} {
  putserv "NOTICE $nick :Error: Use $ipbl(char)ipbl <nick>/<ip>/<host>"
  return
}
  if {![regexp {:|\.} $who]} {
  	putserv "USERHOST :$who"
  	set ::ipblchan $chan
  	set ::ipbl_search $who
  	set ::ipbl_check ""
    set ::ipbl_from $nick
  	bind RAW - 302 ipbl:for:nick
  	return
  }
  set except_host [ipbl:except_mask $who]
if {$except_host == 1} {
  putserv "NOTICE $nick :Error: $who is an excepted mask."
  return
}
  set hostname [ipbl:valid_ip $who]
if {$hostname == 0} {
  putserv "NOTICE $nick :Error: can't get dns for $hostname."
  return
}
set check_blacklisted [ipbl:check $hostname]
if {$check_blacklisted == 0} {
    putserv "PRIVMSG $chan :-= IPBL =- \002IP\002: $hostname ; \002Status\002: OK"
} else {
set source1 [lindex $check_blacklisted 0]
set status1 [lindex $check_blacklisted 1]
set source2 [lindex $check_blacklisted 2]
set status2 [lindex $check_blacklisted 3]
  putserv "PRIVMSG $chan :-= IPBL =- \002IP\002: $hostname ; \002Status\002: $source1 \[$status1\], $source2 \[$status2\]"
  }
}

###
proc ipbl:except_mask {hostname} {
  global ipbl
  set except_host 0
  foreach h $ipbl(except_hostmasks) {
  if {[string match -nocase $h $hostname]} {
    set except_host 1
    break
    }
  }
  return $except_host
}

###
proc ipbl:valid_ip {hostname} {
  global ipbl
  set check_ipv4 [regexp {^[0-9]{1,3}.[0-9]{1,3}.[0-9]{1,3}.[0-9]{1,3}$} $hostname]
  set check_ipv6 [regexp {^([0-9A-Fa-f]{0,4}:){2,7}([0-9A-Fa-f]{1,4}$|((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)(\.|$)){4})$} $hostname]
if {$check_ipv4 == "0" && $check_ipv6 == "0"} {
  set dns_hostname [ipbl:getdns $hostname]
if {[lindex $dns_hostname 0] != ""} {
  set hostname [lindex $dns_hostname 0]
    } elseif {[lindex $dns_hostname 1] != ""} {
  set hostname [lindex $dns_hostname 1]
  } else {
    return 0
    }
  }
  return $hostname
}

###
proc ipbl:for:nick { from keyword arguments } {
	global ipbl
	set ip $::ipbl_search
	set chan $::ipblchan
	set check $::ipbl_check
  set from $::ipbl_from
	set hosts [lindex [split $arguments] 1]
	set hostname [lindex [split $hosts "="] 1]
	regsub {^[-+]} $hostname "" mask
	set nickname [lindex [split $hosts "="] 0]
	regsub {^:} $nickname "" nick
if {$nick == ""} {
  putserv "NOTICE $from :Error: $ip is not online"
  unbind RAW - 302 ipbl:for:nick
  unset ::ipbl_check
  unset ::ipblchan
  unset ::ipbl_search
  unset ::ipbl_from
	return
}
  set hostname [lindex [split $mask @] 1]
  set except_host [ipbl:except_mask $hostname]
if {$except_host == 1} {
  putserv "NOTICE $from :Error: $hostname is an excepted mask."
  unbind RAW - 302 ipbl:for:nick
  unset ::ipbl_check
  unset ::ipblchan
  unset ::ipbl_search
  unset ::ipbl_from
  return
}
  set hostname [ipbl:valid_ip $hostname]
if {$hostname == 0} {
  putserv "NOTICE $from :Error: can't get dns for $hostname."
  unbind RAW - 302 ipbl:for:nick
  unset ::ipbl_check
  unset ::ipblchan
  unset ::ipbl_search
  unset ::ipbl_from
  return
}
set check_blacklisted [ipbl:check $hostname]
if {$check_blacklisted == 0} {
    putserv "PRIVMSG $chan :-= IPBL =- \002Nick\002: $nick ; \002IP\002: $hostname ; \002Status\002: OK"
} else {
set source1 [lindex $check_blacklisted 0]
set status1 [lindex $check_blacklisted 1]
set source2 [lindex $check_blacklisted 2]
set status2 [lindex $check_blacklisted 3]
  putserv "PRIVMSG $chan :-= IPBL =- \002Nick\002: $nick ; \002IP\002: $hostname ; \002Status\002: $source1 \[$status1\], $source2 \[$status2\]"
  }
  unbind RAW - 302 ipbl:for:nick
  unset ::ipbl_check
  unset ::ipblchan
  unset ::ipbl_search
  unset ::ipbl_from
}

###
proc ipbl:join {nick host hand chan} {
  global ipbl
if {![channel get $chan ipbl]} {return 0}
  regexp {(.+)@(.+)} $host string nickname hostname
  set except_host [ipbl:except_mask $hostname]
if {$except_host == 1} {return}
  set hostname [ipbl:valid_ip $hostname]
if {$hostname == 0} {return}
  set check_blacklisted [ipbl:check $hostname]
if {$check_blacklisted == 0} {return}
set source1 [lindex $check_blacklisted 0]
set status1 [lindex $check_blacklisted 1]
set source2 [lindex $check_blacklisted 2]
set status2 [lindex $check_blacklisted 3]
if {$status1 == "LISTED"} {
  set main_source $source1
  } elseif {$status2 == "LISTED"} {
  set main_source $source2
  }
  set replace(%ip%) $hostname
  set replace(%source%) $main_source
  set reason [string map [array get replace] $ipbl(ban_reason)]
  set bhostname [ipbl:host_return $ipbl(ban_type) $nick [getchanhost $nick $chan]]
if {[botisop $chan]} {
  newchanban $chan $bhostname $reason $ipbl(bantime)
  }
  set backchan [channel get $chan ipbl-backchan]
if {$backchan == ""} {
if {$ipbl(backchan) == ""} {return}
  putserv "PRIVMSG $ipbl(backchan) :-= IPBL =- ($nick!$host) $hostname is detected as blacklisted in $chan ($source1 \[$status1\], $source2 \[$status2\])"
  } else {
if {[validchan $backchan]} {
  putserv "PRIVMSG $backchan :-= ($nick!$host) =- $hostname is detected as blacklisted in $chan ($source1 \[$status1\], $source2 \[$status2\])"
    }
  }
}

###
proc ipbl:check {ip} {
  global ipbl
  set data [ipbl:data $ip]
regexp {dnsbl\.dronebl\.org \[(.*?)\]} $data -> status1
regexp {cbl\.abuseat\.org \[(.*?)\]} $data -> status2
if {[string equal -nocase $status1 "LISTED"] || [string equal -nocase $status2 "LISTED"]} {
  return [list "dnsbl.dronebl.org" $status1 "cbl.abuseat.org" $status2]
} else {
  return 0
    }
}

###
proc ipbl:getdns {ip} {
	global ipbl
	set ipv4 ""
	set ipv6 ""
	set gethost [catch {exec host $ip 2>/dev/null} results]
	set res [lrange [split $results] 0 end]
	set inc 0
	set llength [llength $res]
for {set i 0} { $i <= $llength} { incr i } {
	set word [lindex $res $i]
if {[string match -nocase "IPv6" $word]} {
	lappend ipv6 [join [lindex $res [expr $i + 2]]]
	}
if {[string match -nocase "*address*" $word] && ![string match -nocase "IPv6" [lindex $res [expr $i - 1]]]} {
	lappend ipv4 [join [lindex $res [expr $i + 1]]]
	}
}
if {$ipv4 == "" && $ipv6 == ""} {
	return 0
	}
	return [list $ipv4 $ipv6]
}

set ipbl(projectName) "IpBL.tcl"
set ipbl(author) "BLaCkShaDoW"
set ipbl(website) "wWw.TCLScriptS.NeT"
set ipbl(version) "v1.2"

###
proc ipbl:data {ip} {
  global ipbl
  set link "http://dnsbl.tclscripts.net/index.php?ip=$ip"
  set ipq [http::config -useragent "lynx"]
  set error [catch {set ipq [http::geturl $link -timeout 10000]} eror]
  set status [http::status $ipq]
if {$status != "ok"} { return 0}
  set getipq [http::data $ipq]
  ::http::cleanup $ipq
  return $getipq
}

###
proc ipbl:host_return {type user host} {
	global words
	set ident [lindex [split $host "@"] 0]
	set uhost [lindex [split $host @] 1]
	switch $type {
1 {
	return "*!*@$uhost"
}
2 {
	return "*!$ident@$uhost"
}
3 {
	return "$user!$ident@$uhost"
}
4 {
	return "$user!*@*"
}
5 {
	return "*!$ident@*"
		}
	}
}

###
proc ipbl:flood:prot {chan host} {
	global ipbl
	set number [scan $ipbl(flood_prot) %\[^:\]]
	set timer [scan $ipbl(flood_prot) %*\[^:\]:%s]
if {[info exists ipbl(flood:$host:$chan:act)]} {
	return 1
}
foreach tmr [utimers] {
if {[string match "*ipbl:remove:flood $host $chan*" [join [lindex $tmr 1]]]} {
	killutimer [lindex $tmr 2]
	}
}
if {![info exists ipbl(flood:$host:$chan)]} {
	set ipbl(flood:$host:$chan) 0
}
	incr ipbl(flood:$host:$chan)
	utimer $timer [list ipbl:remove:flood $host $chan]
if {$ipbl(flood:$host:$chan) > $number} {
	set ipbl(flood:$host:$chan:act) 1
	utimer [expr $ipbl(ignore_prot) * 60] [list ipbl:expire:flood $host $chan]
	return 1
	} else {
	return 0
	}
}


###
proc ipbl:remove:flood {host chan} {
	global ipbl
if {[info exists ipbl(flood:$host:$chan)]} {
	unset ipbl(flood:$host:$chan)
	}
}

###
proc ipbl:expire:flood {host chan} {
	global ipbl
if {[info exists ipbl(flood:$host:$chan:act)]} {
	unset ipbl(flood:$host:$chan:act)
	}
}

putlog "\002$ipbl(projectName) $ipbl(version)\002 coded by $ipbl(author) ($ipbl(website)): Loaded."

##############
##########################################################
##   END                                                 #
##########################################################