1use strict; 2use Irssi; 3use MIME::Base64; 4use vars qw($VERSION %IRSSI); 5use constant CHALLENGE_SIZE => 32; 6 7$VERSION = "1.11"; 8%IRSSI = ( 9 authors => 'Michael Tharp (gxti), Jilles Tjoelker (jilles), Mantas Mikulėnas (grawity)', 10 contact => 'grawity@gmail.com', 11 name => 'cap_sasl.pl', 12 description => 'Implements SASL authentication and enables CAP "multi-prefix"', 13 license => 'GPLv2', 14 url => 'http://ircv3.atheme.org/extensions/sasl-3.1', 15); 16 17my %sasl_auth = (); 18my %mech = (); 19 20sub irssi_abspath { 21 my $f = shift; 22 $f =~ s!^~/!$ENV{HOME}/!; 23 if ($f !~ m!^/!) { 24 $f = Irssi::get_irssi_dir()."/".$f; 25 } 26 return $f; 27} 28 29sub timeout; 30 31sub server_connected { 32 my $server = shift; 33 if (uc $server->{chat_type} eq 'IRC') { 34 $server->send_raw_now("CAP LS"); 35 } 36} 37 38sub event_cap { 39 my ($server, $args, $nick, $address) = @_; 40 my ($subcmd, $caps, $tosend, $sasl); 41 42 $tosend = ''; 43 $sasl = $sasl_auth{$server->{tag}}; 44 if ($args =~ /^\S+ (\S+) :(.*)$/) { 45 $subcmd = uc $1; 46 $caps = ' '.$2.' '; 47 if ($subcmd eq 'LS') { 48 $tosend .= ' multi-prefix' if $caps =~ / multi-prefix /i; 49 $tosend .= ' sasl' if $caps =~ / sasl /i && defined($sasl); 50 $tosend =~ s/^ //; 51 $server->print('', "CLICAP: supported by server:$caps"); 52 if (!$server->{connected}) { 53 if ($tosend eq '') { 54 $server->send_raw_now("CAP END"); 55 } else { 56 $server->print('', "CLICAP: requesting: $tosend"); 57 $server->send_raw_now("CAP REQ :$tosend"); 58 } 59 } 60 Irssi::signal_stop(); 61 } elsif ($subcmd eq 'ACK') { 62 $server->print('', "CLICAP: now enabled:$caps"); 63 if ($caps =~ / sasl /i) { 64 $sasl->{buffer} = ''; 65 $sasl->{step} = 0; 66 if ($mech{$sasl->{mech}}) { 67 $server->send_raw_now("AUTHENTICATE " . $sasl->{mech}); 68 Irssi::timeout_add_once(7500, \&timeout, $server->{tag}); 69 } else { 70 $server->print('', 'SASL: attempted to start unknown mechanism "' . $sasl->{mech} . '"'); 71 } 72 } 73 elsif (!$server->{connected}) { 74 $server->send_raw_now("CAP END"); 75 } 76 Irssi::signal_stop(); 77 } elsif ($subcmd eq 'NAK') { 78 $server->print('', "CLICAP: refused:$caps"); 79 if (!$server->{connected}) { 80 $server->send_raw_now("CAP END"); 81 } 82 Irssi::signal_stop(); 83 } elsif ($subcmd eq 'LIST') { 84 $server->print('', "CLICAP: currently enabled:$caps"); 85 Irssi::signal_stop(); 86 } 87 } 88} 89 90sub event_authenticate { 91 my ($server, $args, $nick, $address) = @_; 92 my $sasl = $sasl_auth{$server->{tag}}; 93 return unless $sasl && $mech{$sasl->{mech}}; 94 95 $sasl->{buffer} .= $args; 96 return if length($args) == 400; 97 98 my $data = ($sasl->{buffer} eq '+') ? '' : decode_base64($sasl->{buffer}); 99 my $out = $mech{$sasl->{mech}}($sasl, $data); 100 101 if (defined $out) { 102 $out = ($out eq '') ? '+' : encode_base64($out, ''); 103 while (length $out >= 400) { 104 my $subout = substr($out, 0, 400, ''); 105 $server->send_raw_now("AUTHENTICATE $subout"); 106 } 107 if (length $out) { 108 $server->send_raw_now("AUTHENTICATE $out"); 109 } else { 110 # Last piece was exactly 400 bytes, we have to send 111 # some padding to indicate we're done. 112 $server->send_raw_now("AUTHENTICATE +"); 113 } 114 } else { 115 $server->send_raw_now("AUTHENTICATE *"); 116 } 117 118 $sasl->{buffer} = ""; 119 Irssi::signal_stop(); 120} 121 122sub event_saslend { 123 my ($server, $args, $nick, $address) = @_; 124 125 my $data = $args; 126 $data =~ s/^\S+ :?//; 127 # need this to see it, ?? -- jilles 128 129 $server->print('', $data); 130 if (!$server->{connected}) { 131 $server->send_raw_now("CAP END"); 132 } 133} 134 135sub event_saslfail { 136 my ($server, $args, $nick, $address) = @_; 137 138 my $data = $args; 139 $data =~ s/^\S+ :?//; 140 141 if (Irssi::settings_get_bool('sasl_disconnect_on_fail')) { 142 $server->print('', "$data - disconnecting from server", MSGLEVEL_CLIENTERROR); 143 $server->disconnect(); 144 } else { 145 $server->print('', "$data - continuing anyway"); 146 if (!$server->{connected}) { 147 $server->send_raw_now("CAP END"); 148 } 149 } 150} 151 152sub timeout { 153 my $tag = shift; 154 my $server = Irssi::server_find_tag($tag); 155 if ($server && !$server->{connected}) { 156 $server->print('', "SASL: authentication timed out", MSGLEVEL_CLIENTERROR); 157 $server->send_raw_now("CAP END"); 158 } 159} 160 161sub cmd_sasl { 162 my ($data, $server, $item) = @_; 163 164 if ($data ne '') { 165 Irssi::command_runsub ('sasl', $data, $server, $item); 166 } else { 167 cmd_sasl_show(@_); 168 } 169} 170 171sub cmd_sasl_set { 172 my ($data, $server, $item) = @_; 173 174 if (my ($net, $u, $p, $m) = $data =~ /^(\S+) (\S+) (\S+) (\S+)$/) { 175 if ($mech{uc $m}) { 176 $sasl_auth{$net}{user} = $u; 177 $sasl_auth{$net}{password} = $p; 178 $sasl_auth{$net}{mech} = uc $m; 179 Irssi::print("SASL: added $net: [$m] $sasl_auth{$net}{user} *"); 180 } else { 181 Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR); 182 } 183 } elsif ($data =~ /^(\S+)$/) { 184 $net = $1; 185 if (defined($sasl_auth{$net})) { 186 delete $sasl_auth{$net}; 187 Irssi::print("SASL: deleted $net"); 188 } else { 189 Irssi::print("SASL: no entry for $net"); 190 } 191 } else { 192 Irssi::print("SASL: usage: /sasl set <net> <user> <password or keyfile> <mechanism>"); 193 } 194} 195 196sub cmd_sasl_show { 197 #my ($data, $server, $item) = @_; 198 my @nets = keys %sasl_auth; 199 for my $net (@nets) { 200 Irssi::print("SASL: $net: [$sasl_auth{$net}{mech}] $sasl_auth{$net}{user} *"); 201 } 202 Irssi::print("SASL: no networks defined") if !@nets; 203} 204 205sub cmd_sasl_save { 206 #my ($data, $server, $item) = @_; 207 my $file = Irssi::get_irssi_dir()."/sasl.auth"; 208 if (open(my $fh, ">", $file)) { 209 chmod(0600, $file); 210 for my $net (keys %sasl_auth) { 211 printf $fh ("%s\t%s\t%s\t%s\n", 212 $net, 213 $sasl_auth{$net}{user}, 214 $sasl_auth{$net}{password}, 215 $sasl_auth{$net}{mech}); 216 } 217 close($fh); 218 Irssi::print("SASL: auth saved to '$file'"); 219 } else { 220 Irssi::print("SASL: couldn't access '$file': $@"); 221 } 222} 223 224sub cmd_sasl_load { 225 #my ($data, $server, $item) = @_; 226 my $file = Irssi::get_irssi_dir()."/sasl.auth"; 227 if (open(my $fh, "<", $file)) { 228 %sasl_auth = (); 229 while (<$fh>) { 230 chomp; 231 my ($net, $u, $p, $m) = split(/\t/, $_, 4); 232 $m ||= "PLAIN"; 233 if ($mech{uc $m}) { 234 $sasl_auth{$net}{user} = $u; 235 $sasl_auth{$net}{password} = $p; 236 $sasl_auth{$net}{mech} = uc $m; 237 } else { 238 Irssi::print("SASL: unknown mechanism $m", MSGLEVEL_CLIENTERROR); 239 } 240 } 241 close($fh); 242 Irssi::print("SASL: cap_sasl $VERSION, auth loaded from '$file'"); 243 } 244} 245 246sub cmd_sasl_mechanisms { 247 Irssi::print("SASL: mechanisms supported: " . join(", ", sort keys %mech)); 248} 249 250Irssi::settings_add_bool('server', 'sasl_disconnect_on_fail', 1); 251 252Irssi::signal_add_first('server connected', \&server_connected); 253Irssi::signal_add('event cap', \&event_cap); 254Irssi::signal_add('event authenticate', \&event_authenticate); 255Irssi::signal_add('event 903', \&event_saslend); 256Irssi::signal_add('event 904', \&event_saslfail); 257Irssi::signal_add('event 905', \&event_saslend); 258Irssi::signal_add('event 906', \&event_saslfail); 259Irssi::signal_add('event 907', \&event_saslend); 260 261Irssi::command_bind('sasl', \&cmd_sasl); 262Irssi::command_bind('sasl load', \&cmd_sasl_load); 263Irssi::command_bind('sasl save', \&cmd_sasl_save); 264Irssi::command_bind('sasl set', \&cmd_sasl_set); 265Irssi::command_bind('sasl show', \&cmd_sasl_show); 266Irssi::command_bind('sasl mechanisms', \&cmd_sasl_mechanisms); 267 268$mech{PLAIN} = sub { 269 my ($sasl, $data) = @_; 270 my $u = $sasl->{user}; 271 my $p = $sasl->{password}; 272 return join("\0", $u, $u, $p); 273}; 274 275$mech{EXTERNAL} = sub { 276 my ($sasl, $data) = @_; 277 return $sasl->{user} // ""; 278}; 279 280if (eval {require Crypt::PK::ECC}) { 281 my $mech = "ECDSA-NIST256P-CHALLENGE"; 282 283 $mech{'ECDSA-NIST256P-CHALLENGE'} = sub { 284 my ($sasl, $data) = @_; 285 my $u = $sasl->{user}; 286 my $f = $sasl->{password}; 287 $f = irssi_abspath($f); 288 if (!-f $f) { 289 Irssi::print("SASL: key file '$f' not found", MSGLEVEL_CLIENTERROR); 290 return; 291 } 292 my $pk = eval {Crypt::PK::ECC->new($f)}; 293 if ($@ || !$pk || !$pk->is_private) { 294 Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR); 295 return; 296 } 297 my $step = ++$sasl->{step}; 298 if ($step == 1) { 299 if (length $data == CHALLENGE_SIZE) { 300 my $sig = $pk->sign_hash($data); 301 return $u."\0".$u."\0".$sig; 302 } elsif (length $data) { 303 return; 304 } else { 305 return $u."\0".$u; 306 } 307 } 308 elsif ($step == 2) { 309 if (length $data == CHALLENGE_SIZE) { 310 return $pk->sign_hash($data); 311 } else { 312 return; 313 } 314 } 315 }; 316 317 Irssi::command_bind("sasl keygen" => sub { 318 my ($data, $server, $witem) = @_; 319 320 my $print = $server 321 ? sub { $server->print("", shift, shift // MSGLEVEL_CLIENTNOTICE) } 322 : sub { Irssi::print(shift, shift // MSGLEVEL_CLIENTNOTICE) }; 323 324 my $net = $server ? $server->{tag} : $data; 325 if (!length $net) { 326 Irssi::print("SASL: please connect to a server first", 327 MSGLEVEL_CLIENTERROR); 328 return; 329 } 330 331 my $f_name = lc "sasl-ecdsa-$net"; 332 $f_name =~ s![ /]+!_!g; 333 my $f_priv = Irssi::get_irssi_dir()."/$f_name.key"; 334 my $f_pub = Irssi::get_irssi_dir()."/$f_name.pub"; 335 if (-e $f_priv) { 336 $print->("SASL: refusing to overwrite '$f_priv'", MSGLEVEL_CLIENTERROR); 337 return; 338 } 339 340 $print->("SASL: generating keypair for '$net'..."); 341 my $pk = Crypt::PK::ECC->new; 342 $pk->generate_key("prime256v1"); 343 344 my $priv = $pk->export_key_pem("private"); 345 my $pub = encode_base64($pk->export_key_raw("public_compressed"), ""); 346 347 if (open(my $fh, ">", $f_priv)) { 348 chmod(0600, $f_priv); 349 print $fh $priv; 350 close($fh); 351 $print->("SASL: wrote private key to '$f_priv'"); 352 } else { 353 $print->("SASL: could not write '$f_priv': $!", MSGLEVEL_CLIENTERROR); 354 return; 355 } 356 357 if (open(my $fh, ">", $f_pub)) { 358 print $fh $pub."\n"; 359 close($fh); 360 } else { 361 $print->("SASL: could not write '$f_pub': $!", MSGLEVEL_CLIENTERROR); 362 } 363 364 my $cmdchar = substr(Irssi::settings_get_str("cmdchars"), 0, 1); 365 my $cmd = "msg NickServ SET PUBKEY $pub"; 366 367 if ($server) { 368 $print->("SASL: updating your Irssi settings..."); 369 $sasl_auth{$net}{user} //= $server->{nick}; 370 $sasl_auth{$net}{password} = "$f_name.key"; 371 $sasl_auth{$net}{mech} = $mech; 372 cmd_sasl_save(@_); 373 $print->("SASL: submitting pubkey to NickServ..."); 374 $server->command($cmd); 375 } else { 376 $print->("SASL: update your Irssi settings:"); 377 $print->("%P".$cmdchar."sasl set $net <nick> $f_name.key $mech"); 378 $print->("SASL: submit your pubkey to $net:"); 379 $print->("%P".$cmdchar.$cmd); 380 } 381 }); 382 383 Irssi::command_bind("sasl pubkey" => sub { 384 my ($data, $server, $witem) = @_; 385 386 my $arg = $server ? $server->{tag} : $data; 387 388 my $f; 389 if (!length $arg) { 390 Irssi::print("SASL: please select a server or specify a keyfile path", 391 MSGLEVEL_CLIENTERROR); 392 return; 393 } elsif ($arg =~ m![/.]!) { 394 $f = $arg; 395 } else { 396 if ($sasl_auth{$arg}{mech} eq $mech) { 397 $f = $sasl_auth{$arg}{password}; 398 } else { 399 $f = lc "sasl-ecdsa-$arg"; 400 $f =~ s![ /]+!_!g; 401 $f = "$f.key"; 402 } 403 } 404 405 $f = irssi_abspath($f); 406 if (!-e $f) { 407 Irssi::print("SASL: keyfile '$f' not found", MSGLEVEL_CLIENTERROR); 408 return; 409 } 410 411 my $pk = eval {Crypt::PK::ECC->new($f)}; 412 if ($@ || !$pk || !$pk->is_private) { 413 Irssi::print("SASL: no private key in file '$f'", MSGLEVEL_CLIENTERROR); 414 Irssi::print("(keys using named parameters or PKCS#8 are not yet supported)", 415 MSGLEVEL_CLIENTERROR); 416 return; 417 } 418 419 my $pub = encode_base64($pk->export_key_raw("public_compressed"), ""); 420 Irssi::print("SASL: loaded keyfile '$f'"); 421 Irssi::print("SASL: your pubkey is $pub"); 422 }); 423} else { 424 Irssi::command_bind("sasl keygen" => sub { 425 Irssi::print("SASL: cannot '/sasl keygen' as the Perl 'CryptX' module is missing", 426 MSGLEVEL_CLIENTERROR); 427 }); 428 429 Irssi::command_bind("sasl pubkey" => sub { 430 Irssi::print("SASL: cannot '/sasl pubkey' as the Perl 'CryptX' module is missing", 431 MSGLEVEL_CLIENTERROR); 432 }); 433} 434 435cmd_sasl_load(); 436 437# vim: ts=4:sw=4 438