AnyEvent-MP/MP/Transport.pm

=head1 NAME

AnyEvent::MP::Transport - actual transport protocol handler

=head1 SYNOPSIS

   use AnyEvent::MP::Transport;

=head1 DESCRIPTION

This implements the actual transport protocol for MP (it represents a
single link), most of which is considered an implementation detail.

See the "PROTOCOL" section below if you want to write another client for
this protocol.

=head1 FUNCTIONS/METHODS

=over 4

=cut

package AnyEvent::MP::Transport;

use common::sense;

use Scalar::Util ();
use List::Util ();
use MIME::Base64 ();
use Storable ();
use JSON::XS ();

use Digest::MD6 ();
use Digest::HMAC_MD6 ();

use AE ();
use AnyEvent::Socket ();
use AnyEvent::Handle 4.92 ();

use base Exporter::;

our $VERSION = '0.0';
our $PROTOCOL_VERSION = 0;

=item $listener = mp_listener $host, $port, <constructor-args>, $cb->($transport)

Creates a listener on the given host/port using
C<AnyEvent::Socket::tcp_server>.

See C<new>, below, for constructor arguments.

Defaults for peerhost, peerport and fh are provided.

=cut

sub mp_server($$@) {
   my $cb = pop;
   my ($host, $port, @args) = @_;

   AnyEvent::Socket::tcp_server $host, $port, sub {
      my ($fh, $host, $port) = @_;

      $cb->(new AnyEvent::MP::Transport
         fh       => $fh,
         peerhost => $host,
         peerport => $port,
         @args,
      );
   }
}

=item $guard = mp_connect $host, $port, <constructor-args>, $cb->($transport)

=cut

sub mp_connect {
   my $cb = pop;
   my ($host, $port, @args) = @_;

   AnyEvent::Socket::tcp_connect $host, $port, sub {
      my ($fh, $nhost, $nport) = @_;

      return $cb->() unless $fh;

      $cb->(new AnyEvent::MP::Transport
         fh       => $fh,
         peername => $host,
         peerhost => $nhost,
         peerport => $nport,
         @args,
      );
   }
}

=item new AnyEvent::MP::Transport

   # immediately starts negotiation
   my $transport = new AnyEvent::MP::Transport
      # mandatory
      fh       => $filehandle,
      local_id => $identifier,
      on_recv  => sub { receive-callback },
      on_error => sub { error-callback },

      # optional
      secret   => "shared secret",
      on_eof   => sub { clean-close-callback },
      on_connect => sub { successful-connect-callback },
      greeting => { key => value },

      # tls support
      tls_ctx  => AnyEvent::TLS,
      peername => $peername, # for verification
   ;

=cut

sub LATENCY() { 3 } # assumed max. network latency

our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send
our @AUTH_RCV = (@AUTH_SND, qw(cleartext)); # auth types we accept

#AnyEvent::Handle::register_write_type mp_record => sub {
#};

sub new {
   my ($class, %arg) = @_;

   my $self = bless \%arg, $class;

   $self->{queue} = [];

   {
      Scalar::Util::weaken (my $self = $self);

      $arg{secret} = AnyEvent::MP::Base::default_secret ()
         unless exists $arg{secret};

      $arg{timeout} = 30
         unless exists $arg{timeout};

      $arg{timeout} = 1 + LATENCY
         if $arg{timeout} < 1 + LATENCY;

      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,
         no_delay => 1,
         on_error => sub {
            $self->error ($_[2]);
         },
         rtimeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT,
         peername => delete $arg{peername},
      ;

      my $greeting_kv = $self->{greeting} ||= {};

      $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->{timeout}  = $arg{timeout};

      # send greeting
      my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
                     . ";$self->{local_node}"
                     . ";" . (join ",", @AUTH_RCV)
                     . ";" . (join ",", @FRAMINGS)
                     . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);

      my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";

      $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");

      # expect greeting
      $self->{hdl}->rbuf_max (4 * 1024);
      $self->{hdl}->push_read (line => sub {
         my $rgreeting1 = $_[1];

         my ($aemp, $version, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;

         if ($aemp ne "aemp") {
            return $self->error ("unparsable greeting");
         } elsif ($version != $PROTOCOL_VERSION) {
            return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
         }

         my $s_auth;
         for my $auth_ (split /,/, $auths) {
            if (grep $auth_ eq $_, @AUTH_SND) {
               $s_auth = $auth_;
               last;
            }
         }

         defined $s_auth
            or return $self->error ("$auths: no common auth type supported");

         die unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.

         my $s_framing;
         for my $framing_ (split /,/, $framings) {
            if (grep $framing_ eq $_, @FRAMINGS) {
               $s_framing = $framing_;
               last;
            }
         }

         defined $s_framing
            or return $self->error ("$framings: no common framing method supported");

         $self->{remote_node} = $rnode;

         $self->{remote_greeting} = {
            map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
               @kv
         };

         # read nonce
         $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;
            }

            $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");

            # 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");
               }

               $self->{s_framing} = $s_framing;

               $hdl->rbuf_max (undef);
               my $queue = delete $self->{queue}; # we are connected

               $self->{hdl}->rtimeout ($self->{remote_greeting}{timeout});
               $self->{hdl}->wtimeout ($arg{timeout} - LATENCY);
               $self->{hdl}->on_wtimeout (sub { $self->send (["", "devnull"]) });

               $self->connected;

               # send queued messages
               $self->send ($_)
                  for @$queue;

               # receive handling
               my $src_node = $self->{node};

               my $rmsg; $rmsg = sub {
                  $_[0]->push_read ($r_framing => $rmsg);

                  local $AnyEvent::MP::Base::SRCNODE = $src_node;
                  AnyEvent::MP::Base::_inject (@{ $_[1] });
               };
               $hdl->push_read ($r_framing => $rmsg);
            });
         });
      });
   }

   $self
}

sub error {
   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");
   $self->destroy;
}

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);
}

sub send {
   $_[0]{hdl}->push_write ($_[0]{s_framing} => $_[1]);
}

sub destroy {
   my ($self) = @_;

   $self->{hdl}->destroy
      if $self->{hdl};
}

sub DESTROY {
   my ($self) = @_;

   $self->destroy;
}

=back

=head1 PROTOCOL

The protocol is relatively simple, and consists of three phases which are
symmetrical for both sides: greeting (followed by optionally switching to
TLS mode), authentication and packet exchange.

the protocol is designed to allow both full-text and binary streams.

The greeting consists of two text lines that are ended by either an ASCII
CR LF pair, or a single ASCII LF (recommended).

=head2 GREETING

All the lines until after authentication must not exceed 4kb in length,
including delimiter. Afterwards there is no limit on the packet size that
can be received.

=head3 First Greeting Line

Example:

   aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0

The first line contains strings separated (not ended) by C<;>
characters. The first even ixtrings are fixed by the protocol, the
remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
characters themselves.

The fixed strings are:

=over 4

=item protocol identification

The constant C<aemp> to identify the protocol.

=item protocol version

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 through additional key-value pairs.

=item the node endpoint descriptors

for public nodes, this is a comma-separated list of protocol endpoints,
i.e., the noderef. For slave nodes, this is a unique identifier of the
form C<slave/nonce>.

=item the acceptable authentication methods

A comma-separated list of authentication methods supported by the
node. Note that AnyEvent::MP supports a C<hex_secret> authentication
method that accepts a cleartext password (hex-encoded), but will not use
this auth method itself.

The receiving side should choose the first auth method it supports.

=item the acceptable framing formats

A comma-separated list of packet encoding/framign formats understood. The
receiving side should choose the first framing format it supports for
sending packets (which might be different from the format it has to accept).

=back

The remaining arguments are C<KEY=VALUE> pairs. The following key-value
pairs are known at this time:

=over 4

=item provider=<module-version>

The software provider for this implementation. For AnyEvent::MP, this is
C<AE-0.0> or whatever version it currently is at.

=item peeraddr=<host>:<port>

The peer address (socket address of the other side) as seen locally, in the same format
as noderef endpoints.

=item tls=<major>.<minor>

Indicates that the other side supports TLS (version should be 1.0) and
wishes to do a TLS handshake.

=item timeout=<seconds>

The amount of time after which this node should be detected as dead unless
some data has been received. The node is responsible to send traffic
reasonably more often than this interval (such as every timeout minus five
seconds).

=back

=head3 Second Greeting Line

After this greeting line there will be a second line containing a
cryptographic nonce, i.e. random data of high quality. To keep the
protocol text-only, these are usually 32 base64-encoded octets, but
it could be anything that doesn't contain any ASCII CR or ASCII LF
characters.

I<< The two nonces B<must> be different, and an aemp implementation
B<must> check and fail when they are identical >>.

Example of a nonce line:

   p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4

=head2 TLS handshake

I<< If, after the handshake, both sides indicate interest in TLS, then the
connection B<must> 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,
and the one with the higher nonce the server.

=head2 AUTHENTICATION PHASE

After the greeting is received (and the optional TLS handshake),
the authentication phase begins, which consists of sending a single
C<;>-separated line with three fixed strings and any number of
C<KEY=VALUE> pairs.

The three fixed strings are:

=over 4

=item the authentication method chosen

This must be one of the methods offered by the other side in the greeting.

The currently supported authentication methods are:

=over 4

=item cleartext

This is simply the shared secret, lowercase-hex-encoded. This method is of
course very insecure, unless TLS is used, which is why this module will
accept, but not generate, cleartext auth replies.

=item hmac_md6_64_256

This method uses an MD6 HMAC with 64 bit blocksize and 256 bit hash. First, the shared secret
is hashed with MD6:

   key = MD6 (secret)

This secret is then used to generate the "local auth reply", by taking
the two local greeting lines and the two remote greeting lines (without
line endings), appending \012 to all of them, concatenating them and
calculating the MD6 HMAC with the key.

   lauth = HMAC_MD6 key, "lgreeting1\012lgreeting2\012rgreeting1\012rgreeting2\012"

This authentication token is then lowercase-hex-encoded and sent to the
other side.

Then the remote auth reply is generated using the same method, but local
and remote greeting lines swapped:

   rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"

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<must> accept this authentication type.

=back

=item the authentication data

The authentication data itself, usually base64 or hex-encoded data, see
above.

=item the framing protocol chosen

This must be one of the framing protocols offered by the other side in the
greeting. Each side must accept the choice of the other side.

=back

Example of an authentication reply:

   hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json

=head2 DATA PHASE

After this, packets get exchanged using the chosen framing protocol. It is
quite possible that both sides use a different framing protocol.

=head2 FULL EXAMPLE

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.

   > aemp;0;nndKd+gn;10.0.0.1:4040;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:1235
   > sRG8bbc4TDbkpvH8FTP4HBs87OhepH6VuApoZqXXskuG
   < 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
   < dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo
   > hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json
   < hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json
   > ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"]

=head1 SEE ALSO

L<AnyEvent>.

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

1

Revision:	1.27
Committed:	Sun Aug 9 00:31:40 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.26:	+17 -7 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.13	AnyEvent::MP::Transport - actual transport protocol handler
4	root	1.1
5			=head1 SYNOPSIS
6
7			use AnyEvent::MP::Transport;
8
9			=head1 DESCRIPTION
10
11	root	1.13	This implements the actual transport protocol for MP (it represents a
12			single link), most of which is considered an implementation detail.
13	root	1.1
14	root	1.7	See the "PROTOCOL" section below if you want to write another client for
15			this protocol.
16	root	1.1
17			=head1 FUNCTIONS/METHODS
18
19			=over 4
20
21			=cut
22
23			package AnyEvent::MP::Transport;
24
25			use common::sense;
26
27	root	1.27	use Scalar::Util ();
28			use List::Util ();
29	root	1.1	use MIME::Base64 ();
30			use Storable ();
31	root	1.2	use JSON::XS ();
32	root	1.1
33	root	1.19	use Digest::MD6 ();
34			use Digest::HMAC_MD6 ();
35
36	root	1.1	use AE ();
37			use AnyEvent::Socket ();
38	root	1.27	use AnyEvent::Handle 4.92 ();
39	root	1.2
40	root	1.1	use base Exporter::;
41
42			our $VERSION = '0.0';
43	root	1.2	our $PROTOCOL_VERSION = 0;
44	root	1.1
45			=item $listener = mp_listener $host, $port, <constructor-args>, $cb->($transport)
46
47			Creates a listener on the given host/port using
48			C<AnyEvent::Socket::tcp_server>.
49
50			See C<new>, below, for constructor arguments.
51
52	root	1.10	Defaults for peerhost, peerport and fh are provided.
53	root	1.1
54			=cut
55
56			sub mp_server($$@) {
57			my $cb = pop;
58			my ($host, $port, @args) = @_;
59
60			AnyEvent::Socket::tcp_server $host, $port, sub {
61			my ($fh, $host, $port) = @_;
62
63			$cb->(new AnyEvent::MP::Transport
64			fh => $fh,
65			peerhost => $host,
66			peerport => $port,
67			@args,
68			);
69			}
70			}
71
72	root	1.2	=item $guard = mp_connect $host, $port, <constructor-args>, $cb->($transport)
73
74			=cut
75
76			sub mp_connect {
77			my $cb = pop;
78			my ($host, $port, @args) = @_;
79
80			AnyEvent::Socket::tcp_connect $host, $port, sub {
81			my ($fh, $nhost, $nport) = @_;
82
83			return $cb->() unless $fh;
84
85			$cb->(new AnyEvent::MP::Transport
86			fh => $fh,
87			peername => $host,
88			peerhost => $nhost,
89			peerport => $nport,
90			@args,
91			);
92			}
93			}
94
95	root	1.1	=item new AnyEvent::MP::Transport
96
97			# immediately starts negotiation
98			my $transport = new AnyEvent::MP::Transport
99	root	1.2	# mandatory
100	root	1.1	fh => $filehandle,
101	root	1.2	local_id => $identifier,
102	root	1.1	on_recv => sub { receive-callback },
103			on_error => sub { error-callback },
104
105			# optional
106			secret => "shared secret",
107			on_eof => sub { clean-close-callback },
108			on_connect => sub { successful-connect-callback },
109	root	1.2	greeting => { key => value },
110	root	1.1
111			# tls support
112			tls_ctx => AnyEvent::TLS,
113			peername => $peername, # for verification
114			;
115
116			=cut
117
118	root	1.27	sub LATENCY() { 3 } # assumed max. network latency
119
120	root	1.7	our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
121			our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send
122	root	1.13	our @AUTH_RCV = (@AUTH_SND, qw(cleartext)); # auth types we accept
123	root	1.7
124			#AnyEvent::Handle::register_write_type mp_record => sub {
125			#};
126	root	1.4
127	root	1.1	sub new {
128			my ($class, %arg) = @_;
129
130			my $self = bless \%arg, $class;
131
132			$self->{queue} = [];
133
134			{
135			Scalar::Util::weaken (my $self = $self);
136
137	root	1.5	$arg{secret} = AnyEvent::MP::Base::default_secret ()
138	root	1.2	unless exists $arg{secret};
139
140	root	1.27	$arg{timeout} = 30
141	root	1.24	unless exists $arg{timeout};
142
143	root	1.27	$arg{timeout} = 1 + LATENCY
144			if $arg{timeout} < 1 + LATENCY;
145
146	root	1.19	my $secret = $arg{secret};
147
148			if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.-----END RSA PRIVATE KEY-----.-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) {
149			# assume TLS mode
150			$arg{tls_ctx} = {
151			sslv2 => 0,
152			sslv3 => 0,
153			tlsv1 => 1,
154			verify => 1,
155			cert => $secret,
156			ca_cert => $secret,
157			verify_require_client_cert => 1,
158			};
159			}
160
161	root	1.1	$self->{hdl} = new AnyEvent::Handle
162	root	1.2	fh => delete $arg{fh},
163	root	1.4	autocork => 1,
164			no_delay => 1,
165	root	1.1	on_error => sub {
166			$self->error ($_[2]);
167			},
168	root	1.27	rtimeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT,
169	root	1.1	peername => delete $arg{peername},
170			;
171
172	root	1.2	my $greeting_kv = $self->{greeting} \|\|= {};
173	root	1.24
174			$self->{local_node} = $AnyEvent::MP::Base::NODE;
175
176			$greeting_kv->{"tls"} = "1.0" if $arg{tls_ctx};
177	root	1.2	$greeting_kv->{provider} = "AE-$VERSION";
178	root	1.7	$greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
179	root	1.26	$greeting_kv->{timeout} = $arg{timeout};
180	root	1.23
181	root	1.1	# send greeting
182	root	1.12	my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
183	root	1.24	. ";$self->{local_node}"
184	root	1.7	. ";" . (join ",", @AUTH_RCV)
185			. ";" . (join ",", @FRAMINGS)
186			. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
187	root	1.12
188	root	1.7	my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
189	root	1.1
190	root	1.7	$self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
191	root	1.1
192			# expect greeting
193	root	1.12	$self->{hdl}->rbuf_max (4 * 1024);
194	root	1.1	$self->{hdl}->push_read (line => sub {
195	root	1.7	my $rgreeting1 = $_[1];
196	root	1.1
197	root	1.26	my ($aemp, $version, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
198	root	1.1
199			if ($aemp ne "aemp") {
200			return $self->error ("unparsable greeting");
201	root	1.12	} elsif ($version != $PROTOCOL_VERSION) {
202			return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
203	root	1.1	}
204
205	root	1.7	my $s_auth;
206			for my $auth_ (split /,/, $auths) {
207			if (grep $auth_ eq $_, @AUTH_SND) {
208			$s_auth = $auth_;
209			last;
210			}
211			}
212
213			defined $s_auth
214			or return $self->error ("$auths: no common auth type supported");
215
216			die unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.
217
218			my $s_framing;
219			for my $framing_ (split /,/, $framings) {
220			if (grep $framing_ eq $_, @FRAMINGS) {
221			$s_framing = $framing_;
222			last;
223			}
224			}
225
226			defined $s_framing
227			or return $self->error ("$framings: no common framing method supported");
228
229	root	1.2	$self->{remote_node} = $rnode;
230	root	1.1
231	root	1.2	$self->{remote_greeting} = {
232			map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
233			@kv
234	root	1.1	};
235
236	root	1.7	# read nonce
237			$self->{hdl}->push_read (line => sub {
238			my $rgreeting2 = $_[1];
239
240	root	1.19	"$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack?
241			or return $self->error ("authentication error, echo attack?");
242
243			my $key = Digest::MD6::md6 $secret;
244			my $lauth;
245
246	root	1.10	if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
247	root	1.8	$self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
248			$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
249	root	1.19	$s_auth = "tls";
250			$lauth = "";
251			} else {
252			# we currently only support hmac_md6_64_256
253			$lauth = Digest::HMAC_MD6::hmac_md6_hex $key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256;
254	root	1.8	}
255	root	1.2
256	root	1.7	$self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
257	root	1.2
258	root	1.19	# read the authentication response
259	root	1.7	$self->{hdl}->push_read (line => sub {
260			my ($hdl, $rline) = @_;
261	root	1.2
262	root	1.7	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
263	root	1.1
264	root	1.19	my $rauth =
265			$auth_method eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex $key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256
266			: $auth_method eq "cleartext" ? unpack "H*", $secret
267			: $auth_method eq "tls" ? ($self->{tls} ? "" : "\012\012") # \012\012 never matches
268			: return $self->error ("$auth_method: fatal, selected unsupported auth method");
269
270	root	1.7	if ($rauth2 ne $rauth) {
271			return $self->error ("authentication failure/shared secret mismatch");
272			}
273	root	1.1
274	root	1.7	$self->{s_framing} = $s_framing;
275	root	1.2
276	root	1.7	$hdl->rbuf_max (undef);
277			my $queue = delete $self->{queue}; # we are connected
278	root	1.1
279	root	1.27	$self->{hdl}->rtimeout ($self->{remote_greeting}{timeout});
280			$self->{hdl}->wtimeout ($arg{timeout} - LATENCY);
281			$self->{hdl}->on_wtimeout (sub { $self->send (["", "devnull"]) });
282	root	1.24
283	root	1.7	$self->connected;
284	root	1.1
285	root	1.27	# send queued messages
286	root	1.23	$self->send ($_)
287	root	1.7	for @$queue;
288	root	1.1
289	root	1.27	# receive handling
290			my $src_node = $self->{node};
291
292	root	1.22	my $rmsg; $rmsg = sub {
293	root	1.7	$_[0]->push_read ($r_framing => $rmsg);
294	root	1.1
295	root	1.12	local $AnyEvent::MP::Base::SRCNODE = $src_node;
296			AnyEvent::MP::Base::_inject (@{ $_[1] });
297	root	1.7	};
298			$hdl->push_read ($r_framing => $rmsg);
299			});
300	root	1.1	});
301			});
302			}
303
304			$self
305			}
306
307			sub error {
308			my ($self, $msg) = @_;
309
310	root	1.4	if ($self->{node} && $self->{node}{transport} == $self) {
311	root	1.21	#TODO: store error, but do not instantly fail
312			$self->{node}->fail (transport_error => $self->{node}{noderef}, $msg);
313	root	1.4	$self->{node}->clr_transport;
314			}
315	root	1.7	$AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
316	root	1.4	$self->destroy;
317	root	1.1	}
318
319	root	1.2	sub connected {
320			my ($self) = @_;
321
322	root	1.23	if (ref $AnyEvent::MP::Base::SLAVE) {
323			# first connect with a master node
324	root	1.24	my $via = $self->{remote_node};
325			$via =~ s/,/!/g;
326			$AnyEvent::MP::Base::NODE .= "\@$via";
327	root	1.23	$AnyEvent::MP::Base::NODE{$AnyEvent::MP::Base::NODE} = $AnyEvent::MP::Base::NODE{""};
328			$AnyEvent::MP::Base::SLAVE->();
329			}
330
331			if ($self->{local_node} ne $AnyEvent::MP::Base::NODE) {
332			# node changed its name since first greeting
333			$self->send (["", iam => $AnyEvent::MP::Base::NODE]);
334			}
335
336	root	1.5	my $node = AnyEvent::MP::Base::add_node ($self->{remote_node});
337	root	1.4	Scalar::Util::weaken ($self->{node} = $node);
338			$node->set_transport ($self);
339	root	1.2	}
340
341	root	1.1	sub send {
342	root	1.2	$_[0]{hdl}->push_write ($_[0]{s_framing} => $_[1]);
343	root	1.1	}
344
345			sub destroy {
346			my ($self) = @_;
347
348	root	1.2	$self->{hdl}->destroy
349			if $self->{hdl};
350	root	1.1	}
351
352			sub DESTROY {
353			my ($self) = @_;
354
355			$self->destroy;
356			}
357
358			=back
359
360	root	1.7	=head1 PROTOCOL
361
362			The protocol is relatively simple, and consists of three phases which are
363			symmetrical for both sides: greeting (followed by optionally switching to
364			TLS mode), authentication and packet exchange.
365
366			the protocol is designed to allow both full-text and binary streams.
367
368			The greeting consists of two text lines that are ended by either an ASCII
369			CR LF pair, or a single ASCII LF (recommended).
370
371			=head2 GREETING
372
373	root	1.15	All the lines until after authentication must not exceed 4kb in length,
374			including delimiter. Afterwards there is no limit on the packet size that
375			can be received.
376
377			=head3 First Greeting Line
378	root	1.12
379	root	1.16	Example:
380
381			aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0
382
383			The first line contains strings separated (not ended) by C<;>
384			characters. The first even ixtrings are fixed by the protocol, the
385			remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
386			characters themselves.
387
388	root	1.12	The fixed strings are:
389	root	1.7
390			=over 4
391
392	root	1.18	=item protocol identification
393	root	1.7
394			The constant C<aemp> to identify the protocol.
395
396			=item protocol version
397
398	root	1.12	The protocol version supported by this end, currently C<0>. If the
399			versions don't match then no communication is possible. Minor extensions
400	root	1.18	are supposed to be handled through additional key-value pairs.
401	root	1.7
402			=item the node endpoint descriptors
403
404			for public nodes, this is a comma-separated list of protocol endpoints,
405	root	1.26	i.e., the noderef. For slave nodes, this is a unique identifier of the
406			form C<slave/nonce>.
407	root	1.7
408			=item the acceptable authentication methods
409
410			A comma-separated list of authentication methods supported by the
411			node. Note that AnyEvent::MP supports a C<hex_secret> authentication
412			method that accepts a cleartext password (hex-encoded), but will not use
413			this auth method itself.
414
415			The receiving side should choose the first auth method it supports.
416
417			=item the acceptable framing formats
418
419			A comma-separated list of packet encoding/framign formats understood. The
420			receiving side should choose the first framing format it supports for
421			sending packets (which might be different from the format it has to accept).
422
423	root	1.10	=back
424	root	1.8
425			The remaining arguments are C<KEY=VALUE> pairs. The following key-value
426			pairs are known at this time:
427
428			=over 4
429
430			=item provider=<module-version>
431
432			The software provider for this implementation. For AnyEvent::MP, this is
433			C<AE-0.0> or whatever version it currently is at.
434
435			=item peeraddr=<host>:<port>
436
437			The peer address (socket address of the other side) as seen locally, in the same format
438			as noderef endpoints.
439
440			=item tls=<major>.<minor>
441
442			Indicates that the other side supports TLS (version should be 1.0) and
443			wishes to do a TLS handshake.
444
445	root	1.26	=item timeout=<seconds>
446	root	1.24
447	root	1.26	The amount of time after which this node should be detected as dead unless
448			some data has been received. The node is responsible to send traffic
449			reasonably more often than this interval (such as every timeout minus five
450			seconds).
451	root	1.24
452	root	1.8	=back
453
454	root	1.15	=head3 Second Greeting Line
455
456	root	1.8	After this greeting line there will be a second line containing a
457			cryptographic nonce, i.e. random data of high quality. To keep the
458			protocol text-only, these are usually 32 base64-encoded octets, but
459			it could be anything that doesn't contain any ASCII CR or ASCII LF
460			characters.
461
462	root	1.14	I<< The two nonces B<must> be different, and an aemp implementation
463			B<must> check and fail when they are identical >>.
464
465	root	1.16	Example of a nonce line:
466	root	1.8
467	root	1.12	p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
468	root	1.8
469			=head2 TLS handshake
470
471	root	1.14	I<< If, after the handshake, both sides indicate interest in TLS, then the
472	root	1.20	connection B<must> use TLS, or fail. >>
473	root	1.8
474			Both sides compare their nonces, and the side who sent the lower nonce
475			value ("string" comparison on the raw octet values) becomes the client,
476			and the one with the higher nonce the server.
477
478			=head2 AUTHENTICATION PHASE
479
480			After the greeting is received (and the optional TLS handshake),
481			the authentication phase begins, which consists of sending a single
482			C<;>-separated line with three fixed strings and any number of
483			C<KEY=VALUE> pairs.
484
485			The three fixed strings are:
486
487			=over 4
488
489			=item the authentication method chosen
490
491			This must be one of the methods offered by the other side in the greeting.
492
493	root	1.13	The currently supported authentication methods are:
494
495			=over 4
496
497			=item cleartext
498
499			This is simply the shared secret, lowercase-hex-encoded. This method is of
500			course very insecure, unless TLS is used, which is why this module will
501			accept, but not generate, cleartext auth replies.
502
503			=item hmac_md6_64_256
504
505			This method uses an MD6 HMAC with 64 bit blocksize and 256 bit hash. First, the shared secret
506			is hashed with MD6:
507
508			key = MD6 (secret)
509
510			This secret is then used to generate the "local auth reply", by taking
511			the two local greeting lines and the two remote greeting lines (without
512			line endings), appending \012 to all of them, concatenating them and
513			calculating the MD6 HMAC with the key.
514
515			lauth = HMAC_MD6 key, "lgreeting1\012lgreeting2\012rgreeting1\012rgreeting2\012"
516
517			This authentication token is then lowercase-hex-encoded and sent to the
518			other side.
519
520			Then the remote auth reply is generated using the same method, but local
521			and remote greeting lines swapped:
522
523			rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"
524
525			This is the token that is expected from the other side.
526
527	root	1.19	=item tls
528
529			This type is only valid iff TLS was enabled and the TLS handshake
530			was successful. It has no authentication data, as the server/client
531			certificate was successfully verified.
532
533			Implementations supporting TLS I<must> accept this authentication type.
534
535	root	1.13	=back
536
537	root	1.8	=item the authentication data
538
539	root	1.13	The authentication data itself, usually base64 or hex-encoded data, see
540			above.
541	root	1.8
542			=item the framing protocol chosen
543
544			This must be one of the framing protocols offered by the other side in the
545			greeting. Each side must accept the choice of the other side.
546
547			=back
548
549	root	1.16	Example of an authentication reply:
550	root	1.9
551	root	1.13	hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json
552	root	1.9
553	root	1.8	=head2 DATA PHASE
554
555			After this, packets get exchanged using the chosen framing protocol. It is
556			quite possible that both sides use a different framing protocol.
557
558	root	1.16	=head2 FULL EXAMPLE
559
560	root	1.17	This is an actual protocol dump of a handshake, followed by a single data
561	root	1.16	packet. The greater than/less than lines indicate the direction of the
562			transfer only.
563
564			> aemp;0;nndKd+gn;10.0.0.1:4040;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:1235
565			> sRG8bbc4TDbkpvH8FTP4HBs87OhepH6VuApoZqXXskuG
566			< 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
567			< dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo
568			> hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json
569			< hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json
570	root	1.18	> ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"]
571	root	1.16
572	root	1.1	=head1 SEE ALSO
573
574			L<AnyEvent>.
575
576			=head1 AUTHOR
577
578			Marc Lehmann <schmorp@schmorp.de>
579			http://home.schmorp.de/
580
581			=cut
582
583			1
584