#by wiebe @ QuakeNet
#requires dnsdb.tcl

#supports CIDR bans
#supports IP bans (when user is resolved, but the IP is banned)
#supports RDNS bans (when user is unresolved, but the resolved hostname is banned)



#join
bind join -|- * dnsdb-bans:join
bind rejn -|- * dnsdb-bans:join

proc dnsdb-bans:join { nick uhost handle chan } {
  if { [isbotnick $nick] } { return 0 }
  if { ![validchan $chan] } { return 0 }
  if { ![botisop $chan] && ![botishalfop $chan] } { return 0 }
  dnsdb-bans:checkban $nick $chan
}



#check ban
proc dnsdb-bans:checkban { nick chan } {
  if { ![validchan $chan] } { return 0 }
  if { ![onchan $nick] || [onchansplit $nick] } { return 0 }
  set user [lindex [split [getchanhost $nick] @] 0]
  set host [dnsdb:host $nick]
  if { [string equal $host -1] } { set host "" }
  set hostr [lindex [split [getchanhost $nick] @] 1]
  set ip [dnsdb:ip $nick]
  if { [string equal $ip -1] } { set ip "" }
  if { [regexp {^(?:(?:2(?:[0-4]\d?|5[0-5])|[01]?\d{1,2})(?:\.|$)){4}$} $hostr] } {
    if { [string equal $ip ""] } { set ip $hostr }
  }
  set maskh $nick!$user@$host
  set maski $nick!$user@$ip
  set maskr $nick![getchanhost $nick]

#check global bans
  foreach banlist [banlist] {
    set banmask [lindex $banlist 0]
    set banmask2 $banmask
    regsub -all {\[} $banmask2 {\\[} banmask2
    regsub -all {\]} $banmask2 {\\]} banmask2
    regsub -all {\\} $banmask2 {\\\\} banmask2

    set reason [lindex $banlist 1]
    set expire [lindex $banlist 2]

#resolved host matches this ban
    if { ![string equal $host ""] && ![string equal -nocase $host $hostr] && [string match -nocase $banmask2 $maskh] } {
      set ban *![getchanhost $nick]
      pushmode $chan +b $banmask
      pushmode $chan +b $ban
      return 1

#resolved IP matches this ban
    } elseif { ![string equal $ip ""] && ![string equal -nocase $ip $hostr] && [string match -nocase $banmask2 $maski] } {
      pushmode $chan +b $banmask
      return 1

#user is unresolved and matches cidr ban
    } elseif { [string equal [dnsdb-bans:matchcidr $maskr $banmask] $banmask] } {
      pushmode $chan +b $banmask
      return 1

#matches a CIDR ban on resolved ip
    } elseif { ![string equal $ip ""] && [string equal [dnsdb-bans:matchcidr $maski $banmask] $banmask] } {
      pushmode $chan +b $banmask
      return 1
    }
  }

#check channel bans
  foreach banlist [banlist $chan] {
    set banmask [lindex $banlist 0]
    set banmask2 $banmask
    regsub -all {\[} $banmask2 {\\[} banmask2
    regsub -all {\]} $banmask2 {\\]} banmask2
    regsub -all {\\} $banmask2 {\\\\} banmask2

    set reason [lindex $banlist 1]
    set expire [lindex $banlist 2]

#resolved host matches this ban
    if { ![string equal $host ""] && ![string equal -nocase $host $hostr] && [string match -nocase $banmask2 $maskh] } {
      set ban *![getchanhost $nick]
      pushmode $chan +b $banmask
      pushmode $chan +b $ban
      return 1

#resolved IP matches this ban
    } elseif { ![string equal $ip ""] && ![string equal -nocase $ip $hostr] && [string match -nocase $banmask2 $maski] } {
      pushmode $chan +b $banmask
      return 1


#user is unresolved and matches cidr ban
    } elseif { [string equal [dnsdb-bans:matchcidr $maskr $banmask] $banmask] } {
      pushmode $chan +b $banmask
      return 1

#matches a CIDR ban on resolved ip
    } elseif { ![string equal $ip ""] && [string equal [dnsdb-bans:matchcidr $maski $banmask] $banmask] } {
      pushmode $chan +b $banmask
      return 1
    }
  }
  return 0
}



#checkreason, check if a such ban exists and return "1 [reason]", else -1
proc dnsdb-bans:checkreason { nick chan bannedmask } {
  if { ![validchan $chan] } { return 0 }
  if { ![onchan $nick] || [onchansplit $nick] } { return 0 }
  set user [lindex [split [getchanhost $nick] @] 0]
  set host [dnsdb:host $nick]
  if { [string equal $host -1] } { set host "" }
  set hostr [lindex [split [getchanhost $nick] @] 1]
  set ip [dnsdb:ip $nick]
  if { [string equal $ip -1] } { set ip "" }
  set maskh $nick!$user@$host
  set maski $nick!$user@$ip
  set maskr $nick![getchanhost $nick]

#check global bans
  foreach banlist [banlist] {
    set banmask [lindex $banlist 0]
    if { [string equal -nocase $bannedmask $banmask] } {
      set banmask2 $banmask
      regsub -all {\[} $banmask2 {\\[} banmask2
      regsub -all {\]} $banmask2 {\\]} banmask2
      regsub -all {\\} $banmask2 {\\\\} banmask2
      set reason [lindex $banlist 1]
      if { [string match @* $reason] } { set reason "You are banned" }

#resolved host matches this ban
      if { ![string equal $host ""] && ![string equal -nocase $host $hostr] && [string match -nocase $banmask2 $maskh] } {
        return "1 $reason"

#resolved IP matches this ban
      } elseif { ![string equal $ip ""] && ![string equal -nocase $ip $hostr] && [string match -nocase $banmask2 $maski] } {
        return "1 $reason"

#user is unresolved and matches cidr ban
      } elseif { [string equal [dnsdb-bans:matchcidr $maskr $banmask] $banmask] } {
        return "1 $reason"

#matches a CIDR ban on resolved ip
      } elseif { ![string equal $ip ""] && [string equal [dnsdb-bans:matchcidr $maski $banmask] $banmask] } {
        return "1 $reason"
      }
    }
  }

#check channel bans
  foreach banlist [banlist $chan] {
    set banmask [lindex $banlist 0]
    if { [string equal -nocase $bannedmask $banmask] } {
      set banmask2 $banmask
      regsub -all {\[} $banmask2 {\\[} banmask2
      regsub -all {\]} $banmask2 {\\]} banmask2
      regsub -all {\\} $banmask2 {\\\\} banmask2

      set reason [lindex $banlist 1]
      if { [string match @* $reason] } { set reason "You are banned" }

#resolved host matches this ban
      if { ![string equal $host ""] && ![string equal -nocase $host $hostr] && [string match -nocase $banmask2 $maskh] } {
        return "1 $reason"

#resolved IP matches this ban
      } elseif { ![string equal $ip ""] && ![string equal -nocase $ip $hostr] && [string match -nocase $banmask2 $maski] } {
        return "1 $reason"

#user is unresolved and matches cidr ban
      } elseif { [string equal [dnsdb-bans:matchcidr $maskr $banmask] $banmask] } {
        return "1 $reason"

#matches a CIDR ban on resolved ip
      } elseif { ![string equal $ip ""] && [string equal [dnsdb-bans:matchcidr $maski $banmask] $banmask] } {
        return "1 $reason"
      }
    }
  }
  return -1
}



#longip
proc dnsdb-bans:longip { ip } {
  if { ![regexp {^(?:(?:2(?:[0-4]\d?|5[0-5])|[01]?\d{1,2})(?:\.|$)){4}$} $ip] } { return }
  set ip1 [lindex [split $ip .] 0]
  set ip2 [lindex [split $ip .] 1]
  set ip3 [lindex [split $ip .] 2]
  set ip4 [lindex [split $ip .] 3]
  set longip [lindex [split [expr "$ip1. *256*256*256 + $ip2. *256*256 + $ip3. *256 + $ip4"] .] 0]
  return $longip
}



#matchcidr, returns 1 for a match
proc dnsdb-bans:matchcidr { fulladdress banmask } {
  set nick [lindex [split $fulladdress !] 0]
  set user [lindex [split $fulladdress !] 1]
  set user [lindex [split $user @] 0]
  set host [lindex [split $fulladdress @] 1]

#host is not an IP
  if { ![regexp {^(?:(?:2(?:[0-4]\d?|5[0-5])|[01]?\d{1,2})(?:\.|$)){4}$} $host] } { return 0 }

#not matching i.i.i.i/cidr format
  if { ![string match *?!*?@*?/*? $banmask] } { return 0 }

  set bmask [split $banmask !@/]
  set bn [lindex $bmask 0]
  set bu [lindex $bmask 1]
  set bh [lindex $bmask 2]
  set bc [lindex $bmask 3]

#host is not an IP
  if { ![regexp {^(?:(?:2(?:[0-4]\d?|5[0-5])|[01]?\d{1,2})(?:\.|$)){4}$} $bh] } { return 0 }

#invalid CIDR number
  if { $bc < "0" || $bc > "32" } { return 0 }

  set ulongip [dnsdb-bans:longip $host]
#lsort to make /31 and /32 valid
  set firstip [lsort [dnsdb-bans:cidr $bh $bc]]
  set lastip [lindex [split $firstip] 1]
  set firstip [lindex [split $firstip] 0]
  set firstip [dnsdb-bans:longip $firstip]
  set lastip [dnsdb-bans:longip $lastip]

#out of range
  if { $ulongip < $firstip || $ulongip > $lastip } { return 0 }

  regsub -all {\[} $bn {\\[} bn
  regsub -all {\]} $bn {\\]} bn
  regsub -all {\\} $bn {\\\\} bn
#nick part of ban doesnt match
  if { ![string match -nocase $bn $nick] } { return 0 }

  regsub -all {\[} $bu {\\[} bu
  regsub -all {\]} $bu {\\]} bu
  regsub -all {\\} $bu {\\\\} bu
#user part of ban doesnt match
  if { ![string match -nocase $bu $user] } { return 0}

#we got a match..
  return $banmask
}



#mode
bind mode -|- "% +o" dnsdb-bans:mode
bind mode -|- "% +b" dnsdb-bans:mode

proc dnsdb-bans:mode { nick uhost handle chan mode target } {
  if { ![validchan $chan] } { return 0 }
  if { [string equal $mode +o] && [isbotnick $target] } {

#check all users
    foreach n [chanlist $chan] {
      if { [onchan $n $chan] && ![onchansplit $n $chan] && ![isbotnick $n] } {
        if { ![matchattr [nick2hand $n] lomn|lomn $chan] || ![channel get $chan dontkickops] } {
          dnsdb-bans:checkban $n $chan
        }
      }
    }

#enforce ban
  } elseif { [string equal $mode +b] && ([isban $target $chan] || [channel get $chan enforcebans]) && ([botisop $chan] || [botishalfop $chan]) } {
    foreach n [chanlist $chan] {
      if { [onchan $n $chan] && ![onchansplit $n $chan] && ![isbotnick $n] } {
        if { ![matchattr [nick2hand $n] lomn|lomn $chan] || ![channel get $chan dontkickops] } {
#matches internal ban
          set r [dnsdb-bans:checkreason $n $chan $target]
          if { ![string equal $r -1] } {
            putkick $chan $n [join [lrange [split $r] 1 end]]
#else
          } else {
            set user [lindex [split [getchanhost $n] @] 0]
            set host [dnsdb:host $n]
            if { [string equal $host -1] } { set host "" }
            set hostr [lindex [split [getchanhost $n] @] 1]
            set ip [dnsdb:ip $n]
            if { [string equal $ip -1] } { set ip "" }
            set maskh $n!$user@$host
            set maski $n!$user@$ip
            set maskr $n![getchanhost $nick]

            set banmask $target
            set banmask2 $banmask
            regsub -all {\[} $banmask2 {\\[} banmask2
            regsub -all {\]} $banmask2 {\\]} banmask2
            regsub -all {\\} $banmask2 {\\\\} banmask2

#resolved host matches this ban
            if { ![string equal $host ""] && ![string equal -nocase $host $hostr] && [string match -nocase $banmask2 $maskh] } {
              pushmode $chan +b *![getchanhost $n]
#resolved IP matches this ban
            } elseif { ![string equal $ip ""] && ![string equal -nocase $ip $hostr] && [string match -nocase $banmask2 $maski] } {
              putkick $chan $n Banned
#user is unresolved and matches cidr ban
            } elseif { [string equal [dnsdb-bans:matchcidr $maskr $banmask] $banmask] } {
              putkick $chan $n Banned
#matches a CIDR ban on resolved ip
            } elseif { ![string equal $ip ""] && [string equal [dnsdb-bans:matchcidr $maski $banmask] $banmask] } {
              putkick $chan $n Banned
            }
          }
        }
      }
    }
  }
}



#time
bind time - "* * * * *" dnsdb-bans:time

proc dnsdb-bans:time { mi ho da mo ye } {
  foreach c [channels] {
    if { [botisop $c] || [botishalfop $c] } {
      foreach n [chanlist $c] {
        if { [onchan $n $c] && ![onchansplit $n $c] && ![isbotnick $n] } {
          if { ![matchattr [nick2hand $n] lomn|lomn $c] || ![channel get $c dontkickops] } {
            dnsdb-bans:checkban $n $c
#also loop the channel bans (not internal)?
          }
        }
      }
      foreach ban [chanbans $c] {
        set ban [lindex $ban 0]
        dnsdb-bans:mode nick uhost handle $c +b $ban
      }
    }
  }
}



# not by me

#http://wiki.tcl.tk/8909
#!/bin/sh
# Emacs: please open this file in -*-Tcl-*- mode
#
# Author: Mark Oakden http://wiki.tcl.tk/MNO
# Version: 1.1
#
# Note: this is almost certainly riddled with byte order
# and 32-bit assumptions.
#
# Changes since 1.0:-
#  changed usage of regsub to accomodate earlier tcl/tk versions than 8.4.1
#  changed layout to accomodate PocketPC better
#
# the next but one line restarts with tclsh...
# DO NOT REMOVE THIS BACKSLASH -> \
#    exec tclsh "$0" ${1+"$@"}
#
#package require Tk
#
#
# IPtoHex assumes IP has already been validated
proc dnsdb-bans:iptoHex { IP } {
    binary scan [binary format c4 [split $IP .]] H8 Hex
    return $Hex
}
proc dnsdb-bans:hexToIP { Hex } {
    binary scan [binary format H8 $Hex] c4 IPtmp
    foreach num $IPtmp {
	# binary scan "c" format gives signed int - the following
	# [expr]-ology converts to unsigned (from [binary] manpage)
	lappend IP [expr ($num + 0x100) % 0x100]
    }
    set IP [join $IP .]
    return $IP
}
proc dnsdb-bans:CIDRtoHexNetmask { CIDR } {
    set zeros [expr 32 - $CIDR]
    set ones $CIDR
    set binaryCIDR [string repeat 1 $ones]
    append binaryCIDR [string repeat 0 $zeros]
    binary scan [binary format B32 $binaryCIDR] H8 HexNetmask
    return $HexNetmask
}
proc dnsdb-bans:ipisValid { IP } {
    # must contain only dots and digits
    # this originally read:-
    #if { [regsub -all {[.0-9]} $IP {}] != "" } {
    #	return 0
    #}
    regsub -all {[.0-9]} $IP {} tmpStr
    if { $tmpStr != "" } {
	return 0
    }
    # however this appears to be a 8.4.1-ism which doesn't work with
    # earlier versions (e.g. the 8.4a2 version that the PocketPC tcltk
    # version is based on.
    #
    # exactly three dots
    regsub -all {[0-9]} $IP {} tmpStr
    if { $tmpStr != "..." } {
	return 0
    }
    # each numerical component is between 0 and 255
    foreach b [split $IP .] {
	if { [string length $b] == 0 } {
	    return 0
	}
	set ob $b
	scan $b %d b ;# allow for leading zeros which tcl thinks are octal
	if { $b < 0 | $b > 255 } {
	    return 0
	}
    }
    return 1
}
proc dnsdb-bans:CIDRisValid { CIDR } {
    if { [string length $CIDR] == 0 } {
	return 0
    }
    regsub -all {[0-9]} $CIDR {} tmpStr
    if { [string length $tmpStr] != 0 } {
	return 0
    }
    scan $CIDR %d $CIDR
    # 4 is arbitrary restriction on my part, but no-one uses CIDR to
    # amalgamate multiple class A addresses! CIDR of 31 and 32 are
    # non-useful also (/31 would leave just two IP addresses in the
    # subnet, one of which would be the network address, the other
    # the broadcast address - i.e. no usable IPs)
    if { $CIDR < 0 | $CIDR > 32 } {
 	return 0
    }
    return 1
}
 # IP and netmask in Hex, returns hex
proc dnsdb-bans:networkAddress { hexIP hexNetmask } {
    set compNetmask [expr 0x$hexNetmask ^ 0xffffffff]
    set tmpNetAddr [expr ( 0x$hexIP | $compNetmask ) ^ $compNetmask]
    binary scan [binary format I $tmpNetAddr] H8 networkAddress
    return $networkAddress
}
# IP and netmask in Hex, returns hex
proc dnsdb-bans:broadcastAddress { hexIP hexNetmask } {
    set tmpBrdAddr [expr 0x$hexIP | ( 0x$hexNetmask ^ 0xffffffff )]
    binary scan [binary format I $tmpBrdAddr] H8 broadcastAddress
    return $broadcastAddress
}

proc dnsdb-bans:cidr { IP CIDR } {
  if { ! [dnsdb-bans:ipisValid $IP] } { error "IP is not valid" }
  if { ! [dnsdb-bans:CIDRisValid $CIDR] } { error "CIDR is not valid" }
  set hexIP [dnsdb-bans:iptoHex $IP]
  set hexNetmask [dnsdb-bans:CIDRtoHexNetmask $CIDR]
  set hexNetworkAddress [dnsdb-bans:networkAddress $hexIP $hexNetmask]
  set hexBroadcastAddress [dnsdb-bans:broadcastAddress $hexIP $hexNetmask]
  set networkAddress [dnsdb-bans:hexToIP $hexNetworkAddress]
  set broadcastAddress [dnsdb-bans:hexToIP $hexBroadcastAddress]
  return "$networkAddress $broadcastAddress"
}