use strict;

use Irssi;

use MIME::Base64;

use vars qw($VERSION %IRSSI);

use constant CHALLENGE_SIZE => 32;

$VERSION = "1.11";

%IRSSI = (

authors => 'Michael Tharp (gxti), Jilles Tjoelker (jilles), Mantas Mikulėnas (grawity)',

contact => '[email protected]',

name => 'cap_sasl.pl',

description => 'Implements SASL authentication and enables CAP "multi-prefix"',

license => 'GPLv2',

url => 'http://ircv3.atheme.org/extensions/sasl-3.1',

);

my %sasl_auth = ();

my %mech = ();

sub irssi_abspath {

my $f = shift;

$f =~ s!^~/!$ENV{HOME}/!;

if ($f !~ m!^/!) {

$f = Irssi::get_irssi_dir()."/".$f;

}

return $f;

}

sub timeout;

sub server_connected {

my $server = shift;

if (uc $server->{chat_type} eq 'IRC') {

$server->send_raw_now("CAP LS");

}

}

sub event_cap {

my ($server, $args, $nick, $address) = @_;

my ($subcmd, $caps, $tosend, $sasl);

$tosend = '';

$sasl = $sasl_auth{$server->{tag}};

if ($args =~ /^\S+ (\S+) :(.*)$/) {

$subcmd = uc $1;

$caps = ' '.$2.' ';

if ($subcmd eq 'LS') {

$tosend .= ' multi-prefix' if $caps =~ / multi-prefix /i;

$tosend .= ' sasl' if $caps =~ / sasl /i && defined($sasl);

$tosend =~ s/^ //;

$server->print('', "CLICAP: supported by server:$caps");

if (!$server->{connected}) {

if ($tosend eq '') {

$server->send_raw_now("CAP END");

} else {

$server->print('', "CLICAP: requesting: $tosend");

$server->send_raw_now("CAP REQ :$tosend");

}

}

Irssi::signal_stop();

} elsif ($subcmd eq 'ACK') {

$server->print('', "CLICAP: now enabled:$caps");

if ($caps =~ / sasl /i) {

$sasl->{buffer} = '';

$sasl->{step} = 0;

if ($mech{$sasl->{mech}}) {

$server->send_raw_now("AUTHENTICATE " . $sasl->{mech});

Irssi::timeout_add_once(7500, \&timeout, $server->{tag});

} else {

$server->print('', 'SASL: attempted to start unknown mechanism "' . $sasl->{mech} . '"');

}

}

elsif (!$server->{connected}) {

$server->send_raw_now("CAP END");

}

Irssi::signal_stop();

} elsif ($subcmd eq 'NAK') {

$server->print('', "CLICAP: refused:$caps");

if (!$server->{connected}) {

$server->send_raw_now("CAP END");

}

Irssi::signal_stop();

} elsif ($subcmd eq 'LIST') {

$server->print('', "CLICAP: currently enabled:$caps");

Irssi::signal_stop();

}

}

}

sub event_authenticate {

my ($server, $args, $nick, $address) = @_;

my $sasl = $sasl_auth{$server->{tag}};

return unless $sasl && $mech{$sasl->{mech}};

$sasl->{buffer} .= $args;

return if length($args) == 400;

my $data = ($sasl->{buffer} eq '+') ? '' : decode_base64($sasl->{buffer});

my $out = $mech{$sasl->{mech}}($sasl, $data);

if (defined $out) {

$out = ($out eq '') ? '+' : encode_base64($out, '');

while (length $out >= 400) {

my $subout = substr($out, 0, 400, '');

$server->send_raw_now("AUTHENTICATE $subout");

}

if (length $out) {

$server->send_raw_now("AUTHENTICATE $out");

} else {

# Last piece was exactly 400 bytes, we have to send

# some padding to indicate we're done.

$server->send_raw_now("AUTHENTICATE +");

}

} else {

$server->send_raw_now("AUTHENTICATE *");

}

$sasl->{buffer} = "";

Irssi::signal_stop();

}

sub event_saslend {

my ($server, $args, $nick, $address) = @_;

my $data = $args;

$data =~ s/^\S+ :?//;

# need this to see it, ?? -- jilles

$server->print('', $data);

if (!$server->{connected}) {

$server->send_raw_now("CAP END");

}

}

sub event_saslfail {

my ($server, $args, $nick, $address) = @_;

my $data = $args;

$data =~ s/^\S+ :?//;

if (Irssi::settings_get_bool('sasl_disconnect_on_fail')) {

$server->print('', "$data - disconnecting from server", MSGLEVEL_CLIENTERROR);

$server->disconnect();

} else {

$server->print('', "$data - continuing anyway");

if (!$server->{connected}) {

$server->send_raw_now("CAP END");

}

}

}

sub timeout {

my $tag = shift;

my $server = Irssi::server_find_tag($tag);

if ($server && !$server->{connected}) {

$server->print('', "SASL: authentication timed out", MSGLEVEL_CLIENTERROR);

$server->send_raw_now("CAP END");

}

}

sub cmd_sasl {

my ($data, $server, $item) = @_;

if ($data ne '') {

Irssi::command_runsub ('sasl', $data, $server, $item);

} else {

cmd_sasl_show(@_);

}

}

sub cmd_sasl_set {

my ($data, $server, $item) = @_;

if (my ($net, $u, $p, $m) = $data =~ /^(\S+) (\S+) (\S+) (\S+)$/) {

if ($mech{uc $m}) {

$sasl_auth{$net}{user} = $u;

$sasl_auth{$net}{password} = $p;

$sasl_auth{$net}{mech} = uc $m;

Irssi::print("SASL: added $net: [$m] $sasl_auth{$net}{user} *");

} else {

Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR);

}

} elsif ($data =~ /^(\S+)$/) {

$net = $1;

if (defined($sasl_auth{$net})) {

delete $sasl_auth{$net};

Irssi::print("SASL: deleted $net");

} else {

Irssi::print("SASL: no entry for $net");

}

} else {

Irssi::print("SASL: usage: /sasl set <net> <user> <password or keyfile> <mechanism>");

}

}

sub cmd_sasl_show {

#my ($data, $server, $item) = @_;

my @nets = keys %sasl_auth;

for my $net (@nets) {

Irssi::print("SASL: $net: [$sasl_auth{$net}{mech}] $sasl_auth{$net}{user} *");

}

Irssi::print("SASL: no networks defined") if !@nets;

}

sub cmd_sasl_save {

#my ($data, $server, $item) = @_;

my $file = Irssi::get_irssi_dir()."/sasl.auth";

if (open(my $fh, ">", $file)) {

chmod(0600, $file);

for my $net (keys %sasl_auth) {

printf $fh ("%s\t%s\t%s\t%s\n",

$net,

$sasl_auth{$net}{user},

$sasl_auth{$net}{password},

$sasl_auth{$net}{mech});

}

close($fh);

Irssi::print("SASL: auth saved to '$file'");

} else {

Irssi::print("SASL: couldn't access '$file': $@");

}

}

sub cmd_sasl_load {

#my ($data, $server, $item) = @_;

my $file = Irssi::get_irssi_dir()."/sasl.auth";

if (open(my $fh, "<", $file)) {

%sasl_auth = ();

while (<$fh>) {

chomp;

my ($net, $u, $p, $m) = split(/\t/, $_, 4);

$m ||= "PLAIN";

if ($mech{uc $m}) {

$sasl_auth{$net}{user} = $u;

$sasl_auth{$net}{password} = $p;

$sasl_auth{$net}{mech} = uc $m;

} else {

Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR);

}

}

close($fh);

Irssi::print("SASL: cap_sasl $VERSION, auth loaded from '$file'");

}

}

sub cmd_sasl_mechanisms {

Irssi::print("SASL: mechanisms supported: " . join(", ", sort keys %mech));

}

Irssi::settings_add_bool('server', 'sasl_disconnect_on_fail', 1);

Irssi::signal_add_first('server connected', \&server_connected);

Irssi::signal_add('event cap', \&event_cap);

Irssi::signal_add('event authenticate', \&event_authenticate);

Irssi::signal_add('event 903', \&event_saslend);

Irssi::signal_add('event 904', \&event_saslfail);

Irssi::signal_add('event 905', \&event_saslend);

Irssi::signal_add('event 906', \&event_saslfail);

Irssi::signal_add('event 907', \&event_saslend);

Irssi::command_bind('sasl', \&cmd_sasl);

Irssi::command_bind('sasl load', \&cmd_sasl_load);

Irssi::command_bind('sasl save', \&cmd_sasl_save);

Irssi::command_bind('sasl set', \&cmd_sasl_set);

Irssi::command_bind('sasl show', \&cmd_sasl_show);

Irssi::command_bind('sasl mechanisms', \&cmd_sasl_mechanisms);

$mech{PLAIN} = sub {

my ($sasl, $data) = @_;

my $u = $sasl->{user};

my $p = $sasl->{password};

return join("\0", $u, $u, $p);

};

$mech{EXTERNAL} = sub {

my ($sasl, $data) = @_;

return $sasl->{user} // "";

};

if (eval {require Crypt::PK::ECC}) {

my $mech = "ECDSA-NIST256P-CHALLENGE";

$mech{'ECDSA-NIST256P-CHALLENGE'} = sub {

my ($sasl, $data) = @_;

my $u = $sasl->{user};

my $f = $sasl->{password};

$f = irssi_abspath($f);

if (!-f $f) {

Irssi::print("SASL: key file '$f' not found", MSGLEVEL_CLIENTERROR);

return;

}

my $pk = eval {Crypt::PK::ECC->new($f)};

if ($@ || !$pk || !$pk->is_private) {

Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR);

return;

}

my $step = ++$sasl->{step};

if ($step == 1) {

if (length $data == CHALLENGE_SIZE) {

my $sig = $pk->sign_hash($data);

return $u."\0".$u."\0".$sig;

} elsif (length $data) {

return;

} else {

return $u."\0".$u;

}

}

elsif ($step == 2) {

if (length $data == CHALLENGE_SIZE) {

return $pk->sign_hash($data);

} else {

return;

}

}

};

Irssi::command_bind("sasl keygen" => sub {

my ($data, $server, $witem) = @_;

my $print = $server

? sub { $server->print("", shift, shift // MSGLEVEL_CLIENTNOTICE) }

: sub { Irssi::print(shift, shift // MSGLEVEL_CLIENTNOTICE) };

my $net = $server ? $server->{tag} : $data;

if (!length $net) {

Irssi::print("SASL: please connect to a server first",

MSGLEVEL_CLIENTERROR);

return;

}

my $f_name = lc "sasl-ecdsa-$net";

$f_name =~ s![ /]+!_!g;

my $f_priv = Irssi::get_irssi_dir()."/$f_name.key";

my $f_pub = Irssi::get_irssi_dir()."/$f_name.pub";

if (-e $f_priv) {

$print->("SASL: refusing to overwrite '$f_priv'", MSGLEVEL_CLIENTERROR);

return;

}

$print->("SASL: generating keypair for '$net'...");

my $pk = Crypt::PK::ECC->new;

$pk->generate_key("prime256v1");

my $priv = $pk->export_key_pem("private");

my $pub = encode_base64($pk->export_key_raw("public_compressed"), "");

if (open(my $fh, ">", $f_priv)) {

chmod(0600, $f_priv);

print $fh $priv;

close($fh);

$print->("SASL: wrote private key to '$f_priv'");

} else {

$print->("SASL: could not write '$f_priv': $!", MSGLEVEL_CLIENTERROR);

return;

}

if (open(my $fh, ">", $f_pub)) {

print $fh $pub."\n";

close($fh);

} else {

$print->("SASL: could not write '$f_pub': $!", MSGLEVEL_CLIENTERROR);

}

my $cmdchar = substr(Irssi::settings_get_str("cmdchars"), 0, 1);

my $cmd = "msg NickServ SET PUBKEY $pub";

if ($server) {

$print->("SASL: updating your Irssi settings...");

$sasl_auth{$net}{user} //= $server->{nick};

$sasl_auth{$net}{password} = "$f_name.key";

$sasl_auth{$net}{mech} = $mech;

cmd_sasl_save(@_);

$print->("SASL: submitting pubkey to NickServ...");

$server->command($cmd);

} else {

$print->("SASL: update your Irssi settings:");

$print->("%P".$cmdchar."sasl set $net <nick> $f_name.key $mech");

$print->("SASL: submit your pubkey to $net:");

$print->("%P".$cmdchar.$cmd);

}

});

Irssi::command_bind("sasl pubkey" => sub {

my ($data, $server, $witem) = @_;

my $arg = $server ? $server->{tag} : $data;

my $f;

if (!length $arg) {

Irssi::print("SASL: please select a server or specify a keyfile path",

MSGLEVEL_CLIENTERROR);

return;

} elsif ($arg =~ m![/.]!) {

$f = $arg;

} else {

if ($sasl_auth{$arg}{mech} eq $mech) {

$f = $sasl_auth{$arg}{password};

} else {

$f = lc "sasl-ecdsa-$arg";

$f =~ s![ /]+!_!g;

$f = "$f.key";

}

}

$f = irssi_abspath($f);

if (!-e $f) {

Irssi::print("SASL: keyfile '$f' not found", MSGLEVEL_CLIENTERROR);

return;

}

my $pk = eval {Crypt::PK::ECC->new($f)};

if ($@ || !$pk || !$pk->is_private) {

Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR);

Irssi::print("(keys using named parameters or PKCS#8 are not yet supported)",

MSGLEVEL_CLIENTERROR);

return;

}

my $pub = encode_base64($pk->export_key_raw("public_compressed"), "");

Irssi::print("SASL: loaded keyfile '$f'");

Irssi::print("SASL: your pubkey is $pub");

});

} else {

Irssi::command_bind("sasl keygen" => sub {

Irssi::print("SASL: cannot '/sasl keygen' as the Perl 'CryptX' module is missing",

MSGLEVEL_CLIENTERROR);

});

Irssi::command_bind("sasl pubkey" => sub {

Irssi::print("SASL: cannot '/sasl pubkey' as the Perl 'CryptX' module is missing",

MSGLEVEL_CLIENTERROR);

});

}

cmd_sasl_load();