#
# amsg blacklist for shroudBNC 1.2
# Version 1.00, last modified 03/Oct/2007 - kh version tracked @ http://khobbits.net/sbnc/
# Copyright 2007, David Uhlig
#
# ## ##
# ## ##
#
# This file was edited by KHobbits to patch servers where MAXTARGETS is lower than the number of channels you can be in
# This script also makes allowences for partylines, warnings, and amsg counts.
#
# ## ##
# ## ##
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Contact:
#     irc://irc.quakenet.org/sbnc (nick: eteran)
#     http://eteran.googlecode.com
#     david.uhlig@googlemail.com
#
# Functionality:
#     When sending a message to multiple channels, the channel list is
#     matched against a blacklist. The script strips out channels that
#     shall not recieve such multi channel messages.
#
# Usage:
#     amsg add channel ?channel channel ...?
#     amsg del channel ?channel channel ...?
#     amsg on
#     amsg off
#     amsg warning on
#     amsg warning off
#     amsg setting
#
# Bugs:
#     Please report bugs to: http://code.google.com/p/eteran/issues/list
#

namespace eval amsg {
	internalbind prerehash [namespace current]::prerehash
	internalbind command   [namespace current]::command
	internalbind usrcreate [namespace current]::usrcreate
	internalbind usrdelete [namespace current]::usrdelete

	#
	# Initiate binds when a new user is created
	#
	# @param	string	strUsername
	# @return	void
	#
	proc usrcreate {strUsername} {
		initUser $strUsername
	}

	#
	# Delete user specific binds when a user is deleted
	#
	# @param	string	strUsername
	# @return	void
	#
	proc usrdelete {strUsername} {
		set listInternalbinds	[internalbinds]
		foreach {listInternalbind} $listInternalbinds {
			set strType			[lindex $listInternalbinds 0]
			set strProcedure	[lindex $listInternalbinds 1]
			set strPattern		[lindex $listInternalbinds 2]
			set strClient		[lindex $listInternalbinds 3]

			if {[string match -nocase "[namespace current]::*" $strProcedure] && [string equal -nocase $strClient $strUsername]} {
				internalunbind $strType $strProcedure $strPattern $strClient
			}
		}
	}

	#
	# Strip blacklisted channels out of amsgs
	#
	# @param	string	strClient
	# @param	list	listParameter
	# @return	void
	#
	proc filter {strClient listParameter} {

		#
		# blacklist was disabled by the client
		#
		if {[setting get "active"] == 0} {
			return
		}
		#
		# the blacklist only affects real amsgs
		#

		if {![isAmsg $strClient $listParameter]} {
			return
		}
		#
		# strip channels that are blacklisted
		#
		set strReciever				[string tolower [lindex $listParameter 1]]
		set listReciever			[split $strReciever {,}]
		set listBlacklist			[setting get "channel"]

		if {[getbncuser $strClient tag partyline] != ""} {
			append listBlacklist " [split [getbncuser $strClient tag partyline] {,}]"
		}

		set listRecieverStripped	[list]
		set listRecieverGotStripped	[list]
		foreach {strChannel} $listReciever {
			if {[lsearch -exact $listBlacklist $strChannel] == -1} {
				lappend listRecieverStripped	$strChannel
			} else {
				lappend listRecieverGotStripped	$strChannel
			}
		}
		#
		# if any recievers are left, send message
		#
		if {[llength $listRecieverStripped] > 0} {
			set listParameter	[lreplace $listParameter 1 1 [join $listRecieverStripped {,}]]
			puthelp [join $listParameter]

		}
		if {[llength $listRecieverGotStripped] > 0 && [setting get "warning"] == 1} {
			bncreply "Amsg blacklist blocked messages too: $listRecieverGotStripped"
			setting set count [expr [setting get "count"] + 1]
		}
		#
		# throw away the original message
		#
		haltoutput
	}

	#
	# Determ if a given message is an amsg.
	#
	# @param	string	strClient
	# @param	list	listParameter	string sent by the client as list
	# @return	bool
	#
	proc isAmsg {strClient listParameter} {
		#
		# only a privmsg can be an amsg
		#
		set strCommand		[lindex $listParameter 0]
		if {![string equal -nocase $strCommand "privmsg"]} {
			return false
		}
		#
		# only a message sent to more than one channel
		# can be a amsg
		#
		set listReciever	[split [lindex $listParameter 1] {,}]
		set listChannel		[channels]
		if {[getbncuser $strClient tag partyline] != ""} {
			append listChannel " [split [getbncuser $strClient tag partyline] {,}]"
		}

		if {[llength $listReciever] <= 1} {
			if {[getbncuser $strClient tag amsg-blacklistmatch] != 1} {
				return false
			}
			setbncuser $strClient tag amsg-blacklistmatch 0
		} else {
			#
			# the number of recievers and the number of channels the user
			# is currently in have to match
			#
			if {[llength $listReciever] != [llength $listChannel]} {

				# check if the amsg hits the max targets limit, or could be a follow on from max targets.
				if {[getisupport maxtargets] == ""} { return false }
				if {[llength $listReciever] < [getisupport maxtargets] && [llength $listReciever] != [expr {[llength $listChannel] % [getisupport maxtargets]}]} {
					return false
				}

				# check if there is a straggling channel (this should use setting not setbncuser)
				if {[expr [llength $listChannel] % [getisupport maxtargets]] == 1} {
					setbncuser $strClient tag amsg-blacklistmatch 1
				}
			}
		}
		#
		# all recivers must be channels the user is on
		#

		foreach target [string tolower $listReciever] {
			if {[lsearch -exact [string tolower $listChannel] $target] == -1} {
				return false
			}
		}
		return true
	}

	#
	# Handle commands to manage the scripts functions
	# and setup help text
	#
	# @param	string	strClient		username
	# @param	list	listParameter
	# @return	mixed					void|error
	#
	proc command {strClient listParameter} {
		set strCommand	[lindex $listParameter 0]

		#
		# handle the help command
		#
		if {[string equal -nocase $strCommand "help"]} {
			lappend listHelp	"Functionality:"
			lappend listHelp	"When sending a message to multiple channels, the channel list is matched"
			lappend listHelp	"against a blacklist. Channels that shall not recieve an amsg are stripped"
			lappend listHelp	"out of the message."
			lappend listHelp	"-"
			lappend listHelp	"Usage:"
			lappend listHelp	"/sbnc amsg add chan ?chan chan ...? - add a channel to the blacklist"
			lappend listHelp	"           del chan ?chan chan ...? - delete a channel from the blacklist"
			lappend listHelp	"           on                       - enable this script"
			lappend listHelp	"           off                      - disable this script"
			lappend listHelp	"           warning on               - enable warning on amsg block"
			lappend listHelp	"           warning off              - disable warning on amsg block"
			lappend listHelp	"           setting                  - show current settings"

			bncaddcommand "amsg" "KHUser" "filtering of blacklisted channels when sending an amsg" [join $listHelp "\n"]
		}

		#
		# handle the amsg command
		#
		if {[string equal -nocase $strCommand "amsg"]} {
			set strSubCommand		[lindex $listParameter 1]
			set listSubParameter	[lrange $listParameter 2 end]

			#
			# add a channel to the blacklist
			#
			if {[string equal -nocase $strSubCommand "add"]} {
				#
				# no channels given
				#
				if {[llength $listSubParameter] < 1} {
					bncreply "Syntax: /sbnc amsg add chan ?chan chan ...?"
					haltoutput
					return
				}

				#
				# check for prefix
				#
				set listOk		[list]
				set listError	[list]
				foreach {strChannel} $listSubParameter {
					if {[hasChannelPrefix $strChannel] == true} {
						lappend listOk		[string tolower $strChannel]
					} else {
						lappend listError	$strChannel
					}
				}

				#
				# notify user that (parts of) his input was/were incorrect
				#
				if {[llength $listError] > 0} {
					if {[llength $listError] == 1} {
						bncreply "You have to specify a prefix for this channel: [join $listError {, }]"
					} else {
						bncreply "You have to specify a prefix for these channels: [join $listError {, }]"
					}
					bncreply "Your Network supports these prefixes: [getisupport CHANTYPES]"
				}

				#
				# add channels to the blacklist and notify user about success
				#
				if {[llength $listOk] > 0} {
					set listBlacklist	[setting get "channel"]
					foreach {strChannel} $listOk {
						lappend listBlacklist [string tolower $strChannel]
					}
					set listBlacklist [lunique $listBlacklist]
					setting set "channel" $listBlacklist

					internalbind client [namespace current]::filter "privmsg" [getctx]

					if {[llength $listOk] == 1} {
						bncreply "[join $listOk] has been added to your blacklist"
					} else {
						bncreply "These channels have been added to your blacklist: [join $listOk {, }]"
					}
				}

				haltoutput
				return
			#
			# remove a channel from the blacklist
			#
			} elseif {[string equal -nocase $strSubCommand "del"]} {
				#
				# no channels given
				#
				if {[llength $listSubParameter] < 1} {
					bncreply "Syntax: /sbnc amsg add chan ?chan chan ...?"
					haltoutput
					return
				}

				set listBlacklist	[setting get "channel"]

				set listNotFound	[list]
				set listRemove		[list]
				foreach {strChannel} $listSubParameter {
					set strChannel	[string tolower $strChannel]
					#
					# channel is not in the users blacklist
					#
					if {[lsearch -exact $listBlacklist $strChannel] == -1} {
						lappend listNotFound	$strChannel
					#
					# channel was found in the users blacklist
					#
					} else {
						lappend listRemove		$strChannel
					}
				}

				#
				# notify user that (parts of) his input was/were incorrect
				#
				if {[llength $listNotFound] > 0} {
					if {[llength $listNotFound] == 1} {
						bncreply "[join $listNotFound] is not in your blacklist."
					} else {
						bncreply "These channels are not in your blacklist: [join $listNotFound {, }]"
					}
				}

				#
				# remove channels from blacklist and notify user about success
				#
				if {[llength $listRemove] > 0} {
					foreach {strChannel} $listRemove {
						set intIndex [lsearch -exact $listBlacklist $strChannel]

						if {$intIndex == -1} {
							return -code error "Unexpected error when trying to remove $strChannel from the channel blacklist."
						}

						set listBlacklist	[lreplace $listBlacklist $intIndex $intIndex]
					}
					setting set "channel" $listBlacklist

					#
					# no blacklisted channels left so there is
					# no need to filter anything
					#
					if {[llength $listBlacklist] == 0} {
						internalunbind client [namespace current]::filter "privmsg" [getctx]
					}

					if {[llength $listRemove] == 1} {
						bncreply "[join $listRemove] was removed from your blacklist."
					} else {
						bncreply "These channels were removed from your blacklist: [join $listRemove {, }]"
					}
				}

				haltoutput
				return
			#
			# enable the script
			#
			} elseif {[string equal -nocase $strSubCommand "on"] || [string equal -nocase $strSubCommand "enable"]} {
				setting set "active" 1
				bncreply "Done. The amsg blacklist is now enabled."

				if {[llength [setting get "channel"]] > 0} {
					internalbind client [namespace current]::filter "privmsg" [getctx]
				}

				haltoutput
				return
			#
			# disable the script
			#
			} elseif {[string equal -nocase $strSubCommand "off"] || [string equal -nocase $strSubCommand "disable"]} {
				setting set "active" 0
				bncreply "Done. The amsg blacklist is now disabled."

				internalunbind client [namespace current]::filter "privmsg" [getctx]

				haltoutput
				return
			#
			# warnings
			#
			} elseif {[string equal -nocase $strSubCommand "warning"] } {
				if {[string equal -nocase [lindex $listParameter 2] "off"] || [string equal -nocase [lindex $listParameter 2] "disable"]} {
					setting set "warning" 0
					bncreply "Done. The amsg warning is now disabled."
				} elseif {[string equal -nocase [lindex $listParameter 2] "on"] || [string equal -nocase [lindex $listParameter 2] "enable"]} {
					setting set "warning" 1
					bncreply "Done. The amsg warning is now enabled."
				} else {
					set intSettingWarning	[setting get "warning"]
					switch -exact $intSettingWarning {
						1	{	set strWarning "Enabled";	}
						0	{	set strWarning "Disabled";	}
					}
					bncreply "Warning on blocked amsg is $strWarning, Syntax: /sbnc amsg warning \[on/off\]"
				}
				haltoutput
				return
			#
			# show settings
			#
			} else {
				set intSettingActive	[setting get "active"]
				set intSettingWarning	[setting get "warning"]
				set intSettingCount	[setting get "count"]
				set listChannels		[setting get "channel"]

				switch -exact $intSettingActive {
					1	{	set strActive "Enabled";	}
					0	{	set strActive "Disabled";	}
				}
				switch -exact $intSettingWarning {
					1	{	set strWarning "Enabled";	}
					0	{	set strWarning "Disabled";	}
				}

				bncreply "Settings for the amsg blacklist:"
				bncreply "Status:            $strActive"
				bncreply "Warning:           $strWarning"
				bncreply "Affected amsg's:   $intSettingCount"
				bncreply "Channels:          [join $listChannels {, }]"

				haltoutput
				return
			}
		}
	}

	#
	# Buffer function to get and set user settings
	#
	# @param	string	strType		set|get
	# @param	string	strSetting	channel|active
	# @param	mixed	varValue
	#
	# @return	mixed				error|true|value
	#
	proc setting {strType strSetting {varValue ""}} {
		set strType		[string tolower $strType]
		set strSetting	[string tolower $strSetting]
		set strCtx		[getctx]

		#
		# validation
		#
		switch -exact $strType {
			"get"		-
			"set"		{}
			default		{
				return -code error "expecting get|set for strType but got \"$strType\""
			}
		}
		switch -exact $strSetting {
			"channel"	{
				set intIndex 7
			}
			"count"	{
				set intIndex 5
			}
			"warning"	{
				set intIndex 3
			}
			"active"	{
				set intIndex 1
			}
			default		{
				return -code error "expecting channel|active|warning|count for strSetting but got \"$strSetting\""
			}
		}

		set strSetting		[getbncuser $strCtx tag "amsg-blacklist"]
		#
		# no settings in conf file
		# set defaults
		#
		if {[string length $strSetting] == 0} {
			set listSetting	[list "active" 0 "warning" 1 "count" 0 "channel" [list]]
		#
		# settings found in conf file
		#
		} else {
			set listSetting [split $strSetting {,}]
		}

		#
		# apply changes
		#
		if {[string equal $strType "set"]} {
			if {[string equal $strSetting "channel"]} {
				set varValue [lsort -dictionary $varValue]
			}
			set listSetting		[lreplace $listSetting $intIndex $intIndex $varValue]
			setbncuser $strCtx tag "amsg-blacklist" [join $listSetting {,}]
			return true
		#
		# return setting value
		#
		} else {
			return [lindex $listSetting $intIndex]
		}

	}

	#
	# Validate channel name string against prefixes
	# supported by the current network.
	#
	# @param	string	strChannel
	# @return	bool
	#
	proc hasChannelPrefix {strChannel} {
		set strChannelPrefix		[string index $strChannel 0]
		set strPossiblePrefixes		[getisupport CHANTYPES]

		if {[string first $strChannelPrefix $strPossiblePrefixes] == -1} {
			return false
		} else {
			return true
		}
	}

	#
	# Strip duplicate list items
	#
	# @param	list	list
	# @return	list			list with unique items
	#
	proc lunique {list} {
		return [lsort -unique $list]
	}

	#
	# Initiate the script
	#
	# @return	void
	#
	proc init {} {
		foreach {strUsername} [bncuserlist] {
			initUser $strUsername
		}
	}

	#
	# Initiate binds for a single user
	#
	# @param	string	strUsername
	# @return	void
	#
	proc initUser {strUsername} {
		set strOriginalCtx	[getctx]
		setctx $strUsername

		#
		# set up bind
		#
		if {[llength [setting get "channel"]] > 0 && [setting get "active"] == 1} {
			internalbind client [namespace current]::filter "privmsg" $strUsername
		}

		setctx $strOriginalCtx
	}

	#
	# Make sure the script unloads clean before a rehash is issued
	#
	# @return	void
	#
	proc prerehash {} {
		#
		# unbind all internalbinds
		#
		set listInternalbinds	[internalbinds]
		foreach {listInternalbind} $listInternalbinds {
			set strType			[lindex $listInternalbinds 0]
			set strProcedure	[lindex $listInternalbinds 1]
			set strPattern		[lindex $listInternalbinds 2]
			set strClient		[lindex $listInternalbinds 3]

			if {[string match -nocase "[namespace current]::*" $strProcedure]} {
				internalunbind $strType $strProcedure $strPattern $strClient
			}
		}
		#
		# destroy the namespace
		#
		namespace delete [namespace current]
	}

	init
}