#---------------------------------------------------------------------
# enforcenicklen.tcl
# TCL script for IRC bot eggdrop
# 
# Enforces limit on nick length  by kicking non-compliant nicks 
# (maximum 5 kicks per 20 seconds).
# Exempted: users with one of the global/channel flags (n m o f).
#
# v0: 23-Mar-2002
# v1: 26-Mar-2002
# - trigger on join and nick change
# - trigger on +o for the bot
#---------------------------------------------------------------------

set maxnicklen 15

#---------------------------------------------------------------------
# requirements
#---------------------------------------------------------------------

package require eggdrop 1.6
package require Tcl 8.0

#---------------------------------------------------------------------
# bindings
#---------------------------------------------------------------------

bind join - * enforcenicklen:nickjoin
bind nick - * enforcenicklen:nickchange
bind mode - * enforcenicklen:nickgotop

proc enforcenicklen:nickjoin { nick uhost hand chan } {
   # return if nicklength is ok/user is exempted
   if { [enforcenicklen:isgoodnick $nick $chan] } { return }
   # return if a timed call to enforcenicklen exists...
   if { [enforcenicklen:timerexists] } { return }
   # ...otherwise kick the user
   set luser [lappend luser "$nick $chan"]
   enforcenicklen $luser
}

proc enforcenicklen:nickchange { nick uhost hand chan newnick } {
   enforcenicklen:nickjoin $newnick $uhost $hand $chan
}

proc enforcenicklen:nickgotop { nick uhost hand chan args } {
   global botnick
   # fix for eggdrop versions below and above 1.3.23
   set modechange [join $args]
   # modechange is a +o?
   if {[scan $modechange "+o %s" nickgotop] != 1} { return }
   # return if it wasn't the bot
   if {[string compare $nickgotop $botnick] != 0} { return }
   # bot got op, a timed call already exists?
   if { [enforcenicklen:timerexists] } { return }
   # directly call enforcenicklen
   enforcenicklen
}

#---------------------------------------------------------------------
# enforcenicklen
#---------------------------------------------------------------------

proc enforcenicklen { args } {

   # as a starter: purge all timers calling this proc
   foreach timer [utimers] {
      # assume it is a string and scan 3 variables
      set scancount [scan $timer {%d %s %s} secs name timerid]
      if { $scancount != 3 } { continue}
      if {[string compare $name enforcenicklen] != 0 } { continue }
      killutimer $timerid
   }

   # if no candidates were given to the proc: generate a list
   if {[string compare $args ""] == 0} {
      set candidates [enforcenicklen:candidates]
   } else {
      set candidates [lindex $args 0]
   }

   # kick candidates 
   set kickcount [enforcenicklen:kicklusers $candidates]

   # no kicks? return silently ...
   if { $kickcount == 0 } { return }
   # ... otherwise, check back
   utimer 20 enforcenicklen
}

#---------------------------------------------------------------------
# enforcenicklen:timerexists
# return 1 if a timed call to enforcenicklen does exist,
# else return 0
#---------------------------------------------------------------------

proc enforcenicklen:timerexists { args } {
   foreach timer [utimers] {
      # assume it is a string and scan 3 variables
       set scancount [scan $timer {%d %s %s} secs name timerid]
      if { $scancount != 3 } { continue}
      if {[string compare $name enforcenicklen] != 0 } { continue }
      return 1
   }
   return 0
}

#---------------------------------------------------------------------
# enforcenicklen:candidates 
# - return a list of non-compliant nicks if there are any.
# Each listelement contains 2 elements: chan and nick.
# - return 0 if all nicks comply.
#---------------------------------------------------------------------

proc enforcenicklen:candidates { args } {

   global botnick
   global maxnicklen 

   foreach chan [channels] {
      # sanity checks
      if { ![validchan $chan] } { continue }
      if { ![botisop $chan] } { continue }
      foreach nick [chanlist $chan] {
         # nick is botnick, nicklength is ok or nick has exempt flags?
         if { [enforcenicklen:isgoodnick $nick $chan] } { continue }
         # nicklength is too large... a candidate!
         set candidates [lappend candidates "$nick $chan"]
      }
   }
   # either return the list of candidates...
   if { [info exists candidates] } { return $candidates }
   # ... or return 0
   return 0
}

#---------------------------------------------------------------------
# enforcenicklen:isgoodnick
# - return 1 if nick is ok (user flags or nick length)
# - return 0 all other cases.
#---------------------------------------------------------------------

proc enforcenicklen:isgoodnick { nick chan } {

   global botnick
   global maxnicklen

   # check the nick length
   set nicklen [string length $nick]
   if {[string length $nick] <= $maxnicklen} { return 1 }

   # stop if nick is not on channel
   if {![onchan $nick $chan]} { return 1 }

   # botnick?
   if {[string compare $nick $botnick] == 0 } { return 1 }

   # retrieve handle and check flags...
   set hand [nick2hand $nick $chan]
   if { ![validuser $hand] } { return 0 }
   foreach flag "n m o f" {
      if {[matchattr $hand $flag]} { return 1 }
      if {[matchchanattr $hand $flag $chan]} { return 1 }
   }

   return 0

}

#---------------------------------------------------------------------
# enforcenicklen:kicklusers
# on input: "0" to indicate no candidates or a list of candidates.
# kicks a maximum of 5 nicks and returns number of kicks.
#---------------------------------------------------------------------

proc enforcenicklen:kicklusers { candidates } {

   global maxnicklen

   set kickcount 0

   if { $candidates == 0 } { return $kickcount }

   set countcandidates [llength $candidates]

   if { $countcandidates > 5 } {
      # randomly select 5 nicks 
      for { set i 0 } { $i < 5 } { incr i } {
         # randomly select a nick
         set randindx [rand $countcandidates]
         set randluser [lindex $candidates $randindx] 
         # append the selected nick to the lusers list
         set lusers [lappend lusers $randluser]
         # strip the nick from the candidates list
         set candidates [lreplace $candidates $randindx $randindx]
         # decrement the candidates count
         incr countcandidates -1
      }
   } else {
      # number of candidates is 5 or less
      set lusers $candidates
   }

   foreach nickchan $lusers {
      incr kickcount
      if { [scan $nickchan "%s %s" nick chan] != 2 } { continue }
      putserv "KICK $chan $nick :Shrink your nick to\
      $maxnicklen characters or less."
   }

   return $kickcount
}
      
#---------------------------------------------------------------------
# on start up and rehash
#---------------------------------------------------------------------

putlog "Enforcenicklen version 1 loaded (Max: $maxnicklen chars)"