dotfiles/irssi/scripts/cap_sasl.pl

   1 use strict;
   2 use Irssi;
   3 use vars qw($VERSION %IRSSI);
   4 # $Id$
   5
   6 use MIME::Base64;
   7
   8 $VERSION = "1.1";
   9
  10 %IRSSI = (
  11     authors     => 'Michael Tharp and Jilles Tjoelker',
  12     contact     => 'gxti@partiallystapled.com',
  13     name        => 'cap_sasl.pl',
  14     description => 'Implements PLAIN SASL authentication mechanism for use with charybdis ircds, and enables CAP MULTI-PREFIX',
  15     license     => 'GNU General Public License',
  16     url         => 'http://sasl.charybdis.be/',
  17 );
  18
  19 my %sasl_auth = ();
  20 my %mech = ();
  21
  22 sub timeout;
  23
  24 sub server_connected {
  25         my $server = shift;
  26         $server->send_raw_now("CAP LS");
  27 }
  28
  29 sub event_cap {
  30         my ($server, $args, $nick, $address) = @_;
  31         my ($subcmd, $caps, $tosend);
  32
  33         $tosend = '';
  34         if ($args =~ /^\S+ (\S+) :(.*)$/) {
  35                 $subcmd = uc $1;
  36                 $caps = ' '.$2.' ';
  37                 if ($subcmd eq 'LS') {
  38                         $tosend .= ' multi-prefix' if $caps =~ / multi-prefix /i;
  39                         $tosend .= ' sasl' if $caps =~ / sasl /i && defined($sasl_auth{$server->{tag}});
  40                         $tosend =~ s/^ //;
  41                         $server->print('', "CLICAP: supported by server:$caps");
  42                         if (!$server->{connected}) {
  43                                 if ($tosend eq '') {
  44                                         $server->send_raw_now("CAP END");
  45                                 } else {
  46                                         $server->print('', "CLICAP: requesting: $tosend");
  47                                         $server->send_raw_now("CAP REQ :$tosend");
  48                                 }
  49                         }
  50                         Irssi::signal_stop();
  51                 } elsif ($subcmd eq 'ACK') {
  52                         $server->print('', "CLICAP: now enabled:$caps");
  53                         if ($caps =~ / sasl /i) {
  54                                 $sasl_auth{$server->{tag}}{buffer} = '';
  55                                 if($mech{$sasl_auth{$server->{tag}}{mech}}) {
  56                                         $server->send_raw_now("AUTHENTICATE " . $sasl_auth{$server->{tag}}{mech});
  57                                         Irssi::timeout_add_once(5000, \&timeout, $server->{tag});
  58                                 }else{
  59                                         $server->print('', 'SASL: attempted to start unknown mechanism "' . $sasl_auth{$server->{tag}}{mech} . '"');
  60                                 }
  61                         }
  62                         elsif (!$server->{connected}) {
  63                                 $server->send_raw_now("CAP END");
  64                         }
  65                         Irssi::signal_stop();
  66                 } elsif ($subcmd eq 'NAK') {
  67                         $server->print('', "CLICAP: refused:$caps");
  68                         if (!$server->{connected}) {
  69                                 $server->send_raw_now("CAP END");
  70                         }
  71                         Irssi::signal_stop();
  72                 } elsif ($subcmd eq 'LIST') {
  73                         $server->print('', "CLICAP: currently enabled:$caps");
  74                         Irssi::signal_stop();
  75                 }
  76         }
  77 }
  78
  79 sub event_authenticate {
  80         my ($server, $args, $nick, $address) = @_;
  81         my $sasl = $sasl_auth{$server->{tag}};
  82         return unless $sasl && $mech{$sasl->{mech}};
  83
  84         $sasl->{buffer} .= $args;
  85         return if length($args) == 400;
  86
  87         my $data = $sasl->{buffer} eq '+' ? '' : decode_base64($sasl->{buffer});
  88         my $out = $mech{$sasl->{mech}}($sasl, $data);
  89         $out = '' unless defined $out;
  90         $out = $out eq '' ? '+' : encode_base64($out, '');
  91
  92         while(length $out >= 400) {
  93                 my $subout = substr($out, 0, 400, '');
  94                 $server->send_raw_now("AUTHENTICATE $subout");
  95         }
  96         if(length $out) {
  97                 $server->send_raw_now("AUTHENTICATE $out");
  98         }else{ # Last piece was exactly 400 bytes, we have to send some padding to indicate we're done
  99                 $server->send_raw_now("AUTHENTICATE +");
 100         }
 101
 102         $sasl->{buffer} = '';
 103         Irssi::signal_stop();
 104 }
 105
 106 sub event_saslend {
 107         my ($server, $args, $nick, $address) = @_;
 108
 109         my $data = $args;
 110         $data =~ s/^\S+ :?//;
 111         # need this to see it, ?? -- jilles
 112         $server->print('', $data);
 113         if (!$server->{connected}) {
 114                 $server->send_raw_now("CAP END");
 115         }
 116 }
 117
 118 sub timeout {
 119         my $tag = shift;
 120         my $server = Irssi::server_find_tag($tag);
 121         if(!$server->{connected}) {
 122                 $server->print('', "SASL: authentication timed out");
 123                 $server->send_raw_now("CAP END");
 124         }
 125 }
 126
 127 sub cmd_sasl {
 128         my ($data, $server, $item) = @_;
 129
 130         if ($data ne '') {
 131                 Irssi::command_runsub ('sasl', $data, $server, $item);
 132         } else {
 133                 cmd_sasl_show(@_);
 134         }
 135 }
 136
 137 sub cmd_sasl_set {
 138         my ($data, $server, $item) = @_;
 139
 140         if (my($net, $u, $p, $m) = $data =~ /^(\S+) (\S+) (\S+) (\S+)$/) {
 141                 if($mech{uc $m}) {
 142                         $sasl_auth{$net}{user} = $u;
 143                         $sasl_auth{$net}{password} = $p;
 144                         $sasl_auth{$net}{mech} = uc $m;
 145                         Irssi::print("SASL: added $net: [$m] $sasl_auth{$net}{user} *");
 146                 }else{
 147                         Irssi::print("SASL: unknown mechanism $m");
 148                 }
 149         } elsif ($data =~ /^(\S+)$/) {
 150                 $net = $1;
 151                 if (defined($sasl_auth{$net})) {
 152                         delete $sasl_auth{$net};
 153                         Irssi::print("SASL: deleted $net");
 154                 } else {
 155                         Irssi::print("SASL: no entry for $net");
 156                 }
 157         } else {
 158                 Irssi::print("SASL: usage: /sasl set <net> <user> <password or keyfile> <mechanism>");
 159         }
 160 }
 161
 162 sub cmd_sasl_show {
 163         #my ($data, $server, $item) = @_;
 164         my $net;
 165         my $count = 0;
 166
 167         foreach $net (keys %sasl_auth) {
 168                 Irssi::print("SASL: $net: [$sasl_auth{$net}{mech}] $sasl_auth{$net}{user} *");
 169                 $count++;
 170         }
 171         Irssi::print("SASL: no networks defined") if !$count;
 172 }
 173
 174 sub cmd_sasl_save {
 175         #my ($data, $server, $item) = @_;
 176         my $file = Irssi::get_irssi_dir()."/sasl.auth";
 177         open FILE, "> $file" or return;
 178         foreach my $net (keys %sasl_auth) {
 179                 printf FILE ("%s\t%s\t%s\t%s\n", $net, $sasl_auth{$net}{user}, $sasl_auth{$net}{password}, $sasl_auth{$net}{mech});
 180         }
 181         close FILE;
 182         Irssi::print("SASL: auth saved to $file");
 183 }
 184
 185 sub cmd_sasl_load {
 186         #my ($data, $server, $item) = @_;
 187         my $file = Irssi::get_irssi_dir()."/sasl.auth";
 188
 189         open FILE, "< $file" or return;
 190         %sasl_auth = ();
 191         while (<FILE>) {
 192                 chomp;
 193                 my ($net, $u, $p, $m) = split (/\t/, $_, 4);
 194                 $m ||= "PLAIN";
 195                 if($mech{uc $m}) {
 196                         $sasl_auth{$net}{user} = $u;
 197                         $sasl_auth{$net}{password} = $p;
 198                         $sasl_auth{$net}{mech} = uc $m;
 199                 }else{
 200                         Irssi::print("SASL: unknown mechanism $m");
 201                 }
 202         }
 203         close FILE;
 204         Irssi::print("SASL: auth loaded from $file");
 205 }
 206
 207 sub cmd_sasl_mechanisms {
 208         Irssi::print("SASL: mechanisms supported: " . join(" ", keys %mech));
 209 }
 210
 211 Irssi::signal_add_first('server connected', \&server_connected);
 212 Irssi::signal_add('event cap', \&event_cap);
 213 Irssi::signal_add('event authenticate', \&event_authenticate);
 214 Irssi::signal_add('event 903', 'event_saslend');
 215 Irssi::signal_add('event 904', 'event_saslend');
 216 Irssi::signal_add('event 905', 'event_saslend');
 217 Irssi::signal_add('event 906', 'event_saslend');
 218 Irssi::signal_add('event 907', 'event_saslend');
 219
 220 Irssi::command_bind('sasl', \&cmd_sasl);
 221 Irssi::command_bind('sasl load', \&cmd_sasl_load);
 222 Irssi::command_bind('sasl save', \&cmd_sasl_save);
 223 Irssi::command_bind('sasl set', \&cmd_sasl_set);
 224 Irssi::command_bind('sasl show', \&cmd_sasl_show);
 225 Irssi::command_bind('sasl mechanisms', \&cmd_sasl_mechanisms);
 226
 227 $mech{PLAIN} = sub {
 228         my($sasl, $data) = @_;
 229         my $u = $sasl->{user};
 230         my $p = $sasl->{password};
 231
 232         join("\0", $u, $u, $p);
 233 };
 234
 235 eval {
 236         use Crypt::OpenSSL::Bignum;
 237         use Crypt::DH;
 238         use Crypt::Blowfish;
 239         use Math::BigInt;
 240         sub bin2bi { return Crypt::OpenSSL::Bignum->new_from_bin(shift)->to_decimal } # binary to BigInt
 241         sub bi2bin { return Crypt::OpenSSL::Bignum->new_from_decimal((shift)->bstr)->to_bin } # BigInt to binary
 242         $mech{'DH-BLOWFISH'} = sub {
 243                 my($sasl, $data) = @_;
 244                 my $u = $sasl->{user};
 245                 my $pass = $sasl->{password};
 246
 247                 # Generate private key and compute secret key
 248                 my($p, $g, $y) = unpack("(n/a*)3", $data);
 249                 my $dh = Crypt::DH->new(p => bin2bi($p), g => bin2bi($g));
 250                 $dh->generate_keys;
 251
 252                 my $secret = bi2bin($dh->compute_secret(bin2bi($y)));
 253                 my $pubkey = bi2bin($dh->pub_key);
 254
 255                 # Pad the password to the nearest multiple of blocksize and encrypt
 256                 $pass .= "\0";
 257                 $pass .= chr(rand(256)) while length($pass) % 8;
 258
 259                 my $cipher = Crypt::Blowfish->new($secret);
 260                 my $crypted = '';
 261                 while(length $pass) {
 262                         my $clear = substr($pass, 0, 8, '');
 263                         $crypted .= $cipher->encrypt($clear);
 264                 }
 265
 266                 pack("n/a*Z*a*", $pubkey, $u, $crypted);
 267         };
 268 };
 269
 270 cmd_sasl_load();
 271
 272 # vim: ts=4