# "Antispam" plugin for Tkabber.
# This plugin blocks (hides from the user) 
# spam messages and subscription requests.
# Implementation:
#   Otto von Gebbels <gebb at ngs dot ru>
# Guidance and code review:
#   Konstantin Khomoutov <flatworm@users.sourceforge.net>

namespace eval antispam {
	variable options

	package require msgcat
	::msgcat::mcload [file join [file dir [info script]] msgs]

	if {![::plugins::is_registered antispam]} {
		::plugins::register antispam \
					-namespace [namespace current] \
					-source [info script] \
					-description [::msgcat::mc "Whether the Antispam plugin is loaded."] \
					-loadcommand [namespace code load] \
					-unloadcommand [namespace code unload]
		return
	}

	custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber

	set group "Antispam"

	custom::defgroup $group \
		[::msgcat::mc "Antispam plugin discards incoming\
			subscription requests and chat messages\
			from JIDs that are not in the roster,\
			optionally requesting a password that\
			enables the showing of messages."] \
		-group Plugins

	custom::defvar options(disable_regex) "^$" \
		[::msgcat::mc "Regular expression to match JIDs for which\
			the spam protection will not be used. A (default) value\
			of \"^$\" means no JIDs."] \
		-group $group \
		-type string

	custom::defvar options(enable_regex) "" \
		[::msgcat::mc "Regular expression to match unknown JIDs,\
			messages from which will be discarded util\
			a correct password is received. A (default)\
			value of \"\" means any JID."] \
		-group $group \
		-type string

	custom::defvar options(message) "You seem to not exist\
			in my roster. To bypass the spam protection system\
			your message must contain the password: %p." \
		[::msgcat::mc "Message used to notify the sender\
			about the spam protection and to request a password\
			that enables the showing of messages from that JID.\
			A token %% is expanded to a single % and %p to the\
			password before sending.\
			Specify an empty string to disable notification."] \
		-group $group \
		-type string

	custom::defvar options(ack_message) "You have provided the\
			correct password. From now on your messages\
			will not be blocked." \
		[::msgcat::mc "Message used to inform the sender\
			that they have provided the correct password.\
			Specify an empty string to disable acknowledgement."] \
		-group $group \
		-type string

	custom::defvar options(password) "666" \
		[::msgcat::mc "Password, providing which will\
			let the messages from the sender reach you. This\
			is essentially a regexp that an incoming message\
			has to match."] \
		-group $group \
		-type string

	custom::defvar options(empty_err_regex) "^$" \
		[::msgcat::mc "Regular expression to match JIDs from which\
			empty error messages will be ignored.\
			This setting is intended to suppress occasional\
			error messages from transports. A (default) value\
			of \"^$\" means no JIDs."] \
		-group $group \
		-type string

	custom::defvar options(log_file) [file join $::configdir antispam.log] \
		[::msgcat::mc "Antispam log file."] \
		-group $group \
		-type file

	unset group
}

# Sends a password request.
#
proc antispam::notify {xlib to} {
	variable options
	if {$options(message) eq ""} {
		return
	}
	debugmsg antispam \
		"REQUEST_PASSWORD: sending request to $to."
	set msg [string map [list \
		%% % \
		%p $options(password)] $options(message)]
	send_msg $xlib $to $msg
}

# Sends the correct password acknowledgment.
#
proc antispam::acknowledge {xlib to} {
	variable options
	set msg $options(ack_message)
	if {$msg eq ""} {
		return
	}
	debugmsg antispam \
		"ACKNOWLEDGE: sending confirmation to $to."
	send_msg $xlib $to $msg
}

# Sends a chat message.
#
proc antispam::send_msg {xlib to msg} {
	if {$msg eq ""} {
		return
	}
	log_msg $xlib "antispam -> $to" $msg
	message::send_msg $xlib $to -type chat -body $msg
}

# Checks if the rules defined by the user
# are met for a JID, and the spam protection
# must be engaged.
#
proc antispam::meets_rules {jid} {
	variable options
	expr {![regexp -nocase $options(disable_regex) $jid]
		&& [regexp -nocase $options(enable_regex) $jid]}
}

# Disables the postponing of messages and shows offline
# messages (except spam) for the specified connection.
#
proc antispam::roster_loaded_handler {xlib} {
	variable roster_loaded
	variable roster_wait_failed
	set roster_loaded($xlib) 1
	set roster_wait_failed($xlib) 0
	process_postponed_msgs $xlib
}

# Shows all offline messages (including possible spam)
# if the roster failed to load and 
# enables the postponing of messages.
#
proc antispam::disconnected_handler {xlib} {
	variable roster_loaded
	variable roster_wait_failed
	if { ![is_ roster_loaded $xlib] } {
		# Disconnect occurred before the roster has arrived.
		set roster_wait_failed($xlib) 1
		process_postponed_msgs $xlib
	}
	set roster_loaded($xlib) 0
	set roster_wait_failed($xlib) 0
}

# Checks if there are postponed messages.
#
proc antispam::postponed_msgs_exist {xlib} {
	variable postponed_msgs
	expr { [info exists postponed_msgs($xlib)]
		&& $postponed_msgs($xlib) ne ""}
}

# Shows postponed messages and clears the postponed
# message list for the specified connection.
#
proc antispam::process_postponed_msgs {xlib} {
	variable postponed_msgs
	if { ![postponed_msgs_exist $xlib] } {
		return
	}
	foreach {xlib from id type is_subject subject body args} \
	$postponed_msgs($xlib) {
		eval [list hook::run process_message_hook \
			$xlib $from $id $type $is_subject $subject $body] $args
	}
	set postponed_msgs($xlib) {}
}


# Checks if the specified array element exists and is true.
#
proc antispam::is_ {arr x} {
	variable $arr
	upvar 0 ${arr}($x) el
	expr {[info exists el] && $el}
}

# Logs the specified message.
#
proc antispam::log_msg {xlib addr msg} {
	variable options
	set log $options(log_file)
	if { $log eq "" } {
		return
	}
	if { [catch {open $log a} fd] } {
		debugmsg antispam \
			"ERROR: cannot open log file."
		return
	}
	puts $fd "[clock format [clock seconds]]\t([connection_jid $xlib])\t$addr:\t$msg"
	close $fd
}

# Blocks messages from unknown JIDs
# and requests the password (sending $options(message)).
#
proc antispam::process_message {xlib from id type is_subject subject body args} {
	variable options
	variable answered
	variable postponed_msgs
	global whitelist

	if { $type ne "groupchat" } {
		debugmsg antispam \
			"PROCESS: message from $from, type $type, body: $body, args: $args."
	}
	# Block chat and error messages only.
	if {$type ne "chat" 
			&& $type ne "error"} {
		return
	}
	# Accept service messages.
	if {$body eq "" 
			&& $type eq "chat"} {
		debugmsg antispam \
			"ACCEPT: empty body (possible service message)."
		return
	}

	set chatid [chat::chatid $xlib $from]
	set jid [connection_jid $xlib]
	set my_barejid [connection_bare_jid $xlib]
	set sender_barejid [xmpp::jid::stripResource $from]
	set barejid_chatid [chat::chatid $xlib $sender_barejid]

	# Do nothing if the sender is on the white list.
	upvar 0 whitelist($sender_barejid) onwlist
	if { [info exists onwlist] } {
		debugmsg antispam \
			"ACCEPT: white list."
		return
	}
	# Do not block MUC messages.
	if { [chat::is_groupchat $barejid_chatid] } {
		debugmsg antispam \
			"ACCEPT: groupchat."
		return
	}
	# A chat window was manually opened for this JID,
	# so we assume the other side is not a spammer.
	if {[chat::is_opened $barejid_chatid]
		|| [chat::is_opened $chatid]} {
		debugmsg antispam \
			"ACCEPT: chat window open."
		return
	}
	# Do not block messages from self.
	if { [string equal -nocase $my_barejid $sender_barejid] } {
		debugmsg antispam \
			"ACCEPT: from myself."
		return
	}
	# Accept messages from server
	if { [string equal -nocase $from [::xmpp::jid::server $my_barejid]] } {
		debugmsg antispam \
			"ACCEPT: from server."
		return
	}
	# Block empty errors from specified JIDs (defined by regexp).
	if { $type eq "error"
		&& $body eq ""
		&& [regexp -nocase $options(empty_err_regex) $from] } {
		debugmsg antispam \
			"BLOCK_EMPTY_ERR: blocking empty error from $from."
		return stop
	}
	# Do nothing if regexp rules are not met.
	if { ![meets_rules $from] } {
		debugmsg antispam \
			"ACCEPT: blocking rules not met."
		return
	}

	# Do not block offline messages if
	# the roster couldn't be loaded.
	if {[is_ roster_wait_failed $xlib] } {
		debugmsg antispam \
			"ACCEPT: disconnected before loading roster."
		return
	}

	# Postpone messages if the roster has not been initialized.
	if { ![is_ roster_loaded $xlib] } {
		debugmsg antispam \
			"POSTPONE: roster not initialized."
		lappend postponed_msgs($xlib) \
			$xlib $from $id $type $is_subject $subject $body $args
		return stop
	}

	# Do not block messages from contacts in roster.
	if {[roster::find_jid $xlib $sender_barejid] ne "" } {
		debugmsg antispam \
			"ACCEPT: sender in roster."
		return
	}

	# If the correct password was given, put the sender
	# on the white list.
	# (Ignore the password in error messages.)
	if { $type eq "chat"
			&& [regexp -nocase $options(password) $body] } {
		set onwlist 1
		debugmsg antispam \
			"ACCEPT: correct password given."
		acknowledge $xlib $from
		return
	}

	# If code flow reached this point, 
	# the message is considered spam.

	# Suppress error messages from spammers without 
	# sending the request.
	if { $type eq "error" } {
		debugmsg antispam \
			"BLOCK_SPAM: blocking error from $from."
		return stop
	}
	# Don't send the request when processing an offline message.
	if { [postponed_msgs_exist $xlib] } {
		debugmsg antispam \
			"BLOCK_SPAM: blocking offline message from $from."
		return stop
	}
	debugmsg antispam \
		"BLOCK_SPAM: blocking message from $from."
	# Increment the number of times we replied to this JID.
	upvar 0 answered($sender_barejid) answ
	if {![info exists answ]} {
		set answ 1
	} else {
		incr answ
	}
	# Log the blocked message.
	log_msg $xlib $from $body
	# Stop sending the request after doing it 1 time
	# (should we make this number customizable?),
	# but still prevent messages from being shown to the user.
	if { $answ > 1 } {
		return stop
	}
	# Send a password request without opening a chat window.
	notify $xlib $from
	return stop
}

# Automatically rejects subscription if the request
# does not contain the password.
#
proc antispam::block_subscription_spam {xlib from type x args} {
	variable options
	global whitelist

	if {$type ne "subscribe"} {
		return
	}
	# Do nothing if the sender is on the white list.
	set sender_barejid [xmpp::jid::stripResource $from]
	if { [info exists whitelist($sender_barejid)] } {
		debugmsg antispam \
			"ACCEPT_SUBSC: Sender on white list."
		return
	}
	# Do not block requests from contacts in roster.
	if {[roster::find_jid $xlib $sender_barejid] ne "" } {
		debugmsg antispam \
			"ACCEPT_SUBSC: Sender in roster."
		return
	}
	set chatid [chat::chatid $xlib $from]
	set barejid_chatid [chat::chatid $xlib $sender_barejid]
	# Do not request password if a chat window is 
	# open for this JID.
	if {[chat::is_opened $barejid_chatid]
		|| [chat::is_opened $chatid]} {
		debugmsg antispam \
			"ACCEPT_SUBSC: Chat window open."
		return
	}
	set status ""
	foreach {opt val} $args {
		switch -- $opt {
			-status { set status $val }
		}
	}
	if { ![meets_rules $from]
		|| [regexp -nocase $options(password) $status] } {
		return
	}
	roster::remove_item $xlib $from
	log_msg $xlib $from {subscription request}
	# Notify the sender on how to bypass the antispam system.
	notify $xlib $from
	debugmsg antispam \
		"BLOCK_SUBSCR_SPAM: $from."
	return stop
}

# HACK: An unloadable plugin should not behave like this.
# TODO: Remove this when there is a means in Tkabber
#       to check if the roster is loaded without using hooks.
namespace eval antispam {
	hook::add roster_end_hook \
		[namespace current]::roster_loaded_handler
	hook::add disconnected_hook \
		[namespace current]::disconnected_handler
}

proc antispam::load {} {
	variable answered
	variable postponed_msgs
	global whitelist

	# Must be run before other handlers to prevent
	# chat window opening for spam messages.
	hook::add process_message_hook \
		[namespace current]::process_message 40
	# Must be run before the handler showing subcription dialog.
	hook::add client_presence_hook \
		[namespace current]::block_subscription_spam 40

}

proc antispam::unload {} {
	variable answered
	variable postponed_msgs
	global whitelist

	catch {unset answered}
	catch {unset postponed_msgs}
	catch {unset whitelist}

	hook::remove process_message_hook \
		[namespace current]::process_message 40
	hook::remove client_presence_hook \
		[namespace current]::block_subscription_spam 40
}

# vim:ai:si:noet:nosta:ts=3:sw=3
