[ViewVC] Diff of: cvs/AnyEvent-MP/MP/Transport.pm

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.8 by root, Mon Aug 3 14:58:13 2009 UTC vs.
Revision 1.14 by root, Tue Aug 4 07:46:33 2009 UTC

 =head1 NAME
-AnyEvent::MP::Transport - actual transport protocol
+AnyEvent::MP::Transport - actual transport protocol handler
 =head1 SYNOPSIS
    use AnyEvent::MP::Transport;
 =head1 DESCRIPTION
-This is the superclass for MP transports, most of which is considered an
+This implements the actual transport protocol for MP (it represents a
-implementation detail.
+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
 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, fh and tls are provided.
+Defaults for peerhost, peerport and fh are provided.
 =cut
 sub mp_server($$@) {
    my $cb = pop;
       $cb->(new AnyEvent::MP::Transport
          fh       => $fh,
          peerhost => $host,
          peerport => $port,
-         tls      => "accept",
          @args,
       );
    }
 }
       $cb->(new AnyEvent::MP::Transport
          fh       => $fh,
          peername => $host,
          peerhost => $nhost,
          peerport => $nport,
-         tls      => "accept",
          @args,
       );
    }
 }
       on_eof   => sub { clean-close-callback },
       on_connect => sub { successful-connect-callback },
       greeting => { key => value },
       # tls support
-      tls      => "accept|connect",
       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(hex_secret)); # auth types we accept
+our @AUTH_RCV = (@AUTH_SND, qw(cleartext)); # auth types we accept
 #AnyEvent::Handle::register_write_type mp_record => sub {
 #};
 sub new {
    $self->{queue} = [];
    {
       Scalar::Util::weaken (my $self = $self);
-      if (exists $arg{connect}) {
+      $arg{tls_ctx_disabled} ||= {
-         $arg{tls_ctx} ||= { sslv2 => 0, sslv3 => 0, tlsv1 => 1, verify => 1 };
+         sslv2  => 0,
+         sslv3  => 0,
+         tlsv1  => 1,
+         verify => 1,
+         cert_file => "secret.pem",
+         ca_file   => "secret.pem",
+         verify_require_client_cert => 1,
-      }
+      };
       $arg{secret} = AnyEvent::MP::Base::default_secret ()
          unless exists $arg{secret};
       $self->{hdl} = new AnyEvent::Handle
          fh       => delete $arg{fh},
-         rbuf_max => 64 * 1024,
          autocork => 1,
          no_delay => 1,
          on_error => sub {
             $self->error ($_[2]);
          },
          if $arg{tls_ctx};
       $greeting_kv->{provider} = "AE-$VERSION";
       $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
       # send greeting
-      my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min
+      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, $version_min, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
+         my ($aemp, $version, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
          if ($aemp ne "aemp") {
             return $self->error ("unparsable greeting");
-         } elsif ($version_min > $PROTOCOL_VERSION) {
+         } elsif ($version != $PROTOCOL_VERSION) {
-            return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $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) {
          # read nonce
          $self->{hdl}->push_read (line => sub {
             my $rgreeting2 = $_[1];
-            if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{"tls"}) {
+            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});
             }
             # auth
             require Digest::MD6;
             require Digest::HMAC_MD6;
-            my $key   = Digest::MD6::md6_hex ($secret);
+            my $key   = Digest::MD6::md6 ($secret);
-            my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
+            my $lauth = Digest::HMAC_MD6::hmac_md6_hex ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
             my $rauth =
-               $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256)
+               $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_hex ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256)
-             : $s_auth eq "hex_secret"      ? unpack "H*", $secret
+             : $s_auth eq "cleartext"       ? unpack "H*", $secret
              : die;
             $lauth ne $rauth # echo attack?
                or return $self->error ("authentication error");
             $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
-            $self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so
+            # reasd the authentication response
             $self->{hdl}->push_read (line => sub {
                my ($hdl, $rline) = @_;
                my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
                $hdl->rbuf_max (undef);
                my $queue = delete $self->{queue}; # we are connected
                $self->connected;
+               my $src_node = $self->{node};
                $hdl->push_write ($self->{s_framing} => $_)
                   for @$queue;
                my $rmsg; $rmsg = sub  {
                   $_[0]->push_read ($r_framing => $rmsg);
+                  local $AnyEvent::MP::Base::SRCNODE = $src_node;
-                  AnyEvent::MP::Base::_inject ($_[1]);
+                  AnyEvent::MP::Base::_inject (@{ $_[1] });
                };
                $hdl->push_read ($r_framing => $rmsg);
             });
          });
       });
 CR LF pair, or a single ASCII LF (recommended).
 =head2 GREETING
 The first line contains strings separated (not ended) by C<;>
-characters. The first seven strings are fixed by the protocol, the
+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.
+All the lines until after authentication must not exceed 4kb in length, including delimiter.
-The seven fixed strings are:
+The fixed strings are:
 =over 4
 =item C<aemp>
 The constant C<aemp> to identify the protocol.
 =item protocol version
-The (maximum) protocol version supported by this end, currently C<0>.
-=item minimum protocol version
-The minimum protocol version supported by this end, currently C<0>.
+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 by addign 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
 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).
-=cut
+=back
 The remaining arguments are C<KEY=VALUE> pairs. The following key-value
 pairs are known at this time:
 =over 4
 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 the two lines of greeting:
-   aemp;0;0;e7d.4a76f48f;10.0.0.1:4040;hmac_md6_64_256,hex_secret;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:1235
+   aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0
-   XntegV2Guvss0qNn7phCPnoU87xqxV+4Mqm/5y4iQm6a
+   p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
 =head2 TLS handshake
-If, after the handshake, both sides indicate interest in TLS, then the
+I<< If, after the handshake, both sides indicate interest in TLS, then the
-connection I<must> use TLS, or fail.
+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.
 =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.
+=back
 =item the authentication data
-The authentication data itself, usually base64 or hex-encoded 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:
+   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.

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent-MP/MP/Transport.pm (file contents): Revision 1.8 by root, Mon Aug 3 14:58:13 2009 UTC vs. Revision 1.14 by root, Tue Aug 4 07:46:33 2009 UTC

Diff Legend

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.8 by root, Mon Aug 3 14:58:13 2009 UTC vs.
Revision 1.14 by root, Tue Aug 4 07:46:33 2009 UTC