ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/MP/Transport.pm
(Generate patch)

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.18 by root, Tue Aug 4 18:33:30 2009 UTC vs.
Revision 1.19 by root, Tue Aug 4 21:36:28 2009 UTC

26 26
27use Scalar::Util; 27use Scalar::Util;
28use MIME::Base64 (); 28use MIME::Base64 ();
29use Storable (); 29use Storable ();
30use JSON::XS (); 30use JSON::XS ();
31
32use Digest::MD6 ();
33use Digest::HMAC_MD6 ();
31 34
32use AE (); 35use AE ();
33use AnyEvent::Socket (); 36use AnyEvent::Socket ();
34use AnyEvent::Handle (); 37use AnyEvent::Handle ();
35 38
126 $self->{queue} = []; 129 $self->{queue} = [];
127 130
128 { 131 {
129 Scalar::Util::weaken (my $self = $self); 132 Scalar::Util::weaken (my $self = $self);
130 133
131 $arg{tls_ctx_disabled} ||= {
132 sslv2 => 0,
133 sslv3 => 0,
134 tlsv1 => 1,
135 verify => 1,
136 cert_file => "secret.pem",
137 ca_file => "secret.pem",
138 verify_require_client_cert => 1,
139 };
140
141 $arg{secret} = AnyEvent::MP::Base::default_secret () 134 $arg{secret} = AnyEvent::MP::Base::default_secret ()
142 unless exists $arg{secret}; 135 unless exists $arg{secret};
136
137 my $secret = $arg{secret};
138
139 if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) {
140 # assume TLS mode
141 $arg{tls_ctx} = {
142 sslv2 => 0,
143 sslv3 => 0,
144 tlsv1 => 1,
145 verify => 1,
146 cert => $secret,
147 ca_cert => $secret,
148 verify_require_client_cert => 1,
149 };
150 }
143 151
144 $self->{hdl} = new AnyEvent::Handle 152 $self->{hdl} = new AnyEvent::Handle
145 fh => delete $arg{fh}, 153 fh => delete $arg{fh},
146 autocork => 1, 154 autocork => 1,
147 no_delay => 1, 155 no_delay => 1,
149 $self->error ($_[2]); 157 $self->error ($_[2]);
150 }, 158 },
151 peername => delete $arg{peername}, 159 peername => delete $arg{peername},
152 ; 160 ;
153 161
154 my $secret = $arg{secret};
155 my $greeting_kv = $self->{greeting} ||= {}; 162 my $greeting_kv = $self->{greeting} ||= {};
156 $greeting_kv->{"tls"} = "1.0" 163 $greeting_kv->{"tls"} = "1.0"
157 if $arg{tls_ctx}; 164 if $arg{tls_ctx};
158 $greeting_kv->{provider} = "AE-$VERSION"; 165 $greeting_kv->{provider} = "AE-$VERSION";
159 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; 166 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
217 224
218 # read nonce 225 # read nonce
219 $self->{hdl}->push_read (line => sub { 226 $self->{hdl}->push_read (line => sub {
220 my $rgreeting2 = $_[1]; 227 my $rgreeting2 = $_[1];
221 228
229 "$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack?
230 or return $self->error ("authentication error, echo attack?");
231
232 my $key = Digest::MD6::md6 $secret;
233 my $lauth;
234
222 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) { 235 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
223 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept"; 236 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
224 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); 237 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
238 $s_auth = "tls";
239 $lauth = "";
240 } else {
241 # we currently only support hmac_md6_64_256
242 $lauth = Digest::HMAC_MD6::hmac_md6_hex $key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256;
225 } 243 }
226
227 # auth
228 require Digest::MD6;
229 require Digest::HMAC_MD6;
230
231 my $key = Digest::MD6::md6 ($secret);
232 my $lauth = Digest::HMAC_MD6::hmac_md6_hex ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
233
234 my $rauth =
235 $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256)
236 : $s_auth eq "cleartext" ? unpack "H*", $secret
237 : die;
238
239 $lauth ne $rauth # echo attack?
240 or return $self->error ("authentication error");
241 244
242 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012"); 245 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
243 246
244 # reasd the authentication response 247 # read the authentication response
245 $self->{hdl}->push_read (line => sub { 248 $self->{hdl}->push_read (line => sub {
246 my ($hdl, $rline) = @_; 249 my ($hdl, $rline) = @_;
247 250
248 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; 251 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
252
253 my $rauth =
254 $auth_method eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex $key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256
255 : $auth_method eq "cleartext" ? unpack "H*", $secret
256 : $auth_method eq "tls" ? ($self->{tls} ? "" : "\012\012") # \012\012 never matches
257 : return $self->error ("$auth_method: fatal, selected unsupported auth method");
249 258
250 if ($rauth2 ne $rauth) { 259 if ($rauth2 ne $rauth) {
251 return $self->error ("authentication failure/shared secret mismatch"); 260 return $self->error ("authentication failure/shared secret mismatch");
252 } 261 }
253 262
479 488
480 rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012" 489 rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"
481 490
482This is the token that is expected from the other side. 491This is the token that is expected from the other side.
483 492
493=item tls
494
495This type is only valid iff TLS was enabled and the TLS handshake
496was successful. It has no authentication data, as the server/client
497certificate was successfully verified.
498
499Implementations supporting TLS I<must> accept this authentication type.
500
484=back 501=back
485 502
486=item the authentication data 503=item the authentication data
487 504
488The authentication data itself, usually base64 or hex-encoded data, see 505The authentication data itself, usually base64 or hex-encoded data, see

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines