#by wiebe @ QuakeNet
#requires whox.tcl
#requires dnsdb.tcl
#requires c_rule.tcl

set c_gban(defaultduration) "240"
set c_gban(defaultmask) "2"
set c_gban(maxdurationforops) "10080"
set c_gban(xhost) "users.quakenet.org"



#help gban pub

bind pubm mn "% ${botnet-nick} help gban" c_gban:help:pub

proc c_gban:help:pub { nick uhost handle chan text } {
  lappend output "Usage: gban <target> <reason>"
  lappend output "Usage: gban <target1> \[<target2> .. <targetN>\] \[%<XyXmXwXdXhXnXs>\] \[&<masktype>\] \[:\[@\]<reason>\]"
  lappend output "<target> can be a nick, a mask or #account which bans *!*@<account>.$::c_gban(xhost). When target is a nick, an attempt is made to ban the visible host, the *!*@<account>.$::c_gban(xhost) host (even when -x), and a dns-lookup is done to ban the resolved IP/hostname if needed."
  lappend output "Duration is specified with % parameter, where X are numbers, y=year m=month w=week d=day h=hour n=minute s=second (default [c_gban:ts $::c_gban(defaultduration)], lowest possible 5m). Only global masters and owners can set bans longer than [c_gban:ts $::c_gban(maxdurationforops)] and permbans. Masktype is specified with the & parameter, &2 would ban the user by *!*@host (default $::c_gban(defaultmask))."
  lappend output "Parameter <reason> can be custom reason or one predefined from the rule command. The : prefixing the reason is required. Prefix the reason itself with a @ to make it hidden, targets get kicked with reason 'You are banned'."
  if { [catch {set x [cnotice $nick $output]} error] || !$x } {
    foreach t $output { puthelp "NOTICE $nick :$t" }
  }
  putloglev c * "[lindex [split $text] 1]: $nick $uhost $handle $chan [join [lrange [split $text] 2 end]]"
}



#help gbanlist msg

bind msgm mn "help gban" c_gban:help:msg

proc c_gban:help:msg { nick uhost handle text } {
  lappend output "Usage: gban <target> <reason>"
  lappend output "Usage: gban <target1> \[<target2> .. <targetN>\] \[%<XyXmXwXdXhXnXs>\] \[&<masktype>\] \[:\[@\]<reason>\]"
  lappend output "<target> can be a nick, a mask or #account which bans *!*@<account>.$::c_gban(xhost). When target is a nick, an attempt is made to ban the visible host, the *!*@<account>.$::c_gban(xhost) host (even when -x), and a dns-lookup is done to ban the resolved IP/hostname if needed."
  lappend output "Duration is specified with % parameter, where X are numbers, y=year m=month w=week d=day h=hour n=minute s=second (default [c_gban:ts $::c_gban(defaultduration)], lowest possible 5m). Only global masters and owners can set bans longer than [c_gban:ts $::c_gban(maxdurationforops)] and permbans. Masktype is specified with the & parameter, &2 would ban the user by *!*@host (default $::c_gban(defaultmask))."
  lappend output "Parameter <reason> can be custom reason or one predefined from the rule command. The : prefixing the reason is required. Prefix the reason itself with a @ to make it hidden, targets get kicked with reason 'You are banned'."
  if { [catch {set x [cnotice $nick $output]} error] || !$x } {
    foreach t $output { puthelp "NOTICE $nick :$t" }
  }
  putcmdlog "($nick!$uhost) !$handle! $text"
}



#gban pub
bind pubm mn "% ${botnet-nick} gban" c_gban:pub
bind pubm mn "% ${botnet-nick} gban *" c_gban:pub

proc c_gban:pub { nick uhost handle chan text } {
  set targets [join [lrange [split $text] 2 end]]
  if { [string equal $targets ""] } {
    lappend output "Usage: gban <target> <reason>"
    lappend output "Usage: gban <target1> \[<target2> .. <targetN>\] \[%<XyXmXwXdXnXs>\] \[&<masktype>\] \[:<reason>\]"
  } else {
    set output [c_gban:gban $handle $nick $targets]
  }
  if { [catch {set x [cnotice $nick $output]} error] || !$x } {
    foreach t $output { puthelp "NOTICE $nick :$t" }
  }
  putloglev c * "[lindex [split $text] 1]: $nick $uhost $handle $chan [join [lrange [split $text] 2 end]]"
}



#gban msg
bind msg mn gban c_gban:msg

proc c_gban:msg { nick uhost handle text } {
  set targets $text
  if { [string equal $targets ""] } {
    lappend output "Usage: gban <target> <reason>"
    lappend output "Usage: gban <target1> \[<target2> .. <targetN>\] \[%<XyXmXwXdXnXs>\] \[&<masktype>\] \[:<reason>\]"
  } else {
    set output [c_gban:gban $handle $nick $targets]
  }
  if { [catch {set x [cnotice $nick $output]} error] || !$x } {
    foreach t $output { puthelp "NOTICE $nick :$t" }
  }
  return 1
}



#gban
proc c_gban:gban { handle nick targets  } {

#check reason
  set reason ""
  set p [lsearch -glob [split $targets] :*]
  if { ![string equal $p -1] } {
    set reason [string range [join [lrange [split $targets] $p end]] 1 end]
    set targets [join [lrange [split $targets] 0 [expr $p -1]]]
  } else {
    set reason [join [lrange [split $targets] 1 end]]
    set targets [lindex [split $targets] 0]
  }

#check duration
  set duration $::c_gban(defaultduration)
  set p [lsearch -glob [split $targets] \%*]
  if { ![string equal $p -1] } {
    set duration [string range [lindex [split $targets] $p] 1 end]
    set targets [lreplace [split $targets] $p $p]
    set duration [c_gban:duration $duration]
    if { [string equal $duration -1] } {
      set duration $::c_gban(defaultduration)
      lappend output "Error converting duration parameter, using default duration ([c_gban:ts $duration])."
    }

#nick is not mn
    if { ![matchattr $handle mn] } {
      if { [string equal $duration 0] || $duration > $::c_gban(maxdurationforops) } {
        set duration $::c_gban(maxdurationforops)
        lappend output "Need to be a global master or owner to use a duration that long, using max allowed duration ([c_gban:ts $duration])."
      }      
    } elseif { [string equal $duration 0] } {
      lappend output "Warning: you are setting perm gbans."
    } elseif { $duration > "10080" } {
      lappend output "Warning: you are adding gbans with excessive long duration."
    }
  }

#check masktype
  set masktype $::c_gban(defaultmask)
  set p [lsearch -glob [split $targets] \&*]
  if { ![string equal $p -1] } {
    set masktype [string range [lindex [split $targets] $p] 1 end]
    set targets [lreplace [split $targets] $p $p]

#take care of leading 0
    if { [string is digit $masktype] && [string equal [string length $masktype] 2] } {
      set masktype [expr $masktype]
    }
    set p [lsearch -exact "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19" $masktype]
    if { [string equal $p -1] } { set masktype $::c_gban(defaultmask) }
  }

#didnt find reason, last target not on any channel, assume last word is reason, adjust targets
  if { [string equal $reason ""] && ![onchan [lindex [split $targets] end]] } {

    if { ![string equal [c_rule:rule [lindex [split $targets] end]] 0] } {
      set reason [lindex [split $targets] end]
      set targets [join [lrange [split $targets] 0 end-1]]
    }
  }

#set reason
  set temp 0
  set hid 0
  if { [string match @* $reason] } {
    set hid 1
    set reason [string range $reason 1 end]
  }
  if { [catch {set temp [c_rule:rule $reason]} error] } {
    putlog "ERROR using c_rule.tcl, perhaps you have not loaded it?"
  }
  if { ![string equal $temp 0] } { set reason $temp }

#use default
  if { [string equal $reason ""] } {
    if { [catch {set reason [c_rule:rule \#0]} error] } {
      putlog "ERROR using c_rule.tcl, perhaps you have not loaded it?"
      set reason "You are violating channel rules."
    }    
  }
  if { [string equal $hid 1] } { set reason @$reason }

  set gbans ""
  foreach target [split $targets] {
    foreach gban [c_gban:getgban $target $masktype $nick $handle $duration $reason] {
      if { [string equal [lsearch $gbans $gban] -1] } { lappend gbans $gban }
    }
  }
  set widebans ""
  set banned ""
  foreach gban $gbans {
    if { [c_gban:sanity $gban] } {
      lappend widebans $gban
    } else {
      newban $gban $handle $reason $duration
      lappend banned $gban
    }
  }
  if { [string equal $banned$widebans ""] } {
    lappend output "Found nothing to ban."
  } else {
    if { ![string equal $widebans ""] } {
      lappend output "Mask too wide: [join $widebans]"
    }
    if { ![string equal $banned ""] } {
      if { [string equal $duration 0] } {
        set duration perm
      } else {
        set duration [c_gban:ts $duration]
      }
      lappend output "Global banned: [join $banned] (duration: $duration) (reason: $reason)"
    }
  }
  return $output
}



#get the gbans to set
proc c_gban:getgban { target masktype nick handle duration reason } {

  if { [string equal $target ""] } { return }
  if { [string equal $masktype ""] } { return }
  set gban ""

#chasenick
  if { ![onchan $target] } {
    if { [catch {set ct [chase:chasenick $target]} error] } {
      putlog "ERROR using chase.tcl, perhaps you have not loaded it?"
    }
    if { ![string equal $ct -1] && [onchan $ct] && ![onchansplit $ct] } { set target $ct }
  }


#chase uhost
  set ct -1
  if { [catch {set ct [chase:chaseuhost $target]} error] } {
    putlog "ERROR using chase.tcl, perhaps you have not loaded it?"
  }

  if { ![onchan $target] && ![string equal $ct -1] } {
    set nuh $target!$ct

#check dnsdb.tcl
      set dnsdbip ""
      if { [catch {set dnsdbip [dnsdbchase:ip $target]} error] } {
        putlog "ERROR using dnsdb.tcl, perhaps you have not loaded it?"
      }
      set dnsdbhost ""
      if { [catch {set dnsdbhost [dnsdbchase:host $target]} error] } {
        putlog "ERROR using dnsdb.tcl, perhaps you have not loaded it?"
      }

#target has account host
    if { [string match -nocase *!*@?*.$::c_gban(xhost) $nuh] } {
      lappend gban *!*@[lindex [split $nuh @] 1]

#get account
    } else {
      set account 0
      if { [catch {set account [whox:chase $target a]} error] } {
        putlog "ERROR using whox.tcl, perhaps you have not loaded it?"
      }
      if { ![string equal $account 0] && ![string equal $account ""] } {
#target is registered but -x
        lappend gban *!*@$account.$::c_gban(xhost)
      }
#ban the visible host
      lappend gban [c_gban:mask $nuh $masktype]

#dnsdb.tcl failed, perform dns look-up
      if { [string equal $dnsdbhost -1] && [string equal $dnsdbip -1] } {
        set host [lindex [split $nuh @] 1]
        dnslookup $host c_gban:dnscallback $nuh $masktype $nick $handle $duration $reason
      }
    }

#ban host and ip provided by dnsdb.tcl
    set nu [lindex [split $nuh @] 0]
    if { ![string equal $dnsdbhost -1] && ![string equal $dnsdbhost ""] } {
      lappend gban [c_gban:mask $nu@$dnsdbhost $masktype]
    }
    if { ![string equal $dnsdbip -1] && ![string equal $dnsdbip ""] } {
      lappend gban [c_gban:mask $nu@$dnsdbip $masktype]
    }


#nick
  } elseif { [onchan $target] } {
    set nuh $target![getchanhost $target]

#check dnsdb.tcl
      set dnsdbip ""
      if { [catch {set dnsdbip [dnsdb:ip $target]} error] } {
        putlog "ERROR using dnsdb.tcl, perhaps you have not loaded it?"
      }
      set dnsdbhost ""
      if { [catch {set dnsdbhost [dnsdb:host $target]} error] } {
        putlog "ERROR using dnsdb.tcl, perhaps you have not loaded it?"
      }

#target has account host
    if { [string match -nocase *!*@?*.$::c_gban(xhost) $nuh] } {
      lappend gban *!*@[lindex [split $nuh @] 1]

#get account
    } else {
      set account 0
      if { [catch {set account [whox $target a]} error] } {
        putlog "ERROR using whox.tcl, perhaps you have not loaded it?"
      }
      if { ![string equal $account 0] && ![string equal $account ""] } {
#target is registered but -x
        lappend gban *!*@$account.$::c_gban(xhost)
      }
#ban the visible host
      lappend gban [c_gban:mask $nuh $masktype]

#dnsdb.tcl failed, perform dns look-up
      if { [string equal $dnsdbhost -1] && [string equal $dnsdbip -1] } {
        set host [lindex [split $nuh @] 1]
        dnslookup $host c_gban:dnscallback $nuh $masktype $nick $handle $duration $reason
      }
    }

#ban host and ip provided by dnsdb.tcl
    set nu [lindex [split $nuh @] 0]
    if { ![string equal $dnsdbhost -1] && ![string equal $dnsdbhost ""] } {
      lappend gban [c_gban:mask $nu@$dnsdbhost $masktype]
    }
    if { ![string equal $dnsdbip -1] && ![string equal $dnsdbip ""] } {
      lappend gban [c_gban:mask $nu@$dnsdbip $masktype]
    }

#transform to correct masks
#user@host
  } elseif { [string match ?*@?* $target] && ![string match ?*!?*@?* $target] } {
    lappend gban *!$target

#host
  } elseif { [string match *.* $target] && ![string match ?*!?*@?* $target] } {
    lappend gban *!*@$target

#nick!user
  } elseif { [string match ?*!?* $target] && ![string match ?*!?*@?* $target] } {
    lappend gban $target@*

# #account
  } elseif { [string match \#?* $target] && ![string match ?*!?*@?* $target] } {
    lappend gban *!*@[string range $target 1 end].$::c_gban(xhost)

#nick
  } elseif { ![string match ?*!?*@?* $target] } {
    lappend gban $target!*@*
  } else {
    lappend gban $target
  }
  return $gban
}



#transforms XyXMXwXdXhXmXs to minutes
proc c_gban:duration { duration } {
  set d 0
  set e 0
  set duration [c_gban:tsr $duration]
  if { [string equal $duration 0] } { return $d }
  foreach part [split $duration] {
    if { [catch {incr d [expr [clock scan $part] - [unixtime]]} error] } { set e 1 }
  }
  if { $d < "300" && $d > "0" } { set d 5 } else { set d [expr $d / 60] }
  if { [string equal $d$e 01] } { set d -1 }
  return $d
}



#Xy Xn Xw Xd Xh Xm Xs returns Xyear Xmonth Xday Xhour Xminute Xseconds
proc c_gban:tsr { ts } {
  if { [string equal $ts ""] } { return }
  set ts [string tolower $ts]
  set ts [string map [list "s" "SECOND" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "m" "MONTH" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "n" "MINUTE" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "h" "HOUR" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "d" "DAY" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "w" "WEEK" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list "y" "YEAR" "search" "replace" "search" "replace"] $ts]
  return $ts
}



#give minutes, returns XyXwXhXmXs
proc c_gban:ts { ts } {
  if { ![string is digit $ts] } { return 0 }
  set ts [duration [expr $ts * 60]]
  set ts [string map [list " seconds" "s" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " second" "s" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " minutes" "m" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " minute" "m" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " hours" "h" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " hour" "h" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " days" "d" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " day" "d" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " weeks" "w" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " week" "w" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " years" "y" "search" "replace" "search" "replace"] $ts]
  set ts [string map [list " year" "y" "search" "replace" "search" "replace"] $ts]
  return [join [lrange [split $ts] 0 1]]
}



proc c_gban:mask { nuhost type } {
#this proc is taken from:
# Clone Detector v3.0.2
#  by MC_8 - Carl M. Gregory <mc8 at purehype dot net>
#
# made a few changes. dont use maskhost it doesnt return the same stuff as mirc
# removed max host limit. mirc doesnt care about the length, so we dont here as well.
# changed [mask <nick|nick!user@host> <type>]
# changed ident to user(name)
# max username length is 10 chars
  if { [onchan $nuhost] } { set nuhost $nuhost![getchanhost $nuhost] }
  set type [expr {($type == "")?5:$type}]
  if {![regexp -- {^(1?[0-9])$} $type]} { return $nuhost }

  # Define the maximum length the ircd allows for an username.  Standard is 9,
  # however I made it to a variable incase someone wants to change it up.
  set user_max-length 10

  if { ![regexp -- {^(.*[^!])!((.*)@(.*))$} $nuhost -> nick uhost user host] } { return $nuhost }
  set maskhost 1
  if { [string equal [string length $type] 2] } {
    # Type must be 10-19.
    if { [info tclversion] < "8.1" } {
      set re_syntax_1 {([12][0-9][0-9]|[1-9][0-9]|[1-9])}
      set re_syntax_2 {([12][0-9][0-9]|[1-9][0-9]|[0-9])}
    } else {
      set re_syntax_1 {([12]\d{2}|[1-9][0-9]|[1-9])}
      set re_syntax_2 {([12]\d{2}|[1-9][0-9]|[0-9])}
    }
    set re_syntax ^$re_syntax_1\\.$re_syntax_2\\.$re_syntax_2\\.$re_syntax_2\$
    if { ![regexp -- $re_syntax $host] } {
      regsub -all -- {[0-9]} $host ? host
      set maskhost 0
    }
    set type [string index $type 1]
  }
  if { [string match {[0-4]} $type] } { set nick * }
  if { [string match {[2479]} $type] } { set user *}
  if { [string match {[1368]} $type] } { regsub -- {^~?(.*)$} $user *\\1 user }
  if { [string match {[3489]} $type] && $maskhost } {
    if { [regexp {^(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])$} $host] } {
      set host [join [lrange [split $host .] 0 2] .].*
    } elseif { [string match *.*.* $host] } { set host *.[join [lrange [split $host .] 1 end] .] }
  }
  if { [set length [string length $user]] > ${user_max-length} } {
    set user *[string range $user [expr $length-${user_max-length}] end]
  }
  return $nick!$user@$host
}



#sanity check, return 1 if mask is too wide
proc c_gban:sanity { mask } {

  if { [string equal $mask ""] } { return 0 }
  if { ![string match *!*@* $mask] } { return 0 }

  set nick [lindex [split $mask !] 0]
  set user [lindex [split $mask !] 1]
  set host [lindex [split $mask @] 1]
  set user [lindex [split $user @] 0]

#remove all ?'s and .'s and check if ONLY ?* / *.* pairs were used
  set mask2 [string map [list "?" "" "search" "replace" "search" "replace"] $mask]
  set mask2 [string map [list "." "" "search" "replace" "search" "replace"] $mask2]
  regsub -all {\*+} $mask {*} mask

#disallow any type of *!*@* ban that in effect matches everyone
  if { [string equal -nocase $mask2 *!*@*] } { return 1 }

#disallow banning any form of *!~*@* and *!^*@* (^ is same as ~ rfc1459)
  if { [string equal -nocase $mask2 *!~*@*] } { return 1 }
  if { [string equal -nocase $mask2 *!^*@*] } { return 1 }

#disallow banning any form of *!*@*.<xhost>, banning everyone authed/registered
  if { [string equal -nocase $mask2 *!*@*.$::c_gban(xhost)] } { return 1 }

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

#disallow banning any form of *!*@*.tld
    set mask2 [string map [list "?" "" "search" "replace" "search" "replace"] $mask]
    if { [string match -nocase {[*]![*]@[*].??} $mask2] } { return 1 }
    if { [string match -nocase {[*]![*]@[*].???} $mask2] } { return 1 }
    if { [string match -nocase {[*]![*]@[*].????} $mask2] } { return 1 }
  }

#check number of chars other than !@*?
  set nicklen $nick
  set nicklen [string map [list "*" "" "search" "replace" "search" "replace"] $nicklen]
  set nicklen [string map [list "?" "" "search" "replace" "search" "replace"] $nicklen]
  set nicklen [string length $nicklen]

  set userlen $user
  set userlen [string map [list "*" "" "search" "replace" "search" "replace"] $userlen]
  set userlen [string map [list "?" "" "search" "replace" "search" "replace"] $userlen]
  set userlen [string length $userlen]

  set hostlen $host
  set hostlen [string map [list "*" "" "search" "replace" "search" "replace"] $hostlen]
  set hostlen [string map [list "?" "" "search" "replace" "search" "replace"] $hostlen]
  set hostlen [string length $hostlen]

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

#shortest possible mask with host n!u@hhh.hh
   if { $hostlen < "5" && $userlen < "1" && $nicklen < "1" } { return 1 }

#shortest possible mask with IP n!u@i.i.i.i
  } else {
   if { $hostlen < "4" && $userlen < "1" && $nicklen < "1" } { return 1 }
  }

#cidr?
  if { [string match ?*.?*.?*.?*/?* $host] } {
    set cidr [lindex [split $host /] 1]
    set host [lindex [split $host /] 0]
    if { $cidr > "32" } { return 0 }

#found cidr and host is an IP
    if { [regexp {^(?:(?:2(?:[0-4]\d?|5[0-5])|[01]?\d{1,2})(?:\.|$)){4}$} $host] } {
      if { $cidr < "23" && $userlen < "1" && $nicklen < "1" } { return 1 }
    }
  }
  return 0
}



#dnscallback
proc c_gban:dnscallback { ip host status nuh masktype nick handle duration reason } {
  if { !$status } { return }
  set oh [lindex [split $nuh @] 1]
  if { [string equal $oh $host] } { set nh $ip } else { set nh $host }
  set nuh [lindex [split $nuh @] 0]@$nh
  set ban [c_gban:mask $nuh $masktype]
  newban $ban $handle $reason $duration
  if { [string equal $duration 0] } {
    set duration perm
  } else {
    set duration [c_gban:ts $duration]
  }
  lappend output "Global banned (dns lookup): $ban (duration: $duration) (reason: $reason)"
  if { [catch {set x [cnotice $nick $output]} error] || !$x } {
    foreach t $output { puthelp "NOTICE $nick :$t" }
  }
}