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 MIME::Base64 ();
use Storable ();
use JSON::XS ();

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

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

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

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} = 3#d#
         unless exists $arg{timeout};

      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]);
         },
         timeout  => $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}->timeout ($self->{remote_greeting}{timeout});

               $self->connected;

               my $src_node = $self->{node};

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

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