--- /dev/null
+# 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");
+}
git.99rst.org / irssi-scripts.irssi.org.git / commitdiff