quakenet.pl


# TODO: 
# -normal auth support and setting quakenet_authtype 'normal' or 'challenge'

use strict;
use Irssi;
use Irssi::Irc;
use Irssi::TextUI; # for statusbar
use Digest::MD5 qw(md5_hex); # for challengeauth with Q (testing)

use vars qw($VERSION %IRSSI %authed %flood %stopped $authbar $Qhost %motd_timeout);
$VERSION = "20051010.2010";
%IRSSI = (
	authors		=> 'Valentin Batz',
	contact		=> 'senneth@irssi.org',
	name		=> 'quakenet',
	description	=> 'General purpose of this script is to be used on QuakeNet, supports challengeauth',
	license		=> 'GPLv2',
	modules 	=> 'Digest::MD5',
	url		=> 'http://www.oberkommando.org/~senneth/irssi/scripts/',
	sbitems		=> 'quakenet_auth',
	commands	=> 'quakenet',
	revision    	=> '$LastChangedRevision: 369 $',
	changed     	=> '$LastChangedDate: 2006-01-31 22:35:03 +0100 (Di, 31 Jan 2006) $',
);

#-( Globals )-------------------------------------------------------#

$Qhost = 'Q@CServe.quakenet.org';

Irssi::theme_register(	['whois_auth',	'{whois authnick %|$1}',
			 'whois_ip',	'{whois realip %|$1}',
			 'whois_host',	'{whois realhost %|$1}',
			 'hidden_host',	'Your hidden hostname is now: $1',
			 'quakenet_found', 'QuakeNet server for tag $0 detected, checking for Q...',
			 'quakenet_q_online', 'Q is online, sending challenge...',
			 'quakenet_q_offline', 'Q is offline, trying again in 60s',
			 'quakenet_authed', 'Successfully or already authed as $0 on $1',
			 'quakenet_q_overloaded', 'Q seems to be overloaded, trying again in 60s']
);

#-( Helper Subs )---------------------------------------------------#

sub is_colored {
	 my $text = shift;
	 return $text =~ /(\x03|\x1b)/;
}

sub what_bot_isin($) {
	my $channel = shift;
	foreach my $nick ($channel->nicks()) {
		 return "L" if ($nick->{nick} eq "L");
		 return "Q" if ($nick->{nick} eq "Q");
	}
	return undef;
}

sub check_auth {
	my $tag = shift;
	delete $authed{$tag} if defined $authed{$tag};
	my $server = Irssi::server_find_tag($tag);
	return unless $server;
	my $arg = $server->{nick};
        $server->redirect_event('whois', 1, $arg, -1, "", {
                                'event 330' => 'redir quakenet authed',
                                '' => 'event empty'});
	$server->send_raw("WHOIS :$arg");
}

sub init_auth {
	foreach my $server (Irssi::servers()) {
		if (good_server($server)) {
			check_auth($server->{'tag'});
		}
	}
}

sub good_server {
	my $server = shift;
	if (defined($server) && $server->{'chat_type'} eq 'IRC' && ($server->{'real_address'} =~ /\.quakenet\.org$/|| $server->{'real_address'} =~/QuakeNet.proxy/) ) {
		return 1;
	} else {
		return 0;
	}
}

sub send_challenge {
	my $tag = shift;
	my $server = Irssi::server_find_tag($tag);
	return unless good_server($server);
	if (defined($flood{$tag})) {
		delete($flood{$tag});
	}
	$server->send_raw("PRIVMSG $Qhost :CHALLENGE");
}
		
sub check_for_q {
	my $tag = shift;
	my $server = Irssi::server_find_tag($tag);
	return unless good_server($server);
	$server->redirect_event('ison', 1, 'Q', -1, undef, {
				'event 303' => 'redir quakenet ison'});
	$server->send_raw("ISON :Q");
}

sub no_motd {
	my $tag = shift;
	check_auth($tag);
}
#-( Signal Handlers )-----------------------------------------------#

sub quakenet_help {
	Irssi::print( <<SCRIPT_HELPEOF

Info: quakenet.pl
To see all the settings for this script type:

 /SET quakenet

Settings explained:

BOOL quakenet_print_whois_pretty (default OFF)
 Set it to on if you want authnick : <authnick> in the whois reply.

BOOL quakenet_remove_colors_if_needed (default OFF)
 Set it to ON if you want all colors to be removed if channelmode +c is set.

BOOL quakenet_hide_auth_msg (default OFF)
 Set it to ON if you don't want the auth/whois msg directed to Q beeing printed.

BOOL quakenet_auto_challenge_auth (default OFF)
 Warning it's an EXPERIMENTAL feature
 This feature is new to Q aswell so it may change.
 It should work currently.

STR quakenet_auth_passwords (default empty)
 set it to <tag>/<autnick>/<password>
 if you have multiple quakenet accounts just separate them with a space
 
Example:
/SET quakenet_auth_passwords Qnet/foo/bar Quake/baz/quux
 They will be used only on the servers with the matching tag.

STR quakenet_auth_sbar_string (default Q)
 a string that will be displayed in the quakenet_auth statusbar item,
 it will be green if you are authed, if not it will be red.

This script provides a statusbar item which indicates your Q AUTH status.
It's green when you are authed, otherewise it will be red, and it's not beeing displayed
for non-quakenet servers.
See /help statusbar for infos about adding new items

Example:
/statusbar window add -after user quakenet_auth

SCRIPT_HELPEOF
	, MSGLEVEL_CLIENTCRAP);
}

sub event_whois_default_event {
	#"server event", SERVER_REC, char *data, char *sender_nick, char *sender_address
	return unless Irssi::settings_get_bool('quakenet_print_whois_pretty');
	my ($server, $data, $snick, $sender) = @_;
	return unless good_server($server);
	my $numeric = $server->parse_special('$H');
	if ($numeric eq "330") {
		my (undef, $nick, $auth_nick, undef)=split(/ /, $data, 4);
		$server->printformat($nick, MSGLEVEL_CRAP, 'whois_auth', $nick, $auth_nick);
		Irssi::signal_stop();
 	} 
	if ($numeric eq "338") {
		my (undef, $nick, $userhost, $ip, undef) = split(/ /, $data, 5);
		$server->printformat($nick, MSGLEVEL_CRAP, 'whois_ip', $nick, $ip);
		$server->printformat($nick, MSGLEVEL_CRAP, 'whois_host', $nick, $userhost);
		Irssi::signal_stop();
	}

}

sub event_whois_auth {
	return unless Irssi::settings_get_bool('quakenet_print_whois_pretty');
	my ($server, $data) = @_;
	return unless good_server($server);
	my ($num, $nick, $auth_nick) = split(/ /, $data, 3);
	$auth_nick=~s/\ :.*//;
	$server->printformat($nick, MSGLEVEL_CRAP, 'whois_auth', $nick, $auth_nick);
	Irssi::signal_stop();
}

sub event_whois_userip {
	return unless Irssi::settings_get_bool('quakenet_print_whois_pretty');
	my ($server, $data) = @_;
	return unless good_server($server);
	my ($num, $nick, $userhost, $ip) = split(/ /, $data, 4);
	$ip=~s/\ :.*//;
	$server->printformat($nick, MSGLEVEL_CRAP, 'whois_ip', $nick, $ip);
	$server->printformat($nick, MSGLEVEL_CRAP, 'whois_host', $nick, $userhost);
	Irssi::signal_stop();
}

sub event_hidden_host {
	return unless Irssi::settings_get_bool('quakenet_print_whois_pretty');
	my ($server, $data) = @_;
	return unless good_server($server);
	my ($num, $nick, $hiddenhost) = split (/ /, $_[1], 4);
	$hiddenhost=~s/\ :.*//;
	$server->printformat($nick, MSGLEVEL_CRAP, 'hidden_host', $nick, $nick);
}

sub sig_command_msg {
	return unless Irssi::settings_get_bool('quakenet_remove_colors_if_needed');
	my ($cmd, $server, $winitem) = @_;
	my ($param, $target, $data) = $cmd =~ /^(-\S*\s)?(\S*)\s(.*)/;
	return unless good_server($server);
	if ($winitem && ($winitem->{type} eq "CHANNEL") && ($winitem->{mode}=~/^[^ ]*c/) && is_colored($data)) {
		$data=~s/\x03\d?\d?(,\d?\d?)?//g; #strip mirc color code
		$data=~s/\033.*?m//g; #strip ansi colors
		$data=~s/\033//g if is_colored($data); #strip left ansi sequences if any
		$winitem->command("msg $target $data");
		Irssi::signal_stop();
	}
}

sub send_connected {
	my $server= shift;
	return if (!defined($stopped{$server->{'tag'}}) && $stopped{$server->{'tag'}} != 1);
	$stopped{$server->{'tag'}} = 0;
	Irssi::signal_emit('event connected', $server);
}

sub event_notice {
	my ($server, $msg, $nick, $addr, $target) =@_;
	return unless (Irssi::settings_get_str('quakenet_auth_passwords') ne '');
	return unless good_server($server);
	return if defined($authed{$server->{'tag'}});
	return unless ($nick eq 'Q');
	return unless ($addr eq 'TheQBot@CServe.quakenet.org');
	if ($msg=~/Due to overload your command cannot be processed at present/) {
		return if defined $flood{$server->{'tag'}};
		$server->printformat($nick, MSGLEVEL_CRAP, 'quakenet_q_overloaded');
		my $timeout = Irssi::settings_get_time('quakenet_ison_timeout');
		Irssi::timeout_add_once($timeout, "send_challenge", $server->{'tag'});
		$flood{$server->{'tag'}} = 1;
		return;
	}
	if ($msg=~/CHALLENGEAUTH\'d successfully/) {
		send_connected($server);
		check_auth($server->{'tag'});
		refresh_auth_sbar_later();
		return;
	}
	if ($msg=~/are already authed/) {
		check_auth($server->{'tag'});
		return;
	}
	if ($msg=~/^CHALLENGE (.+) (.+)$/) {
		my ($digestfunc, $cookie) = ($1,$2);
		#don't get confused by /msg Q help challenge replies
		return if ($digestfunc =~/<digest function>/);
		my @passwords = split (/ /, Irssi::settings_get_str('quakenet_auth_passwords'));
		my ($pwtag, $authnick, $pw);
		foreach my $password (@passwords) {
			($pwtag, $authnick, $pw) = split("/", $password, 3);
			next if (lc $server->{'tag'} ne lc $pwtag);
			if ($pw ne "" && $authnick ne "") {
				my $digest;
				if ($digestfunc eq 'MD5') {
					$digest = md5_hex($pw.' '.$cookie);
				}
				if ($digest) {
					$server->send_raw("PRIVMSG $Qhost :CHALLENGEAUTH $authnick $digest");
					Irssi::signal_stop();
				} else {
					Irssi::print("Challenge with a unsupported digestfunction $digestfunc requested", MSGLEVEL_CRAP);
				}
			}
		}
	} 
}

sub quakenet_ison {
	my ($server, $text) = @_;
	if (defined($authed{$server->{'tag'}})) {
		Irssi::signal_stop();
		return;
	}
	if ($text =~ /:\QQ\E\s?$/i) {
		$server->printformat($server->{'nick'}, MSGLEVEL_CRAP, 'quakenet_q_online');
		send_challenge($server->{'tag'});
	} else {
		#if Q is offline, we check again in 60s. TODO: make this a setting.
		$server->printformat($server->{'nick'}, MSGLEVEL_CRAP, 'quakenet_q_offline');
		my $timeout = Irssi::settings_get_time('quakenet_ison_timeout');
		Irssi::timeout_add_once($timeout, 'check_for_q', $server->{'tag'});
	}
	Irssi::signal_stop();
}

sub event_connected {
	my $server = shift;
	return unless Irssi::settings_get_bool('quakenet_auto_challengeauth');
	return unless good_server($server);
	return if defined($stopped{$server->{'tag'}} && $stopped{$server->{'tag'}} == 1);
	my @passwords = split (/ /, Irssi::settings_get_str('quakenet_auth_passwords'));
	return unless @passwords;
	my $network;
	foreach my $password (@passwords) {
		($network,undef) = split ("/", $password,2);
		if (lc $server->{'tag'} eq lc $network) {
			$stopped{$server->{'tag'}} = 1;
			#check if Q is online
			#$server->printformat($server->{'nick'}, MSGLEVEL_CRAP,'quakenet_found', $server->{'tag'});
			#Irssi::timeout_add_once(250, "check_for_q", $server->{'tag'});
			$motd_timeout{$server->{'tag'}} = Irssi::timeout_add_once(2000, "no_motd", $server->{'tag'});
			Irssi::signal_stop();
			return;
		}
	}
}

sub event_motd_end {
	my $server = shift;
	my @passwords = split (/ /, Irssi::settings_get_str('quakenet_auth_passwords'));
	return unless @passwords;
	my $network;
	foreach my $password (@passwords) {
		($network,undef) = split ("/", $password,2);
		if (lc $server->{'tag'} eq lc $network) {
			#check if Q is online
			$server->printformat($server->{'nick'}, MSGLEVEL_CRAP,'quakenet_found', $server->{'tag'});
			if (defined $motd_timeout{$server->{'tag'}} && $motd_timeout{$server->{'tag'}}) {
				Irssi::timeout_remove($motd_timeout{$server->{'tag'}});
				delete($motd_timeout{$server->{'tag'}});
			}
			Irssi::timeout_add_once(250, "check_for_q", $server->{'tag'});
			return;
		}
	}
}

sub server_disconnected {
	my $server = shift;
	if (defined($authed{$server->{'tag'}})) {
		delete($authed{$server->{'tag'}});
	}
	if (defined($stopped{$server->{'tag'}})) {
		delete($stopped{$server->{'tag'}});
	}
	refresh_auth_sbar_later();
}

sub intercept_message {
	return unless Irssi::settings_get_bool("quakenet_hide_auth_msg");
	my ($server, $message, $target, $orig_target) = @_;
	return unless good_server($server);
	if (($target =~ /^q$/i || $target=~ /^$Qhost$/i) && ($message =~ /^auth/i)) {
		Irssi::signal_stop();
	}
}

sub refresh_auth_sbar() {
	Irssi::statusbar_items_redraw('quakenet_auth');
}

sub refresh_auth_sbar_later() {
	Irssi::timeout_add_once(100, "refresh_auth_sbar", undef);
}

sub sb_auth() {
	my ($item, $get_size_only) = @_;
	my $authstr = Irssi::settings_get_str("quakenet_auth_sbar_string");
        my $server;
	if (Irssi::active_win->{'active'}) {
        	$server = Irssi::active_win->{'active'}->{'server'};
	} elsif (Irssi::active_win->{'active_server'}) {
		$server = Irssi::active_win->{'active_server'};
        } 
	my $tmpout;
	if (good_server($server)) {
		if (defined($authed{$server->{'tag'}})) {
			$tmpout = "%g$authstr";
		} else {
			$tmpout = "%r$authstr";
		}
	} else {
		$tmpout = "";
	}
	$authbar = $tmpout;
	$item->{min_size} = $item->{max_size} = length($tmpout);
	$item->default_handler($get_size_only, "{sb $authbar}", "", 1);
}

sub quakenet_authed {
        my ($server, $data) = @_;
	my ($num, $nick, $auth_nick, undef) = split(/ /, $data, 4);
	if ($nick eq $server->{nick}) {
		$server->printformat($nick, MSGLEVEL_CRAP, 'quakenet_authed', $auth_nick, $server->{'tag'});
		$authed{$server->{'tag'}} = 1;
	}
	refresh_auth_sbar_later();
}

sub read_settings {
	my $timeout = Irssi::settings_get_time('quakenet_ison_timeout');
	if ($timeout < 10000) {
		Irssi::print('Setting quakenet_ison_timeout to 10s');
		Irssi::settings_set_time('quakenet_ison_timeout', '10s');
	}
	
}

#-( Register Signals )----------------------------------------------#

Irssi::command_bind('quakenet', 
sub { 
	my ($data,$server,$item) = @_; 
	if ($data =~ /^help/i) {
		Irssi::command_runsub('quakenet', $data, $server, $item);
	}
} );

Irssi::signal_add('setup changed', 'read_settings');
Irssi::command_bind('help quakenet', 'quakenet_help');
Irssi::command_bind('quakenet help', 'quakenet_help');
Irssi::command_bind('msg', 'sig_command_msg'); 
Irssi::signal_add('event 330', 'event_whois_auth');
Irssi::signal_add('event 338', 'event_whois_userip');
Irssi::signal_add('event 376', 'event_motd_end');
Irssi::signal_add('event 422', 'event_motd_end');
Irssi::signal_add('whois default event', 'event_whois_default_event');
Irssi::signal_add_first('event 396', 'event_hidden_host');
Irssi::signal_add_first('message own_private', 'intercept_message');
Irssi::signal_add_first('message irc notice', 'event_notice');
Irssi::signal_add_first('event connected', 'event_connected');
Irssi::signal_add_first('server disconnected', 'server_disconnected');
Irssi::signal_add_first('redir quakenet ison', 'quakenet_ison');
Irssi::signal_add_first('redir quakenet authed', 'quakenet_authed');
Irssi::signal_add('window item changed', 'refresh_auth_sbar_later');
Irssi::signal_add('window item server changed', 'refresh_auth_sbar_later');

#-( Register Stautsbar )---------------------------------------------#

Irssi::statusbar_item_register('quakenet_auth', "", 'sb_auth');

#-( Register Settings )---------------------------------------------#

Irssi::settings_add_bool('quakenet', 'quakenet_print_whois_pretty', 0);
Irssi::settings_add_bool('quakenet', 'quakenet_remove_colors_if_needed', 0);
Irssi::settings_add_bool('quakenet', 'quakenet_hide_auth_msg', 0);
Irssi::settings_add_bool('quakenet', 'quakenet_auto_challengeauth', 0);
Irssi::settings_add_str ('quakenet', 'quakenet_auth_passwords', '');
Irssi::settings_add_str ('quakenet', 'quakenet_auth_sbar_string', 'Q');
Irssi::settings_add_time('quakenet', 'quakenet_ison_timeout', "60s");

#-( Inititalisation )-----------------------------------------------#

init_auth();