# CETK clone/flood detection/removal script 0.9

unload cetk.clonecheck
package cetk.clonecheck

load functions
load cetk.functions
load cetk.chanmgmt

alias cka.help (count,...) {
echo =====
	switch ($count) {
		(1) {
echo /clonecheck [min-clones [max-bans [max-banned]]] [char-flags] chan-masks [switches]
echo
echo With no args, find and display all clones on all channels in which none are
echo opped or voiced or "me" or in our userlist.  This is the same as saying
echo "/eval clonecheck 1 0 0 w \$mychannels()".  Note that if _any_ of the
echo clones are "special", then _none_ of them will be acted upon.
		} (2) {
echo min-clones is optional and specifies the number of clones required
echo for action.  1 clone meaning 2 clients, 9 meaning 10, etc.
echo
echo max-bans and max-banned are also optional and specify the maximum number
echo of ban masks and banned users that will be performed in a single run.
echo This is useful as a safety feature.
		} (3) {
echo char-flags is a collection of single character "flags" meaning:
echo   * w - Display all clones.  Default without b, k, K or G.
echo   * W - Whois all clones.
echo   * B - kickban all clones.
echo   * i - Ignore all clones.  XXX
echo   * b - ban all clones.
echo   * k - kick all clones.
echo   * K - K-line all clones.
echo   * G - G-line all clones.
echo   * m - Don't filter out everyone with "my" address.
echo   * o - Don't filter out everyone with an opped address.
echo   * v - Don't filter out everyone with a voiced address.
echo   * u - Don't filter out everyone with a userlisted address.
echo   * f - Don't filter non-flooders out.
echo   * F - Filter everyone out if flood checking isn't available.
echo   * A - Drop all filters.
echo   * a - *@host based clone counting, not user@host.
echo
echo Remaining args are channels to perform the clone check on.
		} (4) {
echo Switches:
echo    -a 30   Minimum action flood count.
echo    -m 30   Minimum msg flood count.
echo    -n 30   Minimum notice flood count.
echo    -p 30   Minimum public flood count.
echo    -c 10   Minimum ctcp flood count.
echo    -j  5   Minimum join/part flood count.
echo    -i  5   Minimum nick flood count.
echo    -z 50   Minimum flood count of all types.
echo These specify _default_ values.
		} (5) {
echo Examples:
echo   /cka Aa         Find all clones (more than one) on all channels.
echo   /cka 4 fb #     Ban unflagged users with more than 4 clones on channel # .
echo   /cka 4 fk #     Kick unflagged users with more than 4 clones on channel # .
echo   /cka 0 FaB #    Kickban all who exceed the flood limits from # .
return
		} (*) {
echo No more help for you!
return
		}
	}
type /clonecheck -h$repeat($count h)
}

alias clonecheck (chans) {
	$getopts(:chans cetk.cka. ha:c:i:j:m:n:p:z: $chans)
	if (cetk.cka.h) {
		cka.help ${@cetk.cka.h/2+1}
		@ cetk.cka.h = []
		return
	}
	@ :oxd = xdebug(dword)
	xdebug dword
	@ :num = isnumber(b10 $chans) ? shift(chans) : 1
	@ :maxm = isnumber(b10 $chans) ? shift(chans) : 0
	@ :maxu = isnumber(b10 $chans) ? shift(chans) : 0
	@ :flags = ischannel($chans) ? [w] : shift(chans)
	@ :chans = #chans ? chans : mychannels()
	@ :bold = chr(2)
	@ :msg = [$num or more clones possibly combined with flooding.  Ident and/or +v might help.]
	fe ($chans) chan {
		@ :users = chanusers($chan)
		@ :clones = userhost($users)
		@ :users = joinstr(! users clones)
		@ :clones = clonecount($num "$flags" $clones)
		foreach -clonecheck foo {
			@ clones = clonecheck[$foo]("$flags" $chan $clones)
		}
		@ :clones = replace(*!. . $clones)
		@ :clones = shuffles($clones)
		@ :users = pattern("\\[$clones\\]" $users)
		if (maxm && maxm<#clones) {
			echo Refusing to act on more than $maxm masks:  $#clones $clones
		} elsif (maxu && maxu<#users) {
			echo Refusing to act on more than $maxu users:  $#users $users
		} elsif (0 <= index(K $flags) && usermode() =~ [*o*]) {
			pkline $chan $clones / $msg
		} elsif (0 <= index(G $flags) && usermode() =~ [*o*]) {
			pgline $chan $clones / $msg
		} elsif (0 <= index(b $flags) && ischanop($servernick() $chan)) {
			ban $chan $filter("\\[$chanbans(b $chan)\\]" $clones)
		} elsif (0 <= index(k $flags) && ischanop($servernick() $chan)) {
			kick.all $chan $clones / $msg
		} elsif (0 <= index(B $flags) && ischanop($servernick() $chan)) {
			ban $chan $filter("\\[$chanbans(b $chan)\\]" $clones)
			kick.all $chan $clones / $msg
		} elsif (0 <= index(W $flags)) {
			fe users users {@ users = before(! $users)}
			wiq $users
		} else {
			fe ($clones) clone {
				@ :match = pattern($clone $users)
				fe match match {@ match = before(! $match)}
				echo clonechecker: $[-3]#match $chan $bold$clone$bold $match
			}
		}
	}
	xdebug $oxd
	qcmd 9
}

alias cka clonecheck $*;

#
# Filtering functions.  You can add your own and they will run automatically.
# A good one might discard clones that have been on the channel a long enough
# time or clones that have been active recently enough.
#
# Note that you will probably have to switch flood checking off with the "f"
# flag if your flood /sets aren't configured correctly.
#
alias clonecheck.mefilt (f,c,a) if (0>index(Am $f)) {@ :x = [$X $userhost($servernick())];fe a a {@ a = match($a $x) ? [] : a}};return $a
alias clonecheck.ofilt (f,c,a) if (0>index(Ao $f)) {@ :x = userhost($chops($c));fe a a {@ a = match($a $x) ? [] : a}};return $a
alias clonecheck.vfilt (f,c,a) if (0>index(Av $f)) {@ :x = userhost($chvoices($c));fe a a {@ a = match($a $x) ? [] : a}};return $a
alias clonecheck.ufilt (f,c,a) if (0>index(Au $f)) {fe a a {@ a = checkuser(*!$foo $c) ? [] : a}};return $a
alias clonecheck.zzfloodfilt (flags,chan,args) {
	unless (floodinfo("% %")) {return ${0 > index(F $flags) ? args : []}}
	^alias clonecheck.zzfloodfilt (flags,chan,args) {
		unless (0>index(Af $flags)) {return $args}
		@ :oxd = xdebug(dword)
		xdebug dword
		@ :sn = servernum()
		fe args args {@ args = floodinfo("$args $chan * $sn 4")}
		@ :ma = cetk[cka][z] ? cetk[cka][z] : 50
		@ :mj = cetk[cka][j] ? cetk[cka][j] : 5
		@ :m[actions] = cetk[cka][a] ? cetk[cka][a] : 30
		@ :m[msgs] = cetk[cka][m] ? cetk[cka][m] : 30
		@ :m[notices] = cetk[cka][n] ? cetk[cka][n] : 30
		@ :m[publics] = cetk[cka][p] ? cetk[cka][p] : 30
		@ :m[ctcps] = cetk[cka][c] ? cetk[cka][c] : 10
		@ :m[nicks] = cetk[cka][i] ? cetk[cka][i] : 5
		fe args args {
			fe args nuh xx type xx count {break}
			@ :enuh = encode($nuh)
			@ :u[$enuh] += count
			@ :u[$enuh][$type] += count
			@ :args = mj < u[$enuh][joins] && mj < u[$enuh][parts] ? nuh : []
			@ :args = m[$type] && m[$type] < u[$enuh][$type] ? nuh : args
			@ :args = ma < u[$enuh] ? nuh : []
		}
		@ :args = uniq($args)
		xdebug $oxd
		return $args
	}
	return $clonecheck.zzfloodfilt($flags $chan $args)
}

#
# Count the clones, return u@h masks for all those above the limits.  Clones
# are counted based on their hosts if the "a" flag has been given.  Otherwise,
# the ident values are also used, and all users with an ident starting with a
# non-alphanumeric char are considered to be one user.
# 
# This function has been modified to exclude usernames with an upper-case
# starting characters.  From memory, it was to deal with Freenode's N=/U=
# leading characters, but it seemed to work well enough, so it's still in here.
#
alias clonecount (num,flags,args) {
	@ :honly = 0 <= index(a $flags)
	@ :chars = jotc(az09)
	if (honly) {
		fe args foo {
			@ foo = [*@$after(@ $foo)]
		}
	} else {
		fe args foo {
			@ foo = index($chars $foo) ? [$left(1 $foo)*@$after(@ $foo)] : foo
		}
	}
	@ :args = sort($args)
	fe args args {
		@ :count = last == args ? count + 1 : 0
		@ :last = args
		@ :args = count == num ? args : []
	}
	return $args
}

alias fe.flooders (args) {
	unless (args) {
		echo Run /command for all known flooders in the built in flood detection system.
		echo   /fe.flooders -options /command
		echo
		echo Options :
		echo   -n nuh   -- Limit detection to a particular u@h mask.
		echo   -c chan  -- Limit detection to a particular channel.
		echo   -t type  -- Limit detection to a particular flood type.
		echo   -s serv  -- Limit detection to a particular server.
		echo   -m mask  -- Specify all the \$floodinfo() values at once.
		echo   -r rest  -- Specify remaining \$floodinfo() args.
		echo   -a       -- Act on all flooders.
		echo An option using a capital will cause /command to be run.
		echo
		echo \$flooder will contain the \$floodinfo() argument, and \$uh, \$chn, \$type,
		echo \$serv, \$count and \$time will contain the individual args from \$flooder.
		return
	}
	@ :nuhm = [*]
	@ :chan = C
	@ :type = [*]
	@ :serv = servernum()
	@ :rest = getset(flood_after)
	while (:option = getopt(:optopt :optarg N:C:T:S:R:M:n:c:t:s:r:m:a $args)) {
		switch ($option) {
		(!) {echo * option "$optopt" is an invalid option;return}
		(-) {echo * option "$optopt" is missing an argument;return}
		(n) {@ :nuhm = optarg}
		(c) {@ :chan = optarg}
		(t) {@ :type = optarg}
		(s) {@ :serv = 0 > servernum($optarg) ? optarg : servernum($optarg)}
		(r) {@ :rest = split(, $optarg)}
		(m) {
			@ optarg = split(, $optarg)
			@ :nuhm = optarg ? shift(optarg) : nuhm
			@ :chan = optarg ? shift(optarg) : chan
			@ :type = optarg ? shift(optarg) : type
			@ :serv = optarg ? shift(optarg) : serv
			@ :rest = optarg ? optarg : rest
		}
		(a) {fe (* * * -1 0) nuhm chan type serv rest {break}}
		}
	}
	@ :cmd = optarg ? [eval $optarg] : [eval echo \$flooder]
	@ :mask = unsplit(" " $nuhm $chan $type $serv $rest)
	fe ($floodinfo("$mask")) flooder {
		fe ($flooder) uh chan type serv count time {$cmd;break}
	}
}

alias ignore.itofix {
	fe ($ignorectl(refnums)) ref {
		@ :timeout   = ignorectl(get $ref expiration) - ignorectl(get $ref creation)
		@ :newcreate = ignorectl(get $ref last_used)
		@ :newcreate = shift(newcreate)
		@ :newexpire = newcreate + timeout
		@ :time = utimen($utime())
		if (newcreate < time && time < newexpire) {
			@ ignorectl(set $ref creation $newcreate 0)
			@ ignorectl(set $ref expiration $newexpire 0)
		}
	}
}

fe (if unless) cmd {
	alias.recurse 2 ${cmd}.cloned (count,args) ${cmd}.clones \$count \$X \$args
	alias.recurse 3 ${cmd}.clones (count,mask,args) $cmd (match(*@$after(-1 @ @$mask) $clonecount($count Aa $mynuhs($common($myservers(,) / $serverctl(gmatch $servergroup())))))) {$args}
}