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

      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]);
         },
         peername => delete $arg{peername},
      ;

      my $greeting_kv = $self->{greeting} ||= {};
      $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};

      $self->{local_node} = $AnyEvent::MP::Base::NODE;

      # send greeting
      my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
                     . ";$AnyEvent::MP::Base::UNIQ"
                     . ";$AnyEvent::MP::Base::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->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
      $AnyEvent::MP::Base::NODE .= "\@$self->{remote_node}";
      $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.

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