AnyEvent-MP/MP/Transport.pm

=head1 NAME

AnyEvent::MP::Transport - actual transport protocol handler

=head1 SYNOPSIS

   use AnyEvent::MP::Transport;

=head1 DESCRIPTION

This implements the actual transport protocol for MP (it represents a
single link), most of which is considered an implementation detail.

See the "PROTOCOL" section below if you want to write another client for
this protocol.

=head1 FUNCTIONS/METHODS

=over 4

=cut

package AnyEvent::MP::Transport;

use common::sense;

use Scalar::Util ();
use List::Util ();
use MIME::Base64 ();
use Storable ();
use JSON::XS ();

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

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

use AnyEvent::MP::Config ();

our $PROTOCOL_VERSION = 0;

=item $listener = mp_listener $host, $port, <constructor-args>

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 ($host, $port, @args) = @_;

   AnyEvent::Socket::tcp_server $host, $port, sub {
      my ($fh, $host, $port) = @_;

      my $tp = new AnyEvent::MP::Transport
         fh       => $fh,
         peerhost => $host,
         peerport => $port,
         @args,
      ;
      $tp->{keepalive} = $tp;
   }
}

=item $guard = mp_connect $host, $port, <constructor-args>, $cb->($transport)

=cut

sub mp_connect {
   my $release = pop;
   my ($host, $port, @args) = @_;

   my $state;

   $state = AnyEvent::Socket::tcp_connect $host, $port, sub {
      my ($fh, $nhost, $nport) = @_;

      return $release->() unless $fh;

      $state = new AnyEvent::MP::Transport
         fh       => $fh,
         peername => $host,
         peerhost => $nhost,
         peerport => $nport,
         release  => $release,
         @args,
      ;
   };

   \$state
}

=item new AnyEvent::MP::Transport

   # immediately starts negotiation
   my $transport = new AnyEvent::MP::Transport
      # mandatory
      fh       => $filehandle,
      local_id => $identifier,
      on_recv  => sub { receive-callback },
      on_error => sub { error-callback },

      # optional
      on_eof   => sub { clean-close-callback },
      on_connect => sub { successful-connect-callback },
      greeting => { key => value },

      # tls support
      tls_ctx  => AnyEvent::TLS,
      peername => $peername, # for verification
   ;

=cut

sub LATENCY() { 3 } # assumed max. network latency

our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
our @AUTH_SND = qw(tls_md6_64_256 hmac_md6_64_256); # auth types we send
our @AUTH_RCV = (@AUTH_SND, qw(tls_anon cleartext)); # auth types we accept

#AnyEvent::Handle::register_write_type mp_record => sub {
#};

sub new {
   my ($class, %arg) = @_;

   my $self = bless \%arg, $class;

   $self->{queue} = [];

   {
      Scalar::Util::weaken (my $self = $self);

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

      my $latency = $config->{network_latency} || LATENCY;

      $arg{secret} = $config->{secret}
         unless exists $arg{secret};

      $arg{timeout} = $config->{monitor_timeout} || $AnyEvent::MP::Kernel::MONITOR_TIMEOUT
         unless exists $arg{timeout};

      $arg{timeout} -= $latency;

      $arg{timeout} = 1 + $latency
         if $arg{timeout} < 1 + $latency;

      my $secret = $arg{secret};

      if (exists $config->{cert}) {
         $arg{tls_ctx} = {
            sslv2   => 0,
            sslv3   => 0,
            tlsv1   => 1,
            verify  => 1,
            cert    => $config->{cert},
            ca_cert => $config->{cert},
            verify_require_client_cert => 1,
         };
      }

      $self->{hdl} = new AnyEvent::Handle
         fh       => delete $arg{fh},
         autocork => 1,
         no_delay => 1,
         on_error => sub {
            $self->error ($_[2]);
         },
         rtimeout => $latency,
         peername => delete $arg{peername},
      ;

      my $greeting_kv = $self->{greeting} ||= {};

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

      $greeting_kv->{tls}      = "1.0" if $arg{tls_ctx};
      $greeting_kv->{provider} = "AE-$AnyEvent::MP::Kernel::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::Kernel::nonce (66), "";

      $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");

      # expect greeting
      $self->{hdl}->rbuf_max (4 * 1024);
      $self->{hdl}->push_read (line => sub {
         my $rgreeting1 = $_[1];

         my ($aemp, $version, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;

         if ($aemp ne "aemp") {
            return $self->error ("unparsable greeting");
         } elsif ($version != $PROTOCOL_VERSION) {
            return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
         } elsif ($rnode eq $self->{local_node}) {
            return $self->error ("I refuse to talk to myself");
         } elsif ($AnyEvent::MP::Kernel::NODE{$rnode} && $AnyEvent::MP::Kernel::NODE{$rnode}{transport}) {
            return $self->error ("$rnode already connected, not connecting again.");
         }

         $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 $tls = $self->{tls_ctx} && 1 == int $self->{remote_greeting}{tls};

            my $s_auth;
            for my $auth_ (split /,/, $auths) {
               if (grep $auth_ eq $_, @AUTH_SND and ($auth_ !~ /^tls_/ or $tls)) {
                  $s_auth = $auth_;
                  last;
               }
            }

            defined $s_auth
               or return $self->error ("$auths: no common auth type supported");

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

            my $key;
            my $lauth;

            if ($tls) {
               $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
               $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});

               $lauth =
                  $s_auth eq "tls_anon"       ? ""
                : $s_auth eq "tls_md6_64_256" ? Digest::MD6::md6_hex "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012"
                : return $self->error ("$s_auth: fatal, selected unsupported snd auth method");

            } elsif (length $secret) {
               return $self->error ("$s_auth: fatal, selected unsupported snd auth method")
                  unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.

               $key = Digest::MD6::md6 $secret;
               # we currently only support hmac_md6_64_256
               $lauth = Digest::HMAC_MD6::hmac_md6_hex $key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256;

            } else {
               return $self->error ("unable to handshake TLS and no shared secret configured");
            }

            $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");

            # read the authentication response
            $self->{hdl}->push_read (line => sub {
               my ($hdl, $rline) = @_;

               my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;

               my $rauth =
                  $auth_method eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex $key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256
                : $auth_method eq "cleartext"       ? unpack "H*", $secret
                : $auth_method eq "tls_anon"        ? ($tls ? "" : "\012\012") # \012\012 never matches
                : $auth_method eq "tls_md6_64_256"  ? ($tls ? Digest::MD6::md6_hex "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012" : "\012\012")
                : return $self->error ("$auth_method: fatal, selected unsupported rcv auth method");

               if ($rauth2 ne $rauth) {
                  return $self->error ("authentication failure/shared secret mismatch");
               }

               $self->{s_framing} = $s_framing;

               $hdl->rbuf_max (undef);
               my $queue = delete $self->{queue}; # we are connected

               $self->{hdl}->rtimeout ($self->{remote_greeting}{timeout});
               $self->{hdl}->wtimeout ($arg{timeout} - LATENCY);
               $self->{hdl}->on_wtimeout (sub { $self->send ([]) });

               $self->connected;

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

               # receive handling
               my $src_node = $self->{node};

               my $rmsg; $rmsg = sub {
                  $_[0]->push_read ($r_framing => $rmsg);

                  local $AnyEvent::MP::Kernel::SRCNODE = $src_node;
                  AnyEvent::MP::Kernel::_inject (@{ $_[1] });
               };
               $hdl->push_read ($r_framing => $rmsg);
            });
         });
      });
   }

   $self
}

sub error {
   my ($self, $msg) = @_;

   delete $self->{keepalive};

#   $AnyEvent::MP::Kernel::WARN->(9, "$self->{peerhost}:$self->{peerport} $msg");#d#

   $self->{node}->transport_error (transport_error => $self->{node}{id}, $msg)
      if $self->{node} && $self->{node}{transport} == $self;

   (delete $self->{release})->()
      if exists $self->{release};
   
#   $AnyEvent::MP::Kernel::WARN->(7, "$self->{peerhost}:$self->{peerport}: $msg");
   $self->destroy;
}

sub connected {
   my ($self) = @_;

   delete $self->{keepalive};

   (delete $self->{release})->()
      if exists $self->{release};

   $AnyEvent::MP::Kernel::WARN->(9, "$self->{peerhost}:$self->{peerport} connected as $self->{remote_node}");

   my $node = AnyEvent::MP::Kernel::add_node ($self->{remote_node});
   Scalar::Util::weaken ($self->{node} = $node);
   $node->transport_connect ($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 id

This is the node ID of the connecting node.

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

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

Note that all methods starting with C<tls_> are only valid I<iff> TLS was
successfully handshaked (and to be secure the implementation must enforce
this).

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_anon

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.

This authentication type is slightly less secure than the others, as it
allows a man-in-the-middle attacker to change some of the connection
parameters (such as the framing format), although there is no known attack
that exploits this in a way that is worse than just denying the service.

By default, this implementation accepts but uses this authentication
method.

=item tls_md6_64_256

This type is only valid iff TLS was enabled and the TLS handshake
was successful.

This authentication type simply calculates:

   lauth = MD6 "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"

and lowercase-hex encodes the result and sends it as authentication
data. No shared secret is required (authentication is done by TLS). The
checksum solely exists to make tinkering with the greeting hard.

=back

=item the authentication data

The authentication data itself, usually base64 or hex-encoded data, see
above.

=item the framing protocol chosen

This must be one of the framing protocols offered by the other side in the
greeting. Each side must accept the choice of the other side.

=back

Example of an authentication reply:

   hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json

=head2 DATA PHASE

After this, packets get exchanged using the chosen framing protocol. It is
quite possible that both sides use a different framing protocol.

=head2 FULL EXAMPLE

This is an actual protocol dump of a handshake, followed by a single data
packet. The greater than/less than lines indicate the direction of the
transfer only.

   > aemp;0;nndKd+gn;10.0.0.1:4040;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:1235
   > sRG8bbc4TDbkpvH8FTP4HBs87OhepH6VuApoZqXXskuG
   < aemp;0;nmpKd+gh;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256,cleartext;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:58760
   < dCEUcL/LJVSTJcx8byEsOzrwhzJYOq+L3YcopA5T6EAo
   > hmac_md6_64_256;9513d4b258975accfcb2ab7532b83690e9c119a502c612203332a591c7237788;json
   < hmac_md6_64_256;0298d6ba2240faabb2b2e881cf86b97d70a113ca74a87dc006f9f1e9d3010f90;json
   > ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"]

=head1 SEE ALSO

L<AnyEvent::MP>.

=head1 AUTHOR

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

=cut

1

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