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 AnyEvent::MP::Config ();

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

      my $config = AnyEvent::MP::Config::node_config;

      $arg{secret} = $config->{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 (exists $config->{cert}) {
         $arg{tls_ctx} = {
            sslv2   => 0,
            sslv3   => 0,
            tlsv1   => 1,
            verify  => 1,
            cert    => $config->{cert},
            ca_cert => $config->{cert},
            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-$AnyEvent::MP::Base::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 (66), "";

      $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;
            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 = "";
            } elsif (length $secret) {
               $key = Digest::MD6::md6 $secret;
               # 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;
            } else {
               return $self->error ("unable to handshake TLS and no shared secret configured");
            }

            $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->(1);
   }

   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::MP>.

=head1 AUTHOR

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

=cut

1

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