|
148
|
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 => '[email protected]',
|
|
|
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
|
