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