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.17 by root, Tue Aug 4 14:10:51 2009 UTC vs.
Revision 1.25 by root, Thu Aug 6 10:21:48 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 $arg{timeout} = 30
138 unless exists $arg{timeout};
139
140 my $keepalive = (int $arg{timeout} * 0.75) || 1;
141
142 my $secret = $arg{secret};
143
144 if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) {
145 # assume TLS mode
146 $arg{tls_ctx} = {
147 sslv2 => 0,
148 sslv3 => 0,
149 tlsv1 => 1,
150 verify => 1,
151 cert => $secret,
152 ca_cert => $secret,
153 verify_require_client_cert => 1,
154 };
155 }
143 156
144 $self->{hdl} = new AnyEvent::Handle 157 $self->{hdl} = new AnyEvent::Handle
145 fh => delete $arg{fh}, 158 fh => delete $arg{fh},
146 autocork => 1, 159 autocork => 1,
147 no_delay => 1, 160 no_delay => 1,
148 on_error => sub { 161 on_error => sub {
149 $self->error ($_[2]); 162 $self->error ($_[2]);
150 }, 163 },
164 timeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT,
151 peername => delete $arg{peername}, 165 peername => delete $arg{peername},
152 ; 166 ;
153 167
154 my $secret = $arg{secret};
155 my $greeting_kv = $self->{greeting} ||= {}; 168 my $greeting_kv = $self->{greeting} ||= {};
169
170 $self->{local_node} = $AnyEvent::MP::Base::NODE;
171
156 $greeting_kv->{"tls"} = "1.0" 172 $greeting_kv->{"tls"} = "1.0" if $arg{tls_ctx};
157 if $arg{tls_ctx};
158 $greeting_kv->{provider} = "AE-$VERSION"; 173 $greeting_kv->{provider} = "AE-$VERSION";
159 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; 174 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
175 $greeting_kv->{maxidle} = $keepalive;
160 176
161 # send greeting 177 # send greeting
162 my $lgreeting1 = "aemp;$PROTOCOL_VERSION" 178 my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
163 . ";$AnyEvent::MP::Base::UNIQ" 179 . ";$AnyEvent::MP::Base::UNIQ"
164 . ";$AnyEvent::MP::Base::NODE" 180 . ";$self->{local_node}"
165 . ";" . (join ",", @AUTH_RCV) 181 . ";" . (join ",", @AUTH_RCV)
166 . ";" . (join ",", @FRAMINGS) 182 . ";" . (join ",", @FRAMINGS)
167 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); 183 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
168 184
169 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), ""; 185 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
… …
217 233
218 # read nonce 234 # read nonce
219 $self->{hdl}->push_read (line => sub { 235 $self->{hdl}->push_read (line => sub {
220 my $rgreeting2 = $_[1]; 236 my $rgreeting2 = $_[1];
221 237
238 "$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack?
239 or return $self->error ("authentication error, echo attack?");
240
241 my $key = Digest::MD6::md6 $secret;
242 my $lauth;
243
222 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) { 244 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
223 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept"; 245 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
224 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); 246 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
247 $s_auth = "tls";
248 $lauth = "";
249 } else {
250 # we currently only support hmac_md6_64_256
251 $lauth = Digest::HMAC_MD6::hmac_md6_hex $key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256;
225 } 252 }
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 253
242 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012"); 254 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
243 255
244 # reasd the authentication response 256 # read the authentication response
245 $self->{hdl}->push_read (line => sub { 257 $self->{hdl}->push_read (line => sub {
246 my ($hdl, $rline) = @_; 258 my ($hdl, $rline) = @_;
247 259
248 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; 260 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
261
262 my $rauth =
263 $auth_method eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex $key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256
264 : $auth_method eq "cleartext" ? unpack "H*", $secret
265 : $auth_method eq "tls" ? ($self->{tls} ? "" : "\012\012") # \012\012 never matches
266 : return $self->error ("$auth_method: fatal, selected unsupported auth method");
249 267
250 if ($rauth2 ne $rauth) { 268 if ($rauth2 ne $rauth) {
251 return $self->error ("authentication failure/shared secret mismatch"); 269 return $self->error ("authentication failure/shared secret mismatch");
252 } 270 }
253 271
254 $self->{s_framing} = $s_framing; 272 $self->{s_framing} = $s_framing;
255 273
256 $hdl->rbuf_max (undef); 274 $hdl->rbuf_max (undef);
257 my $queue = delete $self->{queue}; # we are connected 275 my $queue = delete $self->{queue}; # we are connected
258 276
277 $self->{hdl}->timeout ($self->{remote_greeting}{keepalive} + 5)
278 if $self->{remote_greeting}{keepalive};
279
259 $self->connected; 280 $self->connected;
260 281
261 my $src_node = $self->{node}; 282 my $src_node = $self->{node};
262 283
263 $hdl->push_write ($self->{s_framing} => $_) 284 $self->send ($_)
264 for @$queue; 285 for @$queue;
265 286
266 my $rmsg; $rmsg = sub { 287 my $rmsg; $rmsg = sub {
267 $_[0]->push_read ($r_framing => $rmsg); 288 $_[0]->push_read ($r_framing => $rmsg);
268 289
269 local $AnyEvent::MP::Base::SRCNODE = $src_node; 290 local $AnyEvent::MP::Base::SRCNODE = $src_node;
270 AnyEvent::MP::Base::_inject (@{ $_[1] }); 291 AnyEvent::MP::Base::_inject (@{ $_[1] });
271 }; 292 };
… …
280 301
281sub error { 302sub error {
282 my ($self, $msg) = @_; 303 my ($self, $msg) = @_;
283 304
284 if ($self->{node} && $self->{node}{transport} == $self) { 305 if ($self->{node} && $self->{node}{transport} == $self) {
306 #TODO: store error, but do not instantly fail
307 $self->{node}->fail (transport_error => $self->{node}{noderef}, $msg);
285 $self->{node}->clr_transport; 308 $self->{node}->clr_transport;
286 } 309 }
287 $AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg"); 310 $AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
288 $self->destroy; 311 $self->destroy;
289} 312}
290 313
291sub connected { 314sub connected {
292 my ($self) = @_; 315 my ($self) = @_;
293 316
317 if (ref $AnyEvent::MP::Base::SLAVE) {
318 # first connect with a master node
319 my $via = $self->{remote_node};
320 $via =~ s/,/!/g;
321 $AnyEvent::MP::Base::NODE .= "\@$via";
322 $AnyEvent::MP::Base::NODE{$AnyEvent::MP::Base::NODE} = $AnyEvent::MP::Base::NODE{""};
323 $AnyEvent::MP::Base::SLAVE->();
324 }
325
326 if ($self->{local_node} ne $AnyEvent::MP::Base::NODE) {
327 # node changed its name since first greeting
328 $self->send (["", iam => $AnyEvent::MP::Base::NODE]);
329 }
330
294 my $node = AnyEvent::MP::Base::add_node ($self->{remote_node}); 331 my $node = AnyEvent::MP::Base::add_node ($self->{remote_node});
295 Scalar::Util::weaken ($self->{node} = $node); 332 Scalar::Util::weaken ($self->{node} = $node);
296 $node->set_transport ($self); 333 $node->set_transport ($self);
297} 334}
298 335
… …
345 382
346The fixed strings are: 383The fixed strings are:
347 384
348=over 4 385=over 4
349 386
350=item C<aemp> 387=item protocol identification
351 388
352The constant C<aemp> to identify the protocol. 389The constant C<aemp> to identify the protocol.
353 390
354=item protocol version 391=item protocol version
355 392
356The protocol version supported by this end, currently C<0>. If the 393The protocol version supported by this end, currently C<0>. If the
357versions don't match then no communication is possible. Minor extensions 394versions don't match then no communication is possible. Minor extensions
358are supposed to be handled by addign additional key-value pairs. 395are supposed to be handled through additional key-value pairs.
359 396
360=item a token uniquely identifying the current node instance 397=item a token uniquely identifying the current node instance
361 398
362This is a string that must change between restarts. It usually contains 399This is a string that must change between restarts. It usually contains
363things like the current time, the (OS) process id or similar values, but 400things like the current time, the (OS) process id or similar values, but
… …
402 439
403=item tls=<major>.<minor> 440=item tls=<major>.<minor>
404 441
405Indicates that the other side supports TLS (version should be 1.0) and 442Indicates that the other side supports TLS (version should be 1.0) and
406wishes to do a TLS handshake. 443wishes to do a TLS handshake.
444
445=item maxidle=<seconds>
446
447The maximum amount of time the node will not sent data, i.e., idle. This
448can be used to close the conenction when no data has been received for a
449too-long time (say, maxidle + 5 seconds).
407 450
408=back 451=back
409 452
410=head3 Second Greeting Line 453=head3 Second Greeting Line
411 454
… …
423 p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4 466 p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
424 467
425=head2 TLS handshake 468=head2 TLS handshake
426 469
427I<< If, after the handshake, both sides indicate interest in TLS, then the 470I<< If, after the handshake, both sides indicate interest in TLS, then the
428connection B<must> use TLS, or fail.>> 471connection B<must> use TLS, or fail. >>
429 472
430Both sides compare their nonces, and the side who sent the lower nonce 473Both sides compare their nonces, and the side who sent the lower nonce
431value ("string" comparison on the raw octet values) becomes the client, 474value ("string" comparison on the raw octet values) becomes the client,
432and the one with the higher nonce the server. 475and the one with the higher nonce the server.
433 476
… …
477and remote greeting lines swapped: 520and remote greeting lines swapped:
478 521
479 rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012" 522 rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"
480 523
481This is the token that is expected from the other side. 524This is the token that is expected from the other side.
525
526=item tls
527
528This type is only valid iff TLS was enabled and the TLS handshake
529was successful. It has no authentication data, as the server/client
530certificate was successfully verified.
531
532Implementations supporting TLS I<must> accept this authentication type.
482 533
483=back 534=back
484 535
485=item the authentication data 536=item the authentication data
486 537
… …
513 > sRG8bbc4TDbkpvH8FTP4HBs87OhepH6VuApoZqXXskuG 564 > sRG8bbc4TDbkpvH8FTP4HBs87OhepH6VuApoZqXXskuG
514 < aemp;0;nmpKd+gh;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:58760 565 < aemp;0;nmpKd+gh;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:58760
515 < dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo 566 < dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo
516 > hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json 567 > hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json
517 < hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json 568 < hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json
518 > ["","wkp","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"] 569 > ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"]
519 570
520=head1 SEE ALSO 571=head1 SEE ALSO
521 572
522L<AnyEvent>. 573L<AnyEvent>.
523 574

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines