####################################################
# by wiebe @ QuakeNet
#
# provides procs:
#   bannick:ban nick chan by reason duration, sets bans
#    nick = nick1,nick2,..,nickN
#    chan = chan1,chan2,..,chanN , or chan = global for global bans
#    duration = lifetime of bans in minutes
#
#   bannick:mask user@host, returns a mask to ban
#
# script attempts to adjust the ban to the type of host, dynamic IP, generic host, ident and account host
# a /WHO lookup is performed to get all info needed
#
# script can use: chase.tcl dnsdb.tcl isupport.tcl script.tcl whowas.tcl whox.tcl
# script *required* for: chanout.tcl out.tcl
# script can be used by: ban.tcl censor.tcl flood.tcl idle.tcl sethand.tcl spamscan.tcl
#
####################################################

# clone? flyby? hiddenbans? whox/xbans?

# ti300720a080-2547.bb.online.no
# h40n1fls302o260.telia.com
# ALille-152-1-46-147.w83-198.abo.wanadoo.fr

####################################################
# bannick:ban
####################################################
# n = nick1,nick2,.. , c = #chan1,chan2,.. or global for global bans
# b = by, r = reason, d = duration in minutes
proc bannick:ban { n c b r d } {
  if {$n == "" || $c == ""} { return 0 }
  if {$b == ""} { set b unknown }
  if {$r == ""} { set r Banned }
  if {$d == "" || ![string is digit $d]} { set d 240 }
  set o ""; set x ""
  foreach e [split $n ,] {
    set w 1; set h [nick2hand $e]
    foreach {e i} [bannick:ban2 $e] {
      if {[string match -nocase *.users.quakenet.org $i]} { set w 0 }
      lappend o $e $h $i
    }
    if {$w && [bannick:validnick $e]} { lappend x $e }
  }
# global ban
  if {[string equal -nocase $c global]} {
    if {[info procs newban:ban] != ""} { set p newban:ban } else { set p newban }
    foreach {e h i} $o {
      if {[isban $i]} { continue }
      if {[matchattr $h lomn] && ![matchattr $h kZ]} { continue }
      $p $i $b $r $d
    }
  }
# channel ban
  if {[info procs newchanban:ban] != ""} { set p newchanban:ban } else { set p newchanban }
  foreach z [split $c ,] {
    if {![validchan $z]} { continue }
    foreach {e h i} $o {
      if {[isban $i $z] && ![isban $i]} { continue }
      if {[isop $e $z] || [ishalfop $e $z]} { continue }
      if {[matchattr $h lomn|lomn $z] && ![matchattr $h kZ|k $z]} { continue }
      $p $z $i $b $r $d
    }
  }
# WHO
  if {[info procs isupport] == "" || [isupport WHOX] == "-1" } { return 0 }
  if {$x != ""} {
    global bannickdb; lappend t $c $b $r $d; set y 0
    foreach n $x {
      set n [bannick:lower $n]
      if {![info exists bannickdb($n)]} { set y 1; lappend bannickdb($n) 0 }
      lappend bannickdb($n) $t
    }
# send /WHO after .. seconds
    if {$y && ![string match "* bannick:timer timer*" [utimers]]} { utimer 30 [list bannick:timer]  }
  }
}


####################################################
# bannick:ban2
####################################################
proc bannick:ban2 { n } {
  set h ""; set i ""; set a ""; set o ""
  if {[string match \#* $n]} { lappend o $n *!*@[string range $n 1 end].users.quakenet.org; return $o }
# chase
  if {![bannick:onchan $n]} { if {[info procs chase] != "" && [set nc [chase $n]] != ""} { set n $nc; unset nc } }
# whowas
  if {![bannick:onchan $n]} {
    if {[info procs whowas:get] != ""} {
      set u [whowas:get $n uhost]; set h [whowas:get $n dnsdbh]; set i [whowas:get $n dnsdbi]
      set a [split [whowas:get $n whox]]; set a [string range [lindex $a [lsearch -glob $a "a=?*"]] 2 end]
    }
# get from dnsdb and whox
  } else {
    set u [getchanhost $n]
    if {[info procs dnsdb:get] != ""} { set h [dnsdb:get $n h]; set i [dnsdb:get $n i] }
    if {[info procs whox:get] != ""} { set a [whox:get $n a] }
  }
  set u [split $u @]; set v [lindex $u 1]; set u [lindex $u 0]; if {$a == 0} { set a "" }
  if {$a != ""} { lappend o $n *!*@$a.users.quakenet.org } elseif {[string match -nocase *.users.quakenet.org $v]} { lappend o $n *!*@$v }
  set b [bannick:ban3 $u $v $h $i]; if {$b != ""} { lappend o $n $b }
  return $o
}


####################################################
# bannick:ban3
####################################################
proc bannick:ban3 { u v h i } {
  if {[string match -nocase *.users.quakenet.org $v]} { set v $h } elseif {[string match -nocase *.quakenet.org $v]} { return *!$u@$v }
  if {$u == "~"} { set u * }; if {$h == ""} { set h $v }; if {$h == ""} { set h $i }; if {$h == ""} { return "" }
  if {[bannick:dyn $h]} {
    if {[string match ~* $u]} {
      set u *[string trimleft $u ~]
      if {[string length $u] == 10} { set u [string range $u 0 8]* }
    }
    if {$h == $v} { return *!$u@*.[join [lrange [split $v .] end-1 end] .] }
    return *!$u@[join [lrange [split $v .] 0 2] .].*
  }
  if {[bannick:gen $h]} { return *!*@$v }
  if {![string match ~* $u]} { return *!$u@$v }
  return *!*@$v
}


####################################################
# bannick:timer
####################################################
proc bannick:timer { } {
  if {$::botname == $::botnick} { return 0 }
  global bannickdb; set o ""
  foreach n [array names bannickdb] {
    if {[lindex $bannickdb($n) 0] != 0} { continue }
    set bannickdb($n) [lreplace $bannickdb($n) 0 0 1]
    if {[string length [join "$o $n" ,]] > 450} {
      putserv "WHO [join $o ,],736 n%tuhnfa,736"
      set o ""
    }
    lappend o $n
  }
  if {$o != ""} { putserv "WHO [join $o ,],736 n%tuhnfa,736" }
}


####################################################
# bannick:mask
####################################################
proc bannick:mask { uhost } {
  set b $uhost
  if {![string match *@* $b] && [onchan $b]} { set b [getchanhost $b] }
  set b [split $b @]; set u [lindex $b 0]; set v [lindex $b 1]; set h $v
# take care of .quakenet.org spoof hosts
  if {[string match -nocase *.users.quakenet.org $h]} { return *!*@$v }
  if {[string match -nocase *.quakenet.org $h]} { return *!$u@$v }
# visible host is an IP, attempt to get hostname
  if {[bannick:ip $v] && [info procs dnsdb:get] != ""} {
    set h [dnsdb:get $v h]
# empty or we got an IP back for an IP
    if {$h == "" || [bannick:ip $h]} { set h $v }
  }
  if {$u == "~"} { set u * }
  if {[bannick:dyn $h]} {
    if {[string match ~* $u]} {
      set u *[string trimleft $u ~]
      if {[string length $u] == 10} { set u [string range $u 0 8]* }
    }
# return *!*user*@*.isp.tld or *!*user*@a.b.c.*
    if {$h == $v} { return *!$u@*.[join [lrange [split $v .] end-1 end] .] }
    return *!$u@[join [lrange [split $v .] 0 2] .].*
  }
  if {[bannick:gen $h]} { return *!*@$v }
  if {![string match ~* $u]} { return *!$u@$v }
  return *!*@$v
}


####################################################
# banick:dyn
####################################################
proc bannick:dyn { h } {
  if {$h == ""} { return 0 }
  set h [split $h .]
  if {[llength $h] < 3} { return 0 }
  set h [join [lrange $h 0 end-2] .]
  lappend l dyn dhcp dial abo dip ppp
  foreach e $l { if {[string match -nocase *$e* $h]} { return 1 } }
  lappend p t-dialin.net wanadoo.fr wanadoo.nl ono.com bezeqint.com proxad.net rima-tde.net telia.com bezeqint.net net.il rr.com versanet.de arcor-ip.net aol.com cox.net comcast.net
  foreach e $p { if {[string match -nocase *.$e $h]} { return 1 } }
  if {[regexp -- {^[a-z][A-F0-9]{8}$} [lindex [split $h .] 0]]} { return 1 }
  return 0
}


####################################################
# bannick:gen
####################################################
proc bannick:gen { h } {
  if {$h == ""} { return 0 }
  if {[string match -nocase *.quakenet.org $h]} { return 0 }
  set h [split $h .]
  if {[llength $h] < 3} { return 0 }
  if {![regexp -- {[0-9]} [join [lrange $h 0 end-2] .]]} { return 0 }
  set h [join [lrange $h 0 end-2] .]
  lappend l isp dsl cable kabel cust static addr generic host range line user modem reverse client nat route
  foreach e $l { if {[string match -nocase *$e* $h]} { return 1 } }
  if {[bannick:ipinhost $h]} { return 1 }
  return 0
}


####################################################
# bannick:ipinhost
####################################################
proc bannick:ipinhost { h } {
  if {[bannick:ip $h]} { return 0 }
  set h [split $h .]
  if {[llength $h] < 1} { return 0 }
  set l [lsort -decreasin -dictionary [split [string tolower $h] abcdefghijklmnopqrstuvwxyz-.]]; set p 0
  foreach e $l {
    if {$e == ""} { continue }
    #if {$e > 255} { continue }
    incr p
  }
  if {$p > 3} { return 1 } else { return 0 }
}


####################################################
# bannick:ip
####################################################
proc bannick:ip { i } {
  if {[regexp -- {^(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$} $i]} { return 1 }
  return 0
}


####################################################
# bannick:onchan
####################################################
proc bannick:onchan { n } {
  if {![onchan $n]} { return 0 }
  foreach c [channels] { if {[onchan $n $c] && ![onchansplit $n $c]} { return 1 } }
  return 0
}


####################################################
# bannick:lower
####################################################
proc bannick:lower { t } {
  global rfc-compliant
  if {[info exists rfc-compliant] && [string equal ${rfc-compliant} "1"]} {
    set t [string map "\\{ \[ \\} \] ~ ^ \\\\ |" $t]
  }
  set t [string tolower $t]
  return $t
}


####################################################
# bannick:validnick
####################################################
proc bannick:validnick { n } {
  regsub -all {\*{2,}} $n * n; set l -1
  if {[info procs isupport] != ""} { set l [isupport nicklen] }
  if {$l == -1} { set l $::nicklen }
  if {[string length $n] > $l} { return 0 }
  set p ^(\[a-zA-Z\\^\\\[\\\]\\{\\}\\\\|`_\\?\\*\])(\[a-zA-Z0-9\\-\\^\\\[\\\]\\{\\}\\\\|`_\\?\\*\])*\$
  if {![regexp $p $n]} { return 0 }
  return 1
}


####################################################
# bannick:who
####################################################
bind raw -|- "354" bannick:who; bind raw -|- "315" bannick:who
proc bannick:who { s n t } {
#tuhnfa,736
  global bannickdb
  set t [lrange [split $t] 1 end]
  if {$n == 315} {
    set m [split [lindex $t 0] ,]; set q [lindex $m end]; set m [lrange $m 0 end-1]
    if {$q != 736} { return 0 }
    foreach n $m { if {[info exists bannickdb($n)]} { unset bannickdb($n) } }
  } elseif {$n == 354} {
    set q [lindex $t 0]; set u [lindex $t 1]; set h [lindex $t 2]
    set n [lindex $t 3]; set f [lindex $t 4]; set a [lindex $t 5]
    if {$q != 736} { return 0 }
    if {[info procs whowas:set] != ""} { whowas:set $n uhost $u@$h; whowas:set $n whox "f=$f a=$a" }
    if {[llength $t] != 6} { return 0 }
    set i [finduser $n!$u@$h]; if {![validuser $i] && $a != 0} { set i [finduser $n!$u@$a.users.quakenet.org] }
    set n [bannick:lower $n]
    if {![info exists bannickdb($n)]} { return 0 }
# is an oper
    if {[string match "*\\**" $f]} { unset bannickdb($n); return 0 }
# what to ban
    lappend o [bannick:mask $u@$h]
    if {$a != 0 && ![string equal -nocase $h "$a.users.quakenet.org"]} { lappend o *!*@$a.users.quakenet.org }
# loop the list
    foreach x [lrange $bannickdb($n) 1 end] {
# chans by reason duration
      set c [lindex $x 0]; set b [lindex $x 1]; set r [lindex $x 2]; set d [lindex $x 3]
# global ban
      if {[string equal -nocase $c global]} {
      if {![matchattr $i lomn] || [matchattr $i kZ]} { continue }
        if {[info procs newban:ban] != ""} { set p newban:ban } else { set p newban }
        foreach e $o { $p $e $b $r $d }
      } else {
# channel ban
        if {[info procs newchanban:ban] != ""} { set p newchanban:ban } else { set p newchanban }
        foreach z [split $c ,] {
          if {[matchattr $i lomn|lomn $z] && ![matchattr $i kZ|k $z]} { continue }
          foreach e $o { $p $c $e $b $r $d }
        }
      }
    }
    unset bannickdb($n)
  }
  return 0
}


####################################################
# bannick:evnt
####################################################
bind evnt -|- init-server bannick:evnt
proc bannick:evnt { t } { global bannickdb; if {[info exists bannickdb]} { unset bannickdb } }


####################################################
# info for script.tcl
####################################################
set ::scriptdb(bannick) {
  "provides mask conversion and ban procs for use by other scripts such as ban.tcl, censor.tcl, chanout.tcl, flood.tcl, out.tcl, spamscan.tcl, idle.tcl and sethand.tcl. script attempts to adjust the ban to the type of host, dynamic IP, generic host, working ident or not and account host. a /WHO lookup is performed to get all info needed when not already available from dnsdb.tcl, whox.tcl and whowas.tcl."
}