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

      my $keepalive = (int $arg{timeout} * 0.75) || 1;

      my $secret = $arg{secret};

      if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) {
         # assume TLS mode
         $arg{tls_ctx} = {
            sslv2   => 0,
            sslv3   => 0,
            tlsv1   => 1,
            verify  => 1,
            cert    => $secret,
            ca_cert => $secret,
            verify_require_client_cert => 1,
         };
      }

      $self->{hdl} = new AnyEvent::Handle
         fh       => delete $arg{fh},
         autocork => 1,
         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->{maxidle}  = $keepalive;

      # send greeting
      my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
                     . ";$AnyEvent::MP::Base::UNIQ"
                     . ";$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, $uniq, $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_uniq} = $uniq;
         $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}{keepalive} + 5)
#                  if $self->{remote_greeting}{keepalive};

               $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 a token uniquely identifying the current node instance

This is a string that must change between restarts. It usually contains
things like the current time, the (OS) process id or similar values, but
no meaning of the contents are assumed.

=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.

=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 maxidle=<seconds>

The maximum amount of time the node will not sent data, i.e., idle. This
can be used to close the conenction when no data has been received for a
too-long time (say, maxidle + 5 seconds).

=back

=head3 Second Greeting Line

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