]>
git.sthu.org Git - shutils.git/blob - dotfiles/irssi/scripts/cap_sasl.pl
3 use vars
qw($VERSION %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/',
24 sub server_connected {
26 $server->send_raw_now("CAP LS");
30 my ($server, $args, $nick, $address) = @_;
31 my ($subcmd, $caps, $tosend);
34 if ($args =~ /^\S+ (\S+) :(.*)$/) {
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}});
41 $server->print('', "CLICAP: supported by server:$caps");
42 if (!$server->{connected}) {
44 $server->send_raw_now("CAP END");
46 $server->print('', "CLICAP: requesting: $tosend");
47 $server->send_raw_now("CAP REQ :$tosend");
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});
59 $server->print('', 'SASL: attempted to start unknown mechanism "' . $sasl_auth{$server->{tag}}{mech} . '"');
62 elsif (!$server->{connected}) {
63 $server->send_raw_now("CAP END");
66 } elsif ($subcmd eq 'NAK') {
67 $server->print('', "CLICAP: refused:$caps");
68 if (!$server->{connected}) {
69 $server->send_raw_now("CAP END");
72 } elsif ($subcmd eq 'LIST') {
73 $server->print('', "CLICAP: currently enabled:$caps");
79 sub event_authenticate {
80 my ($server, $args, $nick, $address) = @_;
81 my $sasl = $sasl_auth{$server->{tag}};
82 return unless $sasl && $mech{$sasl->{mech}};
84 $sasl->{buffer} .= $args;
85 return if length($args) == 400;
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, '');
92 while(length $out >= 400) {
93 my $subout = substr($out, 0, 400, '');
94 $server->send_raw_now("AUTHENTICATE $subout");
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 +");
102 $sasl->{buffer} = '';
103 Irssi::signal_stop();
107 my ($server, $args, $nick, $address) = @_;
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");
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");
128 my ($data, $server, $item) = @_;
131 Irssi::command_runsub ('sasl', $data, $server, $item);
138 my ($data, $server, $item) = @_;
140 if (my($net, $u, $p, $m) = $data =~ /^(\S+) (\S+) (\S+) (\S+)$/) {
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} *");
147 Irssi::print("SASL: unknown mechanism $m");
149 } elsif ($data =~ /^(\S+)$/) {
151 if (defined($sasl_auth{$net})) {
152 delete $sasl_auth{$net};
153 Irssi::print("SASL: deleted $net");
155 Irssi::print("SASL: no entry for $net");
158 Irssi::print("SASL: usage: /sasl set <net> <user> <password or keyfile> <mechanism>");
163 #my ($data, $server, $item) = @_;
167 foreach $net (keys %sasl_auth) {
168 Irssi::print("SASL: $net: [$sasl_auth{$net}{mech}] $sasl_auth{$net}{user} *");
171 Irssi::print("SASL: no networks defined") if !$count;
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});
182 Irssi::print("SASL: auth saved to $file");
186 #my ($data, $server, $item) = @_;
187 my $file = Irssi::get_irssi_dir()."/sasl.auth";
189 open FILE, "< $file" or return;
193 my ($net, $u, $p, $m) = split (/\t/, $_, 4);
196 $sasl_auth{$net}{user} = $u;
197 $sasl_auth{$net}{password} = $p;
198 $sasl_auth{$net}{mech} = uc $m;
200 Irssi::print("SASL: unknown mechanism $m");
204 Irssi::print("SASL: auth loaded from $file");
207 sub cmd_sasl_mechanisms {
208 Irssi::print("SASL: mechanisms supported: " . join(" ", keys %mech));
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');
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);
228 my($sasl, $data) = @_;
229 my $u = $sasl->{user};
230 my $p = $sasl->{password};
232 join("\0", $u, $u, $p);
236 use Crypt::OpenSSL::Bignum;
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};
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));
252 my $secret = bi2bin($dh->compute_secret(bin2bi($y)));
253 my $pubkey = bi2bin($dh->pub_key);
255 # Pad the password to the nearest multiple of blocksize and encrypt
257 $pass .= chr(rand(256)) while length($pass) % 8;
259 my $cipher = Crypt::Blowfish->new($secret);
261 while(length $pass) {
262 my $clear = substr($pass, 0, 8, '');
263 $crypted .= $cipher->encrypt($clear);
266 pack("n/a*Z*a*", $pubkey, $u, $crypted);