--- AnyEvent-MP/MP/Transport.pm 2009/08/04 07:50:52 1.16 +++ AnyEvent-MP/MP/Transport.pm 2009/08/06 10:21:48 1.25 @@ -29,6 +29,9 @@ use Storable (); use JSON::XS (); +use Digest::MD6 (); +use Digest::HMAC_MD6 (); + use AE (); use AnyEvent::Socket (); use AnyEvent::Handle (); @@ -128,19 +131,29 @@ { Scalar::Util::weaken (my $self = $self); - $arg{tls_ctx_disabled} ||= { - sslv2 => 0, - sslv3 => 0, - tlsv1 => 1, - verify => 1, - cert_file => "secret.pem", - ca_file => "secret.pem", - verify_require_client_cert => 1, - }; - $arg{secret} = AnyEvent::MP::Base::default_secret () unless exists $arg{secret}; + $arg{timeout} = 30 + unless exists $arg{timeout}; + + my $keepalive = (int $arg{timeout} * 0.75) || 1; + + my $secret = $arg{secret}; + + if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) { + # assume TLS mode + $arg{tls_ctx} = { + sslv2 => 0, + sslv3 => 0, + tlsv1 => 1, + verify => 1, + cert => $secret, + ca_cert => $secret, + verify_require_client_cert => 1, + }; + } + $self->{hdl} = new AnyEvent::Handle fh => delete $arg{fh}, autocork => 1, @@ -148,20 +161,23 @@ on_error => sub { $self->error ($_[2]); }, + timeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT, peername => delete $arg{peername}, ; - my $secret = $arg{secret}; my $greeting_kv = $self->{greeting} ||= {}; - $greeting_kv->{"tls"} = "1.0" - if $arg{tls_ctx}; + + $self->{local_node} = $AnyEvent::MP::Base::NODE; + + $greeting_kv->{"tls"} = "1.0" if $arg{tls_ctx}; $greeting_kv->{provider} = "AE-$VERSION"; $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; + $greeting_kv->{maxidle} = $keepalive; # send greeting my $lgreeting1 = "aemp;$PROTOCOL_VERSION" . ";$AnyEvent::MP::Base::UNIQ" - . ";$AnyEvent::MP::Base::NODE" + . ";$self->{local_node}" . ";" . (join ",", @AUTH_RCV) . ";" . (join ",", @FRAMINGS) . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); @@ -219,34 +235,36 @@ $self->{hdl}->push_read (line => sub { my $rgreeting2 = $_[1]; + "$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack? + or return $self->error ("authentication error, echo attack?"); + + my $key = Digest::MD6::md6 $secret; + my $lauth; + if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) { $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept"; $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); + $s_auth = "tls"; + $lauth = ""; + } else { + # we currently only support hmac_md6_64_256 + $lauth = Digest::HMAC_MD6::hmac_md6_hex $key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256; } - - # auth - require Digest::MD6; - require Digest::HMAC_MD6; - - my $key = Digest::MD6::md6 ($secret); - my $lauth = Digest::HMAC_MD6::hmac_md6_hex ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256); - - my $rauth = - $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256) - : $s_auth eq "cleartext" ? unpack "H*", $secret - : die; - - $lauth ne $rauth # echo attack? - or return $self->error ("authentication error"); $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012"); - # reasd the authentication response + # read the authentication response $self->{hdl}->push_read (line => sub { my ($hdl, $rline) = @_; my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; + my $rauth = + $auth_method eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex $key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256 + : $auth_method eq "cleartext" ? unpack "H*", $secret + : $auth_method eq "tls" ? ($self->{tls} ? "" : "\012\012") # \012\012 never matches + : return $self->error ("$auth_method: fatal, selected unsupported auth method"); + if ($rauth2 ne $rauth) { return $self->error ("authentication failure/shared secret mismatch"); } @@ -256,14 +274,17 @@ $hdl->rbuf_max (undef); my $queue = delete $self->{queue}; # we are connected + $self->{hdl}->timeout ($self->{remote_greeting}{keepalive} + 5) + if $self->{remote_greeting}{keepalive}; + $self->connected; my $src_node = $self->{node}; - $hdl->push_write ($self->{s_framing} => $_) + $self->send ($_) for @$queue; - my $rmsg; $rmsg = sub { + my $rmsg; $rmsg = sub { $_[0]->push_read ($r_framing => $rmsg); local $AnyEvent::MP::Base::SRCNODE = $src_node; @@ -282,6 +303,8 @@ my ($self, $msg) = @_; if ($self->{node} && $self->{node}{transport} == $self) { + #TODO: store error, but do not instantly fail + $self->{node}->fail (transport_error => $self->{node}{noderef}, $msg); $self->{node}->clr_transport; } $AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg"); @@ -291,6 +314,20 @@ sub connected { my ($self) = @_; + if (ref $AnyEvent::MP::Base::SLAVE) { + # first connect with a master node + my $via = $self->{remote_node}; + $via =~ s/,/!/g; + $AnyEvent::MP::Base::NODE .= "\@$via"; + $AnyEvent::MP::Base::NODE{$AnyEvent::MP::Base::NODE} = $AnyEvent::MP::Base::NODE{""}; + $AnyEvent::MP::Base::SLAVE->(); + } + + if ($self->{local_node} ne $AnyEvent::MP::Base::NODE) { + # node changed its name since first greeting + $self->send (["", iam => $AnyEvent::MP::Base::NODE]); + } + my $node = AnyEvent::MP::Base::add_node ($self->{remote_node}); Scalar::Util::weaken ($self->{node} = $node); $node->set_transport ($self); @@ -347,7 +384,7 @@ =over 4 -=item C +=item protocol identification The constant C to identify the protocol. @@ -355,7 +392,7 @@ The protocol version supported by this end, currently C<0>. If the versions don't match then no communication is possible. Minor extensions -are supposed to be handled by addign additional key-value pairs. +are supposed to be handled through additional key-value pairs. =item a token uniquely identifying the current node instance @@ -405,6 +442,12 @@ Indicates that the other side supports TLS (version should be 1.0) and wishes to do a TLS handshake. +=item maxidle= + +The maximum amount of time the node will not sent data, i.e., idle. This +can be used to close the conenction when no data has been received for a +too-long time (say, maxidle + 5 seconds). + =back =head3 Second Greeting Line @@ -425,7 +468,7 @@ =head2 TLS handshake I<< If, after the handshake, both sides indicate interest in TLS, then the -connection B use TLS, or fail.>> +connection B use TLS, or fail. >> Both sides compare their nonces, and the side who sent the lower nonce value ("string" comparison on the raw octet values) becomes the client, @@ -480,6 +523,14 @@ This is the token that is expected from the other side. +=item tls + +This type is only valid iff TLS was enabled and the TLS handshake +was successful. It has no authentication data, as the server/client +certificate was successfully verified. + +Implementations supporting TLS I accept this authentication type. + =back =item the authentication data @@ -505,7 +556,7 @@ =head2 FULL EXAMPLE -This is an actual protocol dump of an handshake, followed by a single data +This is an actual protocol dump of a handshake, followed by a single data packet. The greater than/less than lines indicate the direction of the transfer only. @@ -515,7 +566,7 @@ < dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo > hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json < hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json - > ["","wkp","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"] + > ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"] =head1 SEE ALSO