Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
198 lines (167 sloc) 5.45 KB
# vim: ft=perl
use strict;
use Irssi;
use vars qw($VERSION %IRSSI);
## Settings:
#
# quakenet_account (string) = ( [<servertag>:]<username>:<password> )*
#
# Your QuakeNet account details, in format <username>:<password>. Example:
#
# /set quakenet_account [fishking]:iLOVEfish12345
#
# Different accounts for different Irssi "networks" ("server tags") can be
# set in format <servertag>:<username>:<password> (space-separated). The
# account with empty (or missing) <servertag> will be used as the default
# account for all other connections.)
#
# quakenet_auth_allowed_mechs (string) = any
#
# List of allowed mechanisms, separated by spaces.
# Can be "any" to allow all supported mechanisms.
#
# Currently supported:
# HMAC-SHA-256 (Digest::SHA)
# HMAC-SHA-1 (Digest::SHA1)
# HMAC-MD5 (Digest::MD5)
# LEGACY-MD5 (Digest::MD5 without HMAC)
#
# Note: LEGACY-MD5 is excluded from "any"; if you want to use it, specify
# it manually.
#
## To trigger the script manually, use:
## /msg Q@cserve.quakenet.org challenge
$VERSION = "1.0";
%IRSSI = (
authors => 'Mantas Mikulėnas',
contact => 'grawity@gmail.com',
name => 'auth_quakenet_challenge.pl',
description => "Implements QuakeNet's CHALLENGE authentication",
license => 'WTFPL v2 <http://sam.zoy.org/wtfpl/>',
url => 'http://purl.net/net/grawity/irssi.html',
);
require Digest::HMAC;
my @preferred_mechs = qw(HMAC-SHA-256 HMAC-SHA-1 HMAC-MD5);
my %supported_mechs = ();
eval {
require Digest::SHA;
$supported_mechs{"HMAC-SHA-256"} = sub {
hmac(\&Digest::SHA::sha256_hex, \&Digest::SHA::sha256, @_);
};
};
eval {
require Digest::SHA1;
$supported_mechs{"HMAC-SHA-1"} = sub {
hmac(\&Digest::SHA1::sha1_hex, \&Digest::SHA1::sha1, @_);
};
};
eval {
require Digest::MD5;
$supported_mechs{"HMAC-MD5"} = sub {
hmac(\&Digest::MD5::md5_hex, \&Digest::MD5::md5, @_);
};
$supported_mechs{"LEGACY-MD5"} = sub {
Irssi::print("WARNING: LEGACY-MD5 should not be used.");
my ($challenge, $username, $password) = @_;
Digest::MD5::md5_hex($password . " " . $challenge);
};
};
if (scalar keys %supported_mechs == 0) {
die "No mechanisms available. Please install these Perl modules:\n"
." - Digest::HMAC\n"
." - Digest::SHA, Digest::SHA1, Digest::MD5 (at least one)\n";
}
sub hmac {
my ($fnhex, $fnraw, $challenge, $username, $password) = @_;
my $key = &$fnhex($username . ":" . &$fnhex($password));
Digest::HMAC::hmac_hex($challenge, $key, $fnraw);
}
sub lcnick {
my $str = shift;
$str =~ tr/[\\]/{|}/;
lc $str;
}
sub get_account {
my ($servertag) = @_;
my $accounts = Irssi::settings_get_str("quakenet_account");
my ($defuser, $defpass) = (undef, undef);
for my $acct (split /\s+/, $accounts) {
my ($tag, $user, $pass);
my @acct = split(/:/, $acct);
if (@acct == 3) {
($tag, $user, $pass) = @acct;
} elsif (@acct == 2) {
($tag, $user, $pass) = ("*", @acct);
} else {
next;
}
if (lc $tag eq lc $servertag) {
return ($user, $pass);
}
elsif ($tag eq "*" or $tag eq "") {
($defuser, $defpass) = ($user, $pass);
}
}
return ($defuser, $defpass);
}
Irssi::signal_add_last("event 001" => sub {
my ($server, $evargs, $srcnick, $srcaddr) = @_;
return unless $srcnick =~ /\.quakenet\.org$/;
my ($user, $pass) = get_account($server->{tag});
return if !length($pass);
$server->print("", "Authenticating to Q");
$server->send_message('Q@cserve.quakenet.org', "CHALLENGE", 1);
});
Irssi::signal_add_first("message irc notice" => sub {
my ($server, $msg, $nick, $address, $target) = @_;
return unless $server->mask_match_address('Q!*@cserve.quakenet.org', $nick, $address);
if ($msg =~ /^CHALLENGE ([0-9a-f]+) (.+)$/) {
Irssi::signal_stop();
my $challenge = $1;
my @server_mechs = split(" ", $2);
my ($user, $pass) = get_account($server->{tag});
return if !length($pass);
$user = lcnick($user);
$pass = substr($pass, 0, 10);
my $mech;
my @allowed_mechs = ();
my $allowed_mechs = uc Irssi::settings_get_str("quakenet_auth_allowed_mechs");
if ($allowed_mechs eq "ANY") {
# @preferred_mechs is sorted by strength
@allowed_mechs = @preferred_mechs;
} else {
@allowed_mechs = split(/\s+/, $allowed_mechs);
}
# choose first mech supported by both sides
for my $m (@allowed_mechs) {
if (grep {$_ eq $m} @server_mechs &&
grep {$_ eq $m} (keys %supported_mechs)) {
$mech = $m;
last;
}
}
if (!defined $mech) {
$server->print("", "Authentication failed (no mechanisms available)");
$server->print("", " Server offers: ".join(", ", @server_mechs));
$server->print("", " Client supports: ".join(", ", keys %supported_mechs));
$server->print("", " Restricted to: ".join(", ", @allowed_mechs));
return;
}
my $authfn = $supported_mechs{$mech};
my $response = &$authfn($challenge, $user, $pass);
$server->send_message('Q@cserve.quakenet.org', "CHALLENGEAUTH $user $response $mech", 1);
}
elsif ($msg =~ /^You are now logged in as (.+?)\.$/) {
Irssi::signal_stop();
$server->print("", "Authentication successful, logged in as $1");
}
elsif ($msg =~ /^Username or password incorrect\.$/) {
Irssi::signal_stop();
$server->print("", "Authentication failed (username or password incorrect)");
}
});
Irssi::settings_add_str("misc", "quakenet_auth_allowed_mechs", "any");
Irssi::settings_add_str("misc", "quakenet_account", "");
if (Irssi::settings_get_str("quakenet_account") eq "") {
Irssi::print("Set your QuakeNet account using /set quakenet_account username:password");
}