| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | =head1 NAME | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | AnyEvent::MP::Transport - actual transport protocol handler | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | use AnyEvent::MP::Transport; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | This module implements (and documents) the actual transport protocol for | 
| 12 |  |  |  |  |  |  | AEMP. | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | See the "PROTOCOL" section below if you want to write another client for | 
| 15 |  |  |  |  |  |  | this protocol. | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | =head1 FUNCTIONS/METHODS | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =over 4 | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | =cut | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | package AnyEvent::MP::Transport; | 
| 24 |  |  |  |  |  |  |  | 
| 25 | 1 |  |  | 1 |  | 460 | use common::sense; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 3 |  | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 1 |  |  | 1 |  | 35 | use Scalar::Util (); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 10 |  | 
| 28 | 1 |  |  | 1 |  | 4 | use List::Util (); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 9 |  | 
| 29 | 1 |  |  | 1 |  | 369 | use MIME::Base64 (); | 
|  | 1 |  |  |  |  | 640 |  | 
|  | 1 |  |  |  |  | 24 |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 | 1 |  |  | 1 |  | 415 | use Digest::SHA3 (); | 
|  | 1 |  |  |  |  | 1621 |  | 
|  | 1 |  |  |  |  | 24 |  | 
| 32 | 1 |  |  | 1 |  | 507 | use Digest::HMAC (); | 
|  | 1 |  |  |  |  | 389 |  | 
|  | 1 |  |  |  |  | 14 |  | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 1 |  |  | 1 |  | 5 | use AnyEvent (); | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 11 |  | 
| 35 | 1 |  |  | 1 |  | 404 | use AnyEvent::Socket (); | 
|  | 1 |  |  |  |  | 18246 |  | 
|  | 1 |  |  |  |  | 32 |  | 
| 36 | 1 |  |  | 1 |  | 621 | use AnyEvent::Handle 4.92 (); | 
|  | 1 |  |  |  |  | 5644 |  | 
|  | 1 |  |  |  |  | 24 |  | 
| 37 |  |  |  |  |  |  |  | 
| 38 | 1 |  |  | 1 |  | 23 | use AnyEvent::MP::Config (); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 2670 |  | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | our $PROTOCOL_VERSION = 1; | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | our @HOOK_GREET;   # called at connect/accept time | 
| 43 |  |  |  |  |  |  | our @HOOK_GREETED; # called at greeting1 time | 
| 44 |  |  |  |  |  |  | our @HOOK_CONNECT; # called at data phase | 
| 45 |  |  |  |  |  |  | our @HOOK_DESTROY; # called at destroy time | 
| 46 |  |  |  |  |  |  | our %HOOK_PROTOCOL = ( | 
| 47 |  |  |  |  |  |  | "aemp-dataconn" => sub { | 
| 48 |  |  |  |  |  |  | require AnyEvent::MP::DataConn; | 
| 49 |  |  |  |  |  |  | &AnyEvent::MP::DataConn::_inject; | 
| 50 |  |  |  |  |  |  | }, | 
| 51 |  |  |  |  |  |  | ); | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | =item $listener = mp_server $host, $port, | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | Creates a listener on the given host/port using | 
| 56 |  |  |  |  |  |  | C. | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | See C, below, for constructor arguments. | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | Defaults for peerhost, peerport and fh are provided. | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | =cut | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | sub mp_server($$;%) { | 
| 65 | 0 |  |  | 0 | 1 |  | my ($host, $port, %arg) = @_; | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | AnyEvent::Socket::tcp_server $host, $port, sub { | 
| 68 | 0 |  |  | 0 |  |  | my ($fh, $host, $port) = @_; | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 0 |  |  |  |  |  | my $tp = new AnyEvent::MP::Transport | 
| 71 |  |  |  |  |  |  | fh       => $fh, | 
| 72 |  |  |  |  |  |  | peerhost => $host, | 
| 73 |  |  |  |  |  |  | peerport => $port, | 
| 74 |  |  |  |  |  |  | %arg, | 
| 75 |  |  |  |  |  |  | ; | 
| 76 | 0 |  |  |  |  |  | $tp->{keepalive} = $tp; | 
| 77 |  |  |  |  |  |  | }, delete $arg{prepare} | 
| 78 | 0 |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | =item $guard = mp_connect $host, $port, , $cb->($transport) | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | =cut | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | sub mp_connect { | 
| 85 | 0 |  |  | 0 | 1 |  | my $release = pop; | 
| 86 | 0 |  |  |  |  |  | my ($host, $port, @args) = @_; | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 0 |  |  |  |  |  | new AnyEvent::MP::Transport | 
| 89 |  |  |  |  |  |  | connect  => [$host, $port], | 
| 90 |  |  |  |  |  |  | peerhost => $host, | 
| 91 |  |  |  |  |  |  | peerport => $port, | 
| 92 |  |  |  |  |  |  | release  => $release, | 
| 93 |  |  |  |  |  |  | @args, | 
| 94 |  |  |  |  |  |  | ; | 
| 95 |  |  |  |  |  |  | } | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | =item new AnyEvent::MP::Transport | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | Create a new transport - usually used via C or C | 
| 100 |  |  |  |  |  |  | instead. | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | # immediately starts negotiation | 
| 103 |  |  |  |  |  |  | my $transport = new AnyEvent::MP::Transport | 
| 104 |  |  |  |  |  |  | # mandatory | 
| 105 |  |  |  |  |  |  | fh         => $filehandle, | 
| 106 |  |  |  |  |  |  | local_id   => $identifier, | 
| 107 |  |  |  |  |  |  | on_recv    => sub { receive-callback }, | 
| 108 |  |  |  |  |  |  | on_error   => sub { error-callback }, | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | # optional | 
| 111 |  |  |  |  |  |  | on_greet   => sub { before sending greeting }, | 
| 112 |  |  |  |  |  |  | on_greeted => sub { after receiving greeting }, | 
| 113 |  |  |  |  |  |  | on_connect => sub { successful-connect-callback }, | 
| 114 |  |  |  |  |  |  | greeting   => { key => value }, | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | # tls support | 
| 117 |  |  |  |  |  |  | tls_ctx    => AnyEvent::TLS, | 
| 118 |  |  |  |  |  |  | peername   => $peername, # for verification | 
| 119 |  |  |  |  |  |  | ; | 
| 120 |  |  |  |  |  |  |  | 
| 121 |  |  |  |  |  |  | =cut | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | sub hmac_sha3_512_hex($$) { | 
| 124 | 0 |  |  | 0 | 0 |  | Digest::HMAC::hmac_hex $_[1], $_[0], \&Digest::SHA3::sha3_512, 72 | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | sub new { | 
| 128 | 0 |  |  | 0 | 1 |  | my ($class, %arg) = @_; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 0 |  |  |  |  |  | my $self = bless \%arg, $class; | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | { | 
| 133 | 0 |  |  |  |  |  | Scalar::Util::weaken (my $self = $self); | 
|  | 0 |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  |  | 
| 135 | 0 |  |  |  |  |  | my $config = $AnyEvent::MP::Kernel::CONFIG; | 
| 136 |  |  |  |  |  |  |  | 
| 137 | 0 |  |  |  |  |  | my $timeout  = $config->{monitor_timeout}; | 
| 138 | 0 |  |  |  |  |  | my $lframing = $config->{framing_format}; | 
| 139 | 0 |  |  |  |  |  | my $auth_snd = $config->{auth_offer}; | 
| 140 | 0 |  |  |  |  |  | my $auth_rcv = $config->{auth_accept}; | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | $self->{secret} = $config->{secret} | 
| 143 | 0 | 0 |  |  |  |  | unless exists $self->{secret}; | 
| 144 |  |  |  |  |  |  |  | 
| 145 | 0 |  |  |  |  |  | my $secret = $self->{secret}; | 
| 146 |  |  |  |  |  |  |  | 
| 147 | 0 | 0 |  |  |  |  | if (exists $config->{cert}) { | 
| 148 |  |  |  |  |  |  | $self->{tls_ctx} = { | 
| 149 |  |  |  |  |  |  | sslv2   => 0, | 
| 150 |  |  |  |  |  |  | sslv3   => 0, | 
| 151 |  |  |  |  |  |  | tlsv1   => 1, | 
| 152 |  |  |  |  |  |  | verify  => 1, | 
| 153 |  |  |  |  |  |  | cert    => $config->{cert}, | 
| 154 |  |  |  |  |  |  | ca_cert => $config->{cert}, | 
| 155 | 0 |  |  |  |  |  | verify_require_client_cert => 1, | 
| 156 |  |  |  |  |  |  | }; | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | $self->{hdl} = new AnyEvent::Handle | 
| 160 |  |  |  |  |  |  | +($self->{fh} ? (fh => $self->{fh}) : (connect => $self->{connect})), | 
| 161 |  |  |  |  |  |  | autocork  => $config->{autocork}, | 
| 162 |  |  |  |  |  |  | no_delay  => exists $config->{nodelay} ? $config->{nodelay} : 1, | 
| 163 |  |  |  |  |  |  | keepalive => 1, | 
| 164 |  |  |  |  |  |  | on_error  => sub { | 
| 165 | 0 |  |  | 0 |  |  | $self->error ($_[2]); | 
| 166 |  |  |  |  |  |  | }, | 
| 167 | 0 | 0 |  |  |  |  | rtimeout  => $timeout, | 
|  |  | 0 |  |  |  |  |  | 
| 168 |  |  |  |  |  |  | ; | 
| 169 |  |  |  |  |  |  |  | 
| 170 | 0 |  | 0 |  |  |  | my $greeting_kv = $self->{local_greeting} ||= {}; | 
| 171 |  |  |  |  |  |  |  | 
| 172 | 0 | 0 |  |  |  |  | $greeting_kv->{tls}      = "1.0" if $self->{tls_ctx}; | 
| 173 | 0 |  |  |  |  |  | $greeting_kv->{provider} = "AE-$AnyEvent::MP::Config::VERSION"; | 
| 174 | 0 |  |  |  |  |  | $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; | 
| 175 |  |  |  |  |  |  |  | 
| 176 | 0 |  | 0 |  |  |  | my $protocol = $self->{protocol} || "aemp"; | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | # can modify greeting_kv | 
| 179 | 0 | 0 |  |  |  |  | $_->($self) for $protocol eq "aemp" ? @HOOK_GREET : (); | 
| 180 |  |  |  |  |  |  | (delete $self->{on_greet})->($self) | 
| 181 | 0 | 0 |  |  |  |  | if exists $self->{on_greet}; | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | # send greeting | 
| 184 | 0 |  |  |  |  |  | my $lgreeting1 = "$protocol;$PROTOCOL_VERSION" | 
| 185 |  |  |  |  |  |  | . ";$AnyEvent::MP::Kernel::NODE" | 
| 186 |  |  |  |  |  |  | . ";" . (join ",", @$auth_rcv) | 
| 187 |  |  |  |  |  |  | . ";" . (join ",", @$lframing) | 
| 188 |  |  |  |  |  |  | . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); | 
| 189 |  |  |  |  |  |  |  | 
| 190 | 0 |  |  |  |  |  | my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Kernel::nonce (66), ""; | 
| 191 |  |  |  |  |  |  |  | 
| 192 | 0 |  |  |  |  |  | $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012"); | 
| 193 | 0 | 0 |  |  |  |  | return unless $self; | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | # expect greeting | 
| 196 | 0 |  |  |  |  |  | $self->{hdl}->rbuf_max (4 * 1024); | 
| 197 |  |  |  |  |  |  | $self->{hdl}->push_read (line => sub { | 
| 198 | 0 |  |  | 0 |  |  | my $rgreeting1 = $_[1]; | 
| 199 |  |  |  |  |  |  |  | 
| 200 | 0 |  |  |  |  |  | my ($aemp, $version, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1; | 
| 201 |  |  |  |  |  |  |  | 
| 202 | 0 |  |  |  |  |  | $self->{remote_node} = $rnode; | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | $self->{remote_greeting} = { | 
| 205 | 0 | 0 |  |  |  |  | map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (), | 
| 206 |  |  |  |  |  |  | @kv | 
| 207 |  |  |  |  |  |  | }; | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | # maybe upgrade the protocol | 
| 210 | 0 | 0 | 0 |  |  |  | if ($protocol eq "aemp" and $aemp =~ /^aemp-\w+$/) { | 
| 211 |  |  |  |  |  |  | # maybe check for existence of the protocol handler? | 
| 212 | 0 |  |  |  |  |  | $self->{protocol} = $protocol = $aemp; | 
| 213 |  |  |  |  |  |  | } | 
| 214 |  |  |  |  |  |  |  | 
| 215 | 0 | 0 |  |  |  |  | $_->($self) for $protocol eq "aemp" ? @HOOK_GREETED : (); | 
| 216 |  |  |  |  |  |  | (delete $self->{on_greeted})->($self) | 
| 217 | 0 | 0 |  |  |  |  | if exists $self->{on_greeted}; | 
| 218 |  |  |  |  |  |  |  | 
| 219 | 0 | 0 | 0 |  |  |  | if ($aemp ne $protocol and $aemp ne "aemp") { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 220 | 0 |  |  |  |  |  | return $self->error ("unparsable greeting, expected '$protocol', got '$aemp'"); | 
| 221 |  |  |  |  |  |  | } elsif ($version != $PROTOCOL_VERSION) { | 
| 222 | 0 |  |  |  |  |  | return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)"); | 
| 223 |  |  |  |  |  |  | } elsif ($protocol eq "aemp") { | 
| 224 | 0 | 0 | 0 |  |  |  | if ($rnode eq $AnyEvent::MP::Kernel::NODE) { | 
|  |  | 0 |  |  |  |  |  | 
| 225 | 0 |  |  |  |  |  | return $self->error ("I refuse to talk to myself"); | 
| 226 |  |  |  |  |  |  | } elsif ($AnyEvent::MP::Kernel::NODE{$rnode} && $AnyEvent::MP::Kernel::NODE{$rnode}{transport}) { | 
| 227 | 0 |  |  |  |  |  | return $self->error ("$rnode already connected, not connecting again."); | 
| 228 |  |  |  |  |  |  | } | 
| 229 |  |  |  |  |  |  | } | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | # read nonce | 
| 232 |  |  |  |  |  |  | $self->{hdl}->push_read (line => sub { | 
| 233 | 0 |  |  |  |  |  | my $rgreeting2 = $_[1]; | 
| 234 |  |  |  |  |  |  |  | 
| 235 | 0 | 0 |  |  |  |  | "$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack? | 
| 236 |  |  |  |  |  |  | or return $self->error ("authentication error, echo attack?"); | 
| 237 |  |  |  |  |  |  |  | 
| 238 | 0 |  | 0 |  |  |  | my $tls = $self->{tls_ctx} && 1 == int $self->{remote_greeting}{tls}; | 
| 239 |  |  |  |  |  |  |  | 
| 240 | 0 |  |  |  |  |  | my $s_auth; | 
| 241 | 0 |  |  |  |  |  | for my $auth_ (split /,/, $auths) { | 
| 242 | 0 | 0 | 0 |  |  |  | if (grep $auth_ eq $_, @$auth_snd and ($auth_ !~ /^tls_/ or $tls)) { | 
|  |  |  | 0 |  |  |  |  | 
| 243 | 0 |  |  |  |  |  | $s_auth = $auth_; | 
| 244 | 0 |  |  |  |  |  | last; | 
| 245 |  |  |  |  |  |  | } | 
| 246 |  |  |  |  |  |  | } | 
| 247 |  |  |  |  |  |  |  | 
| 248 | 0 | 0 |  |  |  |  | defined $s_auth | 
| 249 |  |  |  |  |  |  | or return $self->error ("$auths: no common auth type supported"); | 
| 250 |  |  |  |  |  |  |  | 
| 251 | 0 |  |  |  |  |  | my $s_framing; | 
| 252 | 0 |  |  |  |  |  | for my $framing_ (split /,/, $framings) { | 
| 253 | 0 | 0 |  |  |  |  | if (grep $framing_ eq $_, @$lframing) { | 
| 254 | 0 |  |  |  |  |  | $s_framing = $framing_; | 
| 255 | 0 |  |  |  |  |  | last; | 
| 256 |  |  |  |  |  |  | } | 
| 257 |  |  |  |  |  |  | } | 
| 258 |  |  |  |  |  |  |  | 
| 259 | 0 | 0 |  |  |  |  | defined $s_framing | 
| 260 |  |  |  |  |  |  | or return $self->error ("$framings: no common framing method supported"); | 
| 261 |  |  |  |  |  |  |  | 
| 262 | 0 |  |  |  |  |  | my $lauth; | 
| 263 |  |  |  |  |  |  |  | 
| 264 | 0 | 0 |  |  |  |  | if ($tls) { | 
|  |  | 0 |  |  |  |  |  | 
| 265 | 0 | 0 |  |  |  |  | $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept"; | 
| 266 | 0 |  |  |  |  |  | $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); | 
| 267 | 0 | 0 |  |  |  |  | return unless $self->{hdl}; # starttls might destruct us | 
| 268 |  |  |  |  |  |  |  | 
| 269 | 0 | 0 |  |  |  |  | $lauth = | 
|  |  | 0 |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | $s_auth eq "tls_anon"     ? "" | 
| 271 |  |  |  |  |  |  | : $s_auth eq "tls_sha3_512" ? Digest::SHA3::sha3_512_hex "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012" | 
| 272 |  |  |  |  |  |  | : return $self->error ("$s_auth: fatal, selected unsupported snd auth method"); | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | } elsif (length $secret) { | 
| 275 | 0 | 0 |  |  |  |  | return $self->error ("$s_auth: fatal, selected unsupported snd auth method") | 
| 276 |  |  |  |  |  |  | unless $s_auth eq "hmac_sha3_512"; # hardcoded atm. | 
| 277 |  |  |  |  |  |  |  | 
| 278 | 0 |  |  |  |  |  | $lauth = hmac_sha3_512_hex $secret, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012"; | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | } else { | 
| 281 | 0 |  |  |  |  |  | return $self->error ("unable to handshake TLS and no shared secret configured"); | 
| 282 |  |  |  |  |  |  | } | 
| 283 |  |  |  |  |  |  |  | 
| 284 | 0 |  |  |  |  |  | $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012"); | 
| 285 | 0 | 0 |  |  |  |  | return unless $self; | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | # read the authentication response | 
| 288 |  |  |  |  |  |  | $self->{hdl}->push_read (line => sub { | 
| 289 | 0 |  |  |  |  |  | my ($hdl, $rline) = @_; | 
| 290 |  |  |  |  |  |  |  | 
| 291 | 0 |  |  |  |  |  | my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; | 
| 292 |  |  |  |  |  |  |  | 
| 293 | 0 | 0 |  |  |  |  | my $rauth = | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | $auth_method eq "hmac_sha3_512" ? hmac_sha3_512_hex $secret, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012" | 
| 295 |  |  |  |  |  |  | : $auth_method eq "cleartext"     ? unpack "H*", $secret | 
| 296 |  |  |  |  |  |  | : $auth_method eq "tls_anon"      ? ($tls ? "" : "\012\012") # \012\012 never matches | 
| 297 |  |  |  |  |  |  | : $auth_method eq "tls_sha3_512"  ? ($tls ? Digest::SHA3::sha3_512_hex "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012" : "\012\012") | 
| 298 |  |  |  |  |  |  | : return $self->error ("$auth_method: fatal, selected unsupported rcv auth method"); | 
| 299 |  |  |  |  |  |  |  | 
| 300 | 0 | 0 |  |  |  |  | if ($rauth2 ne $rauth) { | 
| 301 | 0 |  |  |  |  |  | return $self->error ("authentication failure/shared secret mismatch"); | 
| 302 |  |  |  |  |  |  | } | 
| 303 |  |  |  |  |  |  |  | 
| 304 | 0 |  |  |  |  |  | $self->{r_framing} = $r_framing; | 
| 305 | 0 |  |  |  |  |  | $self->{s_framing} = $s_framing; | 
| 306 |  |  |  |  |  |  |  | 
| 307 | 0 |  |  |  |  |  | $hdl->rbuf_max (undef); | 
| 308 |  |  |  |  |  |  |  | 
| 309 |  |  |  |  |  |  | # we rely on TCP retransmit timeouts and keepalives | 
| 310 | 0 |  |  |  |  |  | $self->{hdl}->rtimeout (undef); | 
| 311 |  |  |  |  |  |  |  | 
| 312 | 0 | 0 |  |  |  |  | $self->{remote_greeting}{untrusted} = 1 | 
| 313 |  |  |  |  |  |  | if $auth_method eq "tls_anon"; | 
| 314 |  |  |  |  |  |  |  | 
| 315 | 0 | 0 | 0 |  |  |  | if ($protocol eq "aemp" and $self->{hdl}) { | 
| 316 |  |  |  |  |  |  | # listener-less nodes need to continuously probe | 
| 317 |  |  |  |  |  |  | #                  unless (@$AnyEvent::MP::Kernel::BINDS) { | 
| 318 |  |  |  |  |  |  | #                     $self->{hdl}->wtimeout ($timeout); | 
| 319 |  |  |  |  |  |  | #                     $self->{hdl}->on_wtimeout (sub { $self->{send}->([]) }); | 
| 320 |  |  |  |  |  |  | #                  } | 
| 321 |  |  |  |  |  |  |  | 
| 322 |  |  |  |  |  |  | # receive handling | 
| 323 | 0 |  |  |  |  |  | $self->set_snd_framing; | 
| 324 | 0 |  |  |  |  |  | $self->set_rcv_framing; | 
| 325 |  |  |  |  |  |  | } | 
| 326 |  |  |  |  |  |  |  | 
| 327 | 0 |  |  |  |  |  | $self->connected; | 
| 328 | 0 |  |  |  |  |  | }); | 
| 329 | 0 |  |  |  |  |  | }); | 
| 330 | 0 |  |  |  |  |  | }); | 
| 331 |  |  |  |  |  |  | } | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | $self | 
| 334 | 0 |  |  |  |  |  | } | 
| 335 |  |  |  |  |  |  |  | 
| 336 |  |  |  |  |  |  | sub set_snd_framing { | 
| 337 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 338 |  |  |  |  |  |  |  | 
| 339 | 0 |  |  |  |  |  | my $framing    = $self->{s_framing}; | 
| 340 | 0 |  |  |  |  |  | my $hdl        = $self->{hdl}; | 
| 341 | 0 |  |  |  |  |  | my $push_write = $hdl->can ("push_write"); | 
| 342 |  |  |  |  |  |  |  | 
| 343 | 0 | 0 |  |  |  |  | if ($framing eq "cbor") { | 
|  |  | 0 |  |  |  |  |  | 
| 344 | 0 |  |  |  |  |  | require CBOR::XS; | 
| 345 |  |  |  |  |  |  | $self->{send} = sub { | 
| 346 | 0 |  |  | 0 |  |  | $push_write->($hdl, CBOR::XS::encode_cbor ($_[0])); | 
| 347 | 0 |  |  |  |  |  | }; | 
| 348 |  |  |  |  |  |  | } elsif ($framing eq "json") { | 
| 349 | 0 |  |  |  |  |  | require JSON::XS; | 
| 350 |  |  |  |  |  |  | $self->{send} = sub { | 
| 351 | 0 |  |  | 0 |  |  | $push_write->($hdl, JSON::XS::encode_json ($_[0])); | 
| 352 | 0 |  |  |  |  |  | }; | 
| 353 |  |  |  |  |  |  | } else { | 
| 354 |  |  |  |  |  |  | $self->{send} = sub { | 
| 355 | 0 |  |  | 0 |  |  | $push_write->($hdl, $framing => $_[0]); | 
| 356 | 0 |  |  |  |  |  | }; | 
| 357 |  |  |  |  |  |  | } | 
| 358 |  |  |  |  |  |  | } | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | sub set_rcv_framing { | 
| 361 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 362 |  |  |  |  |  |  |  | 
| 363 | 0 |  |  |  |  |  | my $node       = $self->{remote_node}; | 
| 364 | 0 |  |  |  |  |  | my $framing    = $self->{r_framing}; | 
| 365 | 0 |  |  |  |  |  | my $hdl        = $self->{hdl}; | 
| 366 | 0 |  |  |  |  |  | my $push_read  = $hdl->can ("push_read"); | 
| 367 |  |  |  |  |  |  |  | 
| 368 | 0 | 0 |  |  |  |  | if ($framing eq "cbor") { | 
|  |  | 0 |  |  |  |  |  | 
| 369 | 0 |  |  |  |  |  | require CBOR::XS; | 
| 370 | 0 |  |  |  |  |  | my $coder = CBOR::XS->new; | 
| 371 |  |  |  |  |  |  |  | 
| 372 |  |  |  |  |  |  | $hdl->on_read (sub { | 
| 373 | 0 |  |  | 0 |  |  | $AnyEvent::MP::Kernel::SRCNODE = $node; | 
| 374 |  |  |  |  |  |  |  | 
| 375 |  |  |  |  |  |  | AnyEvent::MP::Kernel::_inject (@$_) | 
| 376 | 0 |  |  |  |  |  | for $coder->incr_parse_multiple ($_[0]{rbuf}); | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  | () | 
| 379 | 0 |  |  |  |  |  | }); | 
|  | 0 |  |  |  |  |  |  | 
| 380 |  |  |  |  |  |  | } elsif ($framing eq "json") { | 
| 381 | 0 |  |  |  |  |  | require JSON::XS; | 
| 382 | 0 |  |  |  |  |  | my $coder = JSON::XS->new->utf8; | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | $hdl->on_read (sub { | 
| 385 | 0 |  |  | 0 |  |  | $AnyEvent::MP::Kernel::SRCNODE = $node; | 
| 386 |  |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | AnyEvent::MP::Kernel::_inject (@$_) | 
| 388 | 0 |  |  |  |  |  | for $coder->incr_parse (delete $_[0]{rbuf}); | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | () | 
| 391 | 0 |  |  |  |  |  | }); | 
|  | 0 |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  | } else { | 
| 393 | 0 |  |  |  |  |  | my $rmsg; $rmsg = $self->{rmsg} = sub { | 
| 394 | 0 |  |  | 0 |  |  | $push_read->($_[0], $framing => $rmsg); | 
| 395 |  |  |  |  |  |  |  | 
| 396 | 0 |  |  |  |  |  | $AnyEvent::MP::Kernel::SRCNODE = $node; | 
| 397 | 0 |  |  |  |  |  | AnyEvent::MP::Kernel::_inject (@{ $_[1] }); | 
|  | 0 |  |  |  |  |  |  | 
| 398 | 0 |  |  |  |  |  | }; | 
| 399 | 0 |  |  |  |  |  | eval { | 
| 400 | 0 |  |  |  |  |  | $push_read->($hdl, $framing => $rmsg); | 
| 401 |  |  |  |  |  |  | }; | 
| 402 | 0 |  |  |  |  |  | Scalar::Util::weaken $rmsg; | 
| 403 | 0 | 0 |  |  |  |  | return $self->error ("$framing: unusable remote framing") | 
| 404 |  |  |  |  |  |  | if $@; | 
| 405 |  |  |  |  |  |  | } | 
| 406 |  |  |  |  |  |  | } | 
| 407 |  |  |  |  |  |  |  | 
| 408 |  |  |  |  |  |  | sub error { | 
| 409 | 0 |  |  | 0 | 0 |  | my ($self, $msg) = @_; | 
| 410 |  |  |  |  |  |  |  | 
| 411 | 0 |  |  |  |  |  | delete $self->{keepalive}; | 
| 412 |  |  |  |  |  |  |  | 
| 413 | 0 | 0 |  |  |  |  | if ($self->{protocol}) { | 
| 414 | 0 |  |  |  |  |  | $HOOK_PROTOCOL{$self->{protocol}}->($self, $msg); | 
| 415 |  |  |  |  |  |  | } else { | 
| 416 | 0 |  |  |  |  |  | AE::log 9 => "$self->{peerhost}:$self->{peerport} disconnected - $msg."; | 
| 417 |  |  |  |  |  |  |  | 
| 418 |  |  |  |  |  |  | $self->{node}->transport_error (transport_error => $self->{node}{id}, $msg) | 
| 419 | 0 | 0 | 0 |  |  |  | if $self->{node} && $self->{node}{transport} == $self; | 
| 420 |  |  |  |  |  |  | } | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | (delete $self->{release})->() | 
| 423 | 0 | 0 |  |  |  |  | if exists $self->{release}; | 
| 424 |  |  |  |  |  |  |  | 
| 425 | 0 |  |  |  |  |  | $self->destroy; | 
| 426 |  |  |  |  |  |  | } | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | sub connected { | 
| 429 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 430 |  |  |  |  |  |  |  | 
| 431 | 0 |  |  |  |  |  | delete $self->{keepalive}; | 
| 432 |  |  |  |  |  |  |  | 
| 433 | 0 | 0 |  |  |  |  | if ($self->{protocol}) { | 
| 434 | 0 |  |  |  |  |  | $self->{hdl}->on_error (undef); | 
| 435 | 0 |  |  |  |  |  | $HOOK_PROTOCOL{$self->{protocol}}->($self, undef); | 
| 436 |  |  |  |  |  |  | } else { | 
| 437 | 0 |  |  |  |  |  | AE::log 9 => "$self->{peerhost}:$self->{peerport} connected as $self->{remote_node}."; | 
| 438 |  |  |  |  |  |  |  | 
| 439 | 0 |  |  |  |  |  | my $node = AnyEvent::MP::Kernel::add_node ($self->{remote_node}); | 
| 440 | 0 |  |  |  |  |  | Scalar::Util::weaken ($self->{node} = $node); | 
| 441 | 0 |  |  |  |  |  | $node->transport_connect ($self); | 
| 442 |  |  |  |  |  |  |  | 
| 443 | 0 |  |  |  |  |  | $_->($self) for @HOOK_CONNECT; | 
| 444 |  |  |  |  |  |  | } | 
| 445 |  |  |  |  |  |  |  | 
| 446 |  |  |  |  |  |  | (delete $self->{release})->() | 
| 447 | 0 | 0 |  |  |  |  | if exists $self->{release}; | 
| 448 |  |  |  |  |  |  |  | 
| 449 |  |  |  |  |  |  | (delete $self->{on_connect})->($self) | 
| 450 | 0 | 0 |  |  |  |  | if exists $self->{on_connect}; | 
| 451 |  |  |  |  |  |  | } | 
| 452 |  |  |  |  |  |  |  | 
| 453 |  |  |  |  |  |  | sub destroy { | 
| 454 | 0 |  |  | 0 | 0 |  | my ($self) = @_; | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | (delete $self->{release})->() | 
| 457 | 0 | 0 |  |  |  |  | if exists $self->{release}; | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  | $self->{hdl}->destroy | 
| 460 | 0 | 0 |  |  |  |  | if $self->{hdl}; | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | (delete $self->{on_destroy})->($self) | 
| 463 | 0 | 0 |  |  |  |  | if exists $self->{on_destroy}; | 
| 464 | 0 | 0 |  |  |  |  | $_->($self) for $self->{protocol} ? () : @HOOK_DESTROY; | 
| 465 |  |  |  |  |  |  |  | 
| 466 | 0 |  |  |  |  |  | $self->{protocol} = "destroyed"; # to keep hooks from invoked twice. | 
| 467 |  |  |  |  |  |  | } | 
| 468 |  |  |  |  |  |  |  | 
| 469 |  |  |  |  |  |  | sub DESTROY { | 
| 470 | 0 |  |  | 0 |  |  | my ($self) = @_; | 
| 471 |  |  |  |  |  |  |  | 
| 472 | 0 |  |  |  |  |  | $self->destroy; | 
| 473 |  |  |  |  |  |  | } | 
| 474 |  |  |  |  |  |  |  | 
| 475 |  |  |  |  |  |  | =back | 
| 476 |  |  |  |  |  |  |  | 
| 477 |  |  |  |  |  |  | =head1 PROTOCOL | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | The AEMP protocol is comparatively simple, and consists of three phases | 
| 480 |  |  |  |  |  |  | which are symmetrical for both sides: greeting (followed by optionally | 
| 481 |  |  |  |  |  |  | switching to TLS mode), authentication and packet exchange. | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  | The protocol is designed to allow both full-text and binary streams. | 
| 484 |  |  |  |  |  |  |  | 
| 485 |  |  |  |  |  |  | The greeting consists of two text lines that are ended by either an ASCII | 
| 486 |  |  |  |  |  |  | CR LF pair, or a single ASCII LF (recommended). | 
| 487 |  |  |  |  |  |  |  | 
| 488 |  |  |  |  |  |  | =head2 GREETING | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | All the lines until after authentication must not exceed 4kb in length, | 
| 491 |  |  |  |  |  |  | including line delimiter. Afterwards there is no limit on the packet size | 
| 492 |  |  |  |  |  |  | that can be received. | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | =head3 First Greeting Line | 
| 495 |  |  |  |  |  |  |  | 
| 496 |  |  |  |  |  |  | Example: | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | aemp;0;rain;tls_sha3_512,hmac_sha3_512,tls_anon,cleartext;cbor,json,storable;timeout=12;peeraddr=10.0.0.1:48082 | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | The first line contains strings separated (not ended) by C<;> | 
| 501 |  |  |  |  |  |  | characters. The first five strings are fixed by the protocol, the | 
| 502 |  |  |  |  |  |  | remaining strings are C pairs. None of them may contain C<;> | 
| 503 |  |  |  |  |  |  | characters themselves (when escaping is needed, use C<%3b> to represent | 
| 504 |  |  |  |  |  |  | C<;> and C<%25> to represent C<%>)- | 
| 505 |  |  |  |  |  |  |  | 
| 506 |  |  |  |  |  |  | The fixed strings are: | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | =over 4 | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | =item protocol identification | 
| 511 |  |  |  |  |  |  |  | 
| 512 |  |  |  |  |  |  | The constant C to identify this protocol. | 
| 513 |  |  |  |  |  |  |  | 
| 514 |  |  |  |  |  |  | =item protocol version | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | The protocol version supported by this end, currently C<1>. If the | 
| 517 |  |  |  |  |  |  | versions don't match then no communication is possible. Minor extensions | 
| 518 |  |  |  |  |  |  | are supposed to be handled through additional key-value pairs. | 
| 519 |  |  |  |  |  |  |  | 
| 520 |  |  |  |  |  |  | =item the node ID | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | This is the node ID of the connecting node. | 
| 523 |  |  |  |  |  |  |  | 
| 524 |  |  |  |  |  |  | =item the acceptable authentication methods | 
| 525 |  |  |  |  |  |  |  | 
| 526 |  |  |  |  |  |  | A comma-separated list of authentication methods supported by the | 
| 527 |  |  |  |  |  |  | node. Note that AnyEvent::MP supports a C authentication | 
| 528 |  |  |  |  |  |  | method that accepts a clear-text password (hex-encoded), but will not use | 
| 529 |  |  |  |  |  |  | this authentication method itself. | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | The receiving side should choose the first authentication method it | 
| 532 |  |  |  |  |  |  | supports. | 
| 533 |  |  |  |  |  |  |  | 
| 534 |  |  |  |  |  |  | =item the acceptable framing formats | 
| 535 |  |  |  |  |  |  |  | 
| 536 |  |  |  |  |  |  | A comma-separated list of packet encoding/framing formats understood. The | 
| 537 |  |  |  |  |  |  | receiving side should choose the first framing format it supports for | 
| 538 |  |  |  |  |  |  | sending packets (which might be different from the format it has to accept). | 
| 539 |  |  |  |  |  |  |  | 
| 540 |  |  |  |  |  |  | =back | 
| 541 |  |  |  |  |  |  |  | 
| 542 |  |  |  |  |  |  | The remaining arguments are C pairs. The following key-value | 
| 543 |  |  |  |  |  |  | pairs are known at this time: | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | =over 4 | 
| 546 |  |  |  |  |  |  |  | 
| 547 |  |  |  |  |  |  | =item provider= | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | The software provider for this implementation. For AnyEvent::MP, this is | 
| 550 |  |  |  |  |  |  | C or whatever version it currently is at. | 
| 551 |  |  |  |  |  |  |  | 
| 552 |  |  |  |  |  |  | =item peeraddr=: | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  | The peer address (socket address of the other side) as seen locally. | 
| 555 |  |  |  |  |  |  |  | 
| 556 |  |  |  |  |  |  | =item tls=. | 
| 557 |  |  |  |  |  |  |  | 
| 558 |  |  |  |  |  |  | Indicates that the other side supports TLS (version should be 1.0) and | 
| 559 |  |  |  |  |  |  | wishes to do a TLS handshake. | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | =item nproto=. | 
| 562 |  |  |  |  |  |  |  | 
| 563 |  |  |  |  |  |  | Informs the other side of the node protocol implemented by this | 
| 564 |  |  |  |  |  |  | node. Major version mismatches are fatal. If this key is missing, then it | 
| 565 |  |  |  |  |  |  | is assumed that the node doesn't support the node protocol. | 
| 566 |  |  |  |  |  |  |  | 
| 567 |  |  |  |  |  |  | The node protocol is currently undocumented, but includes port | 
| 568 |  |  |  |  |  |  | monitoring, spawning and informational requests. | 
| 569 |  |  |  |  |  |  |  | 
| 570 |  |  |  |  |  |  | =item gproto=. | 
| 571 |  |  |  |  |  |  |  | 
| 572 |  |  |  |  |  |  | Informs the other side of the global protocol implemented by this | 
| 573 |  |  |  |  |  |  | node. Major version mismatches are fatal. If this key is missing, then it | 
| 574 |  |  |  |  |  |  | is assumed that the node doesn't support the global protocol. | 
| 575 |  |  |  |  |  |  |  | 
| 576 |  |  |  |  |  |  | The global protocol is currently undocumented, but includes node address | 
| 577 |  |  |  |  |  |  | lookup and shared database operations. | 
| 578 |  |  |  |  |  |  |  | 
| 579 |  |  |  |  |  |  | =back | 
| 580 |  |  |  |  |  |  |  | 
| 581 |  |  |  |  |  |  | =head3 Second Greeting Line | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | After this greeting line there will be a second line containing a | 
| 584 |  |  |  |  |  |  | cryptographic nonce, i.e. random data of high quality. To keep the | 
| 585 |  |  |  |  |  |  | protocol text-only, these are usually 32 base64-encoded octets, but | 
| 586 |  |  |  |  |  |  | it could be anything that doesn't contain any ASCII CR or ASCII LF | 
| 587 |  |  |  |  |  |  | characters. | 
| 588 |  |  |  |  |  |  |  | 
| 589 |  |  |  |  |  |  | I<< The two nonces B be different, and an aemp implementation | 
| 590 |  |  |  |  |  |  | B check and fail when they are identical >>. | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | Example of a nonce line (yes, it's random-looking because it is random | 
| 593 |  |  |  |  |  |  | data): | 
| 594 |  |  |  |  |  |  |  | 
| 595 |  |  |  |  |  |  | 2XYhdG7/O6epFa4wuP0ujAEx1rXYWRcOypjUYK7eF6yWAQr7gwIN9m/2+mVvBrTPXz5GJDgfGm9d8QRABAbmAP/s | 
| 596 |  |  |  |  |  |  |  | 
| 597 |  |  |  |  |  |  | =head2 TLS handshake | 
| 598 |  |  |  |  |  |  |  | 
| 599 |  |  |  |  |  |  | I<< If, after the handshake, both sides indicate interest in TLS, then the | 
| 600 |  |  |  |  |  |  | connection B use TLS, or fail to continue. >> | 
| 601 |  |  |  |  |  |  |  | 
| 602 |  |  |  |  |  |  | Both sides compare their nonces, and the side who sent the lower nonce | 
| 603 |  |  |  |  |  |  | value ("string" comparison on the raw octet values) becomes the client, | 
| 604 |  |  |  |  |  |  | and the one with the higher nonce the server. | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | =head2 AUTHENTICATION PHASE | 
| 607 |  |  |  |  |  |  |  | 
| 608 |  |  |  |  |  |  | After the greeting is received (and the optional TLS handshake), | 
| 609 |  |  |  |  |  |  | the authentication phase begins, which consists of sending a single | 
| 610 |  |  |  |  |  |  | C<;>-separated line with three fixed strings and any number of | 
| 611 |  |  |  |  |  |  | C pairs. | 
| 612 |  |  |  |  |  |  |  | 
| 613 |  |  |  |  |  |  | The three fixed strings are: | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  | =over 4 | 
| 616 |  |  |  |  |  |  |  | 
| 617 |  |  |  |  |  |  | =item the authentication method chosen | 
| 618 |  |  |  |  |  |  |  | 
| 619 |  |  |  |  |  |  | This must be one of the methods offered by the other side in the greeting. | 
| 620 |  |  |  |  |  |  |  | 
| 621 |  |  |  |  |  |  | Note that all methods starting with C are only valid I TLS was | 
| 622 |  |  |  |  |  |  | successfully handshaked (and to be secure the implementation must enforce | 
| 623 |  |  |  |  |  |  | this). | 
| 624 |  |  |  |  |  |  |  | 
| 625 |  |  |  |  |  |  | The currently supported authentication methods are: | 
| 626 |  |  |  |  |  |  |  | 
| 627 |  |  |  |  |  |  | =over 4 | 
| 628 |  |  |  |  |  |  |  | 
| 629 |  |  |  |  |  |  | =item cleartext | 
| 630 |  |  |  |  |  |  |  | 
| 631 |  |  |  |  |  |  | This is simply the shared secret, lowercase-hex-encoded. This method is of | 
| 632 |  |  |  |  |  |  | course very insecure if TLS is not used (and not completely secure even | 
| 633 |  |  |  |  |  |  | if TLS is used), which is why this module will accept, but not generate, | 
| 634 |  |  |  |  |  |  | cleartext auth replies. | 
| 635 |  |  |  |  |  |  |  | 
| 636 |  |  |  |  |  |  | =item hmac_sha3_512 | 
| 637 |  |  |  |  |  |  |  | 
| 638 |  |  |  |  |  |  | This method uses a SHA-3/512 HMAC with 576 bit blocksize and 512 bit hash, | 
| 639 |  |  |  |  |  |  | and requires a shared secret. It is the preferred auth method when a | 
| 640 |  |  |  |  |  |  | shared secret is available. | 
| 641 |  |  |  |  |  |  |  | 
| 642 |  |  |  |  |  |  | The secret is used to generate the "local auth reply", by taking the | 
| 643 |  |  |  |  |  |  | two local greeting lines and the two remote greeting lines (without | 
| 644 |  |  |  |  |  |  | line endings), appending \012 to all of them, concatenating them and | 
| 645 |  |  |  |  |  |  | calculating the HMAC with the key: | 
| 646 |  |  |  |  |  |  |  | 
| 647 |  |  |  |  |  |  | lauth = HMAC_SHA3_512 key, "lgreeting1\012lgreeting2\012rgreeting1\012rgreeting2\012" | 
| 648 |  |  |  |  |  |  |  | 
| 649 |  |  |  |  |  |  | This authentication token is then lowercase-hex-encoded and sent to the | 
| 650 |  |  |  |  |  |  | other side. | 
| 651 |  |  |  |  |  |  |  | 
| 652 |  |  |  |  |  |  | Then the remote auth reply is generated using the same method, but local | 
| 653 |  |  |  |  |  |  | and remote greeting lines swapped: | 
| 654 |  |  |  |  |  |  |  | 
| 655 |  |  |  |  |  |  | rauth = HMAC_SHA3_512 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012" | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | This is the token that is expected from the other side. | 
| 658 |  |  |  |  |  |  |  | 
| 659 |  |  |  |  |  |  | =item hmac_md6_64_256 [obsolete, not supported] | 
| 660 |  |  |  |  |  |  |  | 
| 661 |  |  |  |  |  |  | This method uses an MD6 HMAC with 64 bit blocksize and 256 bit hash, and | 
| 662 |  |  |  |  |  |  | requires a shared secret. It is similar to C, but uses | 
| 663 |  |  |  |  |  |  | MD6 instead of SHA-3 and instead of using the secret directly, it uses | 
| 664 |  |  |  |  |  |  | MD6(secret) as HMAC key. | 
| 665 |  |  |  |  |  |  |  | 
| 666 |  |  |  |  |  |  | =item tls_anon | 
| 667 |  |  |  |  |  |  |  | 
| 668 |  |  |  |  |  |  | This type is only valid I TLS was enabled and the TLS handshake | 
| 669 |  |  |  |  |  |  | was successful. It has no authentication data, as the server/client | 
| 670 |  |  |  |  |  |  | certificate was successfully verified. | 
| 671 |  |  |  |  |  |  |  | 
| 672 |  |  |  |  |  |  | This authentication type is somewhat insecure, as it allows a | 
| 673 |  |  |  |  |  |  | man-in-the-middle attacker to change some of the connection parameters | 
| 674 |  |  |  |  |  |  | (such as the framing format), although there is no known attack that | 
| 675 |  |  |  |  |  |  | exploits this in a way that is worse than just denying the service. | 
| 676 |  |  |  |  |  |  |  | 
| 677 |  |  |  |  |  |  | By default, this implementation accepts but never generates this auth | 
| 678 |  |  |  |  |  |  | reply. | 
| 679 |  |  |  |  |  |  |  | 
| 680 |  |  |  |  |  |  | =item tls_sha3_512 | 
| 681 |  |  |  |  |  |  |  | 
| 682 |  |  |  |  |  |  | This type is only valid I TLS was enabled and the TLS handshake was | 
| 683 |  |  |  |  |  |  | successful. | 
| 684 |  |  |  |  |  |  |  | 
| 685 |  |  |  |  |  |  | This authentication type simply calculates: | 
| 686 |  |  |  |  |  |  |  | 
| 687 |  |  |  |  |  |  | lauth = SHA3_512 "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012" | 
| 688 |  |  |  |  |  |  |  | 
| 689 |  |  |  |  |  |  | and lowercase-hex encodes the result and sends it as authentication | 
| 690 |  |  |  |  |  |  | data. No shared secret is required (authentication is done by TLS). The | 
| 691 |  |  |  |  |  |  | checksum exists only to make tinkering with the greeting hard. | 
| 692 |  |  |  |  |  |  |  | 
| 693 |  |  |  |  |  |  | =item tls_md6_64_256 [deprecated, unsupported] | 
| 694 |  |  |  |  |  |  |  | 
| 695 |  |  |  |  |  |  | Same as C, except MD6 is used. | 
| 696 |  |  |  |  |  |  |  | 
| 697 |  |  |  |  |  |  | =back | 
| 698 |  |  |  |  |  |  |  | 
| 699 |  |  |  |  |  |  | =item the authentication data | 
| 700 |  |  |  |  |  |  |  | 
| 701 |  |  |  |  |  |  | The authentication data itself, usually base64 or hex-encoded data, see | 
| 702 |  |  |  |  |  |  | above. | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | =item the framing protocol chosen | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | This must be one of the framing protocols offered by the other side in the | 
| 707 |  |  |  |  |  |  | greeting. Each side must accept the choice of the other side, and generate | 
| 708 |  |  |  |  |  |  | packets in the format it chose itself. | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | =back | 
| 711 |  |  |  |  |  |  |  | 
| 712 |  |  |  |  |  |  | Example of an authentication reply: | 
| 713 |  |  |  |  |  |  |  | 
| 714 |  |  |  |  |  |  | hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json | 
| 715 |  |  |  |  |  |  |  | 
| 716 |  |  |  |  |  |  | =head2 DATA PHASE | 
| 717 |  |  |  |  |  |  |  | 
| 718 |  |  |  |  |  |  | After this, packets get exchanged using the chosen framing protocol. It is | 
| 719 |  |  |  |  |  |  | quite possible that both sides use a different framing protocol. | 
| 720 |  |  |  |  |  |  |  | 
| 721 |  |  |  |  |  |  | =head2 FULL EXAMPLE | 
| 722 |  |  |  |  |  |  |  | 
| 723 |  |  |  |  |  |  | This is an actual protocol dump of a handshake, followed by a single data | 
| 724 |  |  |  |  |  |  | packet. The greater than/less than lines indicate the direction of the | 
| 725 |  |  |  |  |  |  | transfer only. | 
| 726 |  |  |  |  |  |  |  | 
| 727 |  |  |  |  |  |  | > aemp;0;anon/57Cs1CggVJjzYaQp13XXg4;tls_md6_64_256,hmac_md6_64_256,tls_anon,cleartext;json,storable;provider=AE-0.8;timeout=12;peeraddr=10.0.0.17:4040 | 
| 728 |  |  |  |  |  |  | > yLgdG1ov/02shVkVQer3wzeuywZK+oraTdEQBmIqWHaegxSGDG4g+HqogLQbvdypFOsoDWJ1Sh4ImV4DMhvUBwTK | 
| 729 |  |  |  |  |  |  |  | 
| 730 |  |  |  |  |  |  | < aemp;0;ruth;tls_md6_64_256,hmac_md6_64_256,tls_anon,cleartext;json,storable;provider=AE-0.8;timeout=12;peeraddr=10.0.0.1:37108 | 
| 731 |  |  |  |  |  |  | < +xMQXP8ElfNmuvEhsmcp+s2wCJOuQAsPxSg3d2Ewhs6gBnJz+ypVdWJ/wAVrXqlIJfLeVS/CBy4gEGkyWHSuVb1L | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | > hmac_md6_64_256;5ad913855742ae5a03a5aeb7eafa4c78629de136bed6acd73eea36c9e98df44a;json | 
| 734 |  |  |  |  |  |  |  | 
| 735 |  |  |  |  |  |  | < hmac_md6_64_256;84cd590976f794914c2ca26dac3a207a57a6798b9171289c114de07cf0c20401;json | 
| 736 |  |  |  |  |  |  | < ["","AnyEvent::MP::_spawn","57Cs1CggVJjzYaQp13XXg4.c","AnyEvent::MP::Global::connect",0,"anon/57Cs1CggVJjzYaQp13XXg4"] | 
| 737 |  |  |  |  |  |  | ... | 
| 738 |  |  |  |  |  |  |  | 
| 739 |  |  |  |  |  |  | The shared secret in use was C<8ugxrtw6H5tKnfPWfaSr4HGhE8MoJXmzTT1BWq7sLutNcD0IbXprQlZjIbl7MBKoeklG3IEfY9GlJthC0pENzk>. | 
| 740 |  |  |  |  |  |  |  | 
| 741 |  |  |  |  |  |  | =head2 SIMPLE HANDSHAKE FOR NON-PERL NODES | 
| 742 |  |  |  |  |  |  |  | 
| 743 |  |  |  |  |  |  | Implementing the full set of options for handshaking can be a daunting | 
| 744 |  |  |  |  |  |  | task. | 
| 745 |  |  |  |  |  |  |  | 
| 746 |  |  |  |  |  |  | If security is not so important (because you only connect locally and | 
| 747 |  |  |  |  |  |  | control the host, a common case), and you want to interface with an AEMP | 
| 748 |  |  |  |  |  |  | node from another programming language, then you can also implement a | 
| 749 |  |  |  |  |  |  | simplified handshake. | 
| 750 |  |  |  |  |  |  |  | 
| 751 |  |  |  |  |  |  | For example, in a simple implementation you could decide to simply not | 
| 752 |  |  |  |  |  |  | check the authenticity of the other side and use cleartext authentication | 
| 753 |  |  |  |  |  |  | yourself. The the handshake is as simple as sending three lines of text, | 
| 754 |  |  |  |  |  |  | reading three lines of text, and then you can exchange JSON-formatted | 
| 755 |  |  |  |  |  |  | messages: | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | aemp;1;;hmac_sha3_512;json | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | cleartext;;json | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | The nodename should be unique within the network, preferably unique with | 
| 762 |  |  |  |  |  |  | every connection, the  could be empty or some random data, and the | 
| 763 |  |  |  |  |  |  | hexencoded secret would be the shared secret, in lowercase hex (e.g. if | 
| 764 |  |  |  |  |  |  | the secret is "geheim", the hex-encoded version would be "67656865696d"). | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | Note that apart from the low-level handshake and framing protocol, there | 
| 767 |  |  |  |  |  |  | is a high-level protocol, e.g. for monitoring, building the mesh or | 
| 768 |  |  |  |  |  |  | spawning. All these messages are sent to the node port (the empty string) | 
| 769 |  |  |  |  |  |  | and can safely be ignored if you do not need the relevant functionality. | 
| 770 |  |  |  |  |  |  |  | 
| 771 |  |  |  |  |  |  | =head3 USEFUL HINTS | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | Since taking part in the global protocol to find port groups is | 
| 774 |  |  |  |  |  |  | nontrivial, hardcoding port names should be considered as well, i.e. the | 
| 775 |  |  |  |  |  |  | non-Perl node could simply listen to messages for a few well-known ports. | 
| 776 |  |  |  |  |  |  |  | 
| 777 |  |  |  |  |  |  | Alternatively, the non-Perl node could call a (already loaded) function | 
| 778 |  |  |  |  |  |  | in the Perl node by sending it a special message: | 
| 779 |  |  |  |  |  |  |  | 
| 780 |  |  |  |  |  |  | ["", "Some::Function::name", "myownport", 1, 2, 3] | 
| 781 |  |  |  |  |  |  |  | 
| 782 |  |  |  |  |  |  | This would call the function C with the string | 
| 783 |  |  |  |  |  |  | C and some additional arguments. | 
| 784 |  |  |  |  |  |  |  | 
| 785 |  |  |  |  |  |  | =head2 MONITORING | 
| 786 |  |  |  |  |  |  |  | 
| 787 |  |  |  |  |  |  | Monitoring the connection itself is transport-specific. For TCP, all | 
| 788 |  |  |  |  |  |  | connection monitoring is currently left to TCP retransmit time-outs | 
| 789 |  |  |  |  |  |  | on a busy link, and TCP keepalive (which should be enabled) for idle | 
| 790 |  |  |  |  |  |  | connections. | 
| 791 |  |  |  |  |  |  |  | 
| 792 |  |  |  |  |  |  | This is not sufficient for listener-less nodes, however: they need | 
| 793 |  |  |  |  |  |  | to regularly send data (30 seconds, or the monitoring interval, is | 
| 794 |  |  |  |  |  |  | recommended), so TCP actively probes. | 
| 795 |  |  |  |  |  |  |  | 
| 796 |  |  |  |  |  |  | Future implementations of AnyEvent::MP::Transport might query the kernel TCP | 
| 797 |  |  |  |  |  |  | buffer after a write timeout occurs, and if it is non-empty, shut down the | 
| 798 |  |  |  |  |  |  | connections, but this is an area of future research :) | 
| 799 |  |  |  |  |  |  |  | 
| 800 |  |  |  |  |  |  | =head2 NODE PROTOCOL | 
| 801 |  |  |  |  |  |  |  | 
| 802 |  |  |  |  |  |  | The transport simply transfers messages, but to implement a full node, a | 
| 803 |  |  |  |  |  |  | special node port must exist that understands a number of requests. | 
| 804 |  |  |  |  |  |  |  | 
| 805 |  |  |  |  |  |  | If you are interested in implementing this, drop us a note so we finish | 
| 806 |  |  |  |  |  |  | the documentation. | 
| 807 |  |  |  |  |  |  |  | 
| 808 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 809 |  |  |  |  |  |  |  | 
| 810 |  |  |  |  |  |  | L. | 
| 811 |  |  |  |  |  |  |  | 
| 812 |  |  |  |  |  |  | =head1 AUTHOR | 
| 813 |  |  |  |  |  |  |  | 
| 814 |  |  |  |  |  |  | Marc Lehmann | 
| 815 |  |  |  |  |  |  | http://home.schmorp.de/ | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | =cut | 
| 818 |  |  |  |  |  |  |  | 
| 819 |  |  |  |  |  |  | 1 | 
| 820 |  |  |  |  |  |  |  |