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

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