ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/MP/Transport.pm
Revision: 1.41
Committed: Fri Aug 28 16:37:30 2009 UTC (14 years, 9 months ago) by root
Branch: MAIN
Changes since 1.40: +66 -34 lines
Log Message:
*** empty log message ***

File Contents

# Content
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 implements the actual transport protocol for MP (it represents a
12 single link), most of which is considered an implementation detail.
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 use common::sense;
26
27 use Scalar::Util ();
28 use List::Util ();
29 use MIME::Base64 ();
30 use Storable ();
31 use JSON::XS ();
32
33 use Digest::MD6 ();
34 use Digest::HMAC_MD6 ();
35
36 use AE ();
37 use AnyEvent::Socket ();
38 use AnyEvent::Handle 4.92 ();
39
40 use AnyEvent::MP::Config ();
41
42 our $PROTOCOL_VERSION = 0;
43
44 =item $listener = mp_listener $host, $port, <constructor-args>
45
46 Creates a listener on the given host/port using
47 C<AnyEvent::Socket::tcp_server>.
48
49 See C<new>, below, for constructor arguments.
50
51 Defaults for peerhost, peerport and fh are provided.
52
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 my $tp = new AnyEvent::MP::Transport
62 fh => $fh,
63 peerhost => $host,
64 peerport => $port,
65 @args,
66 ;
67 $tp->{keepalive} = $tp;
68 }
69 }
70
71 =item $guard = mp_connect $host, $port, <constructor-args>, $cb->($transport)
72
73 =cut
74
75 sub mp_connect {
76 my $release = pop;
77 my ($host, $port, @args) = @_;
78
79 my $state;
80
81 $state = AnyEvent::Socket::tcp_connect $host, $port, sub {
82 my ($fh, $nhost, $nport) = @_;
83
84 return $release->() unless $fh;
85
86 $state = new AnyEvent::MP::Transport
87 fh => $fh,
88 peername => $host,
89 peerhost => $nhost,
90 peerport => $nport,
91 release => $release,
92 @args,
93 ;
94 };
95
96 \$state
97 }
98
99 =item new AnyEvent::MP::Transport
100
101 # immediately starts negotiation
102 my $transport = new AnyEvent::MP::Transport
103 # mandatory
104 fh => $filehandle,
105 local_id => $identifier,
106 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 greeting => { key => value },
113
114 # tls support
115 tls_ctx => AnyEvent::TLS,
116 peername => $peername, # for verification
117 ;
118
119 =cut
120
121 sub LATENCY() { 3 } # assumed max. network latency
122
123 our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
124 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
127 #AnyEvent::Handle::register_write_type mp_record => sub {
128 #};
129
130 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 my $config = AnyEvent::MP::Config::config;
141
142 my $latency = $config->{network_latency} || LATENCY;
143
144 $arg{secret} = $config->{secret}
145 unless exists $arg{secret};
146
147 $arg{timeout} = $config->{monitor_timeout} || $AnyEvent::MP::Kernel::MONITOR_TIMEOUT
148 unless exists $arg{timeout};
149
150 $arg{timeout} -= $latency;
151
152 $arg{timeout} = 1 + $latency
153 if $arg{timeout} < 1 + $latency;
154
155 my $secret = $arg{secret};
156
157 if (exists $config->{cert}) {
158 $arg{tls_ctx} = {
159 sslv2 => 0,
160 sslv3 => 0,
161 tlsv1 => 1,
162 verify => 1,
163 cert => $config->{cert},
164 ca_cert => $config->{cert},
165 verify_require_client_cert => 1,
166 };
167 }
168
169 $self->{hdl} = new AnyEvent::Handle
170 fh => delete $arg{fh},
171 autocork => 1,
172 no_delay => 1,
173 on_error => sub {
174 $self->error ($_[2]);
175 },
176 rtimeout => $latency,
177 peername => delete $arg{peername},
178 ;
179
180 my $greeting_kv = $self->{greeting} ||= {};
181
182 $self->{local_node} ||= $AnyEvent::MP::Kernel::NODE;
183
184 $greeting_kv->{tls} = "1.0" if $arg{tls_ctx};
185 $greeting_kv->{provider} = "AE-$AnyEvent::MP::Kernel::VERSION";
186 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
187 $greeting_kv->{timeout} = $arg{timeout};
188
189 # send greeting
190 my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
191 . ";$self->{local_node}"
192 . ";" . (join ",", @AUTH_RCV)
193 . ";" . (join ",", @FRAMINGS)
194 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
195
196 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Kernel::nonce (66), "";
197
198 $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
199
200 # expect greeting
201 $self->{hdl}->rbuf_max (4 * 1024);
202 $self->{hdl}->push_read (line => sub {
203 my $rgreeting1 = $_[1];
204
205 my ($aemp, $version, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
206
207 if ($aemp ne "aemp") {
208 return $self->error ("unparsable greeting");
209 } elsif ($version != $PROTOCOL_VERSION) {
210 return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
211 } 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 }
216
217 $self->{remote_node} = $rnode;
218
219 $self->{remote_greeting} = {
220 map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
221 @kv
222 };
223
224 # read nonce
225 $self->{hdl}->push_read (line => sub {
226 my $rgreeting2 = $_[1];
227
228 "$lgreeting1\012$lgreeting2" ne "$rgreeting1\012$rgreeting2" # echo attack?
229 or return $self->error ("authentication error, echo attack?");
230
231 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 my $key;
256 my $lauth;
257
258 if ($tls) {
259 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
260 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
261
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 } elsif (length $secret) {
268 return $self->error ("$s_auth: fatal, selected unsupported snd auth method")
269 unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.
270
271 $key = Digest::MD6::md6 $secret;
272 # 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
275 } else {
276 return $self->error ("unable to handshake TLS and no shared secret configured");
277 }
278
279 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
280
281 # read the authentication response
282 $self->{hdl}->push_read (line => sub {
283 my ($hdl, $rline) = @_;
284
285 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
286
287 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 : $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
294 if ($rauth2 ne $rauth) {
295 return $self->error ("authentication failure/shared secret mismatch");
296 }
297
298 $self->{s_framing} = $s_framing;
299
300 $hdl->rbuf_max (undef);
301 my $queue = delete $self->{queue}; # we are connected
302
303 $self->{hdl}->rtimeout ($self->{remote_greeting}{timeout});
304 $self->{hdl}->wtimeout ($arg{timeout} - LATENCY);
305 $self->{hdl}->on_wtimeout (sub { $self->send ([]) });
306
307 $self->connected;
308
309 # send queued messages
310 $self->send ($_)
311 for @$queue;
312
313 # receive handling
314 my $src_node = $self->{node};
315
316 my $rmsg; $rmsg = sub {
317 $_[0]->push_read ($r_framing => $rmsg);
318
319 local $AnyEvent::MP::Kernel::SRCNODE = $src_node;
320 AnyEvent::MP::Kernel::_inject (@{ $_[1] });
321 };
322 $hdl->push_read ($r_framing => $rmsg);
323 });
324 });
325 });
326 }
327
328 $self
329 }
330
331 sub error {
332 my ($self, $msg) = @_;
333
334 delete $self->{keepalive};
335
336 # $AnyEvent::MP::Kernel::WARN->(9, "$self->{peerhost}:$self->{peerport} $msg");#d#
337
338 $self->{node}->transport_error (transport_error => $self->{node}{id}, $msg)
339 if $self->{node} && $self->{node}{transport} == $self;
340
341 (delete $self->{release})->()
342 if exists $self->{release};
343
344 # $AnyEvent::MP::Kernel::WARN->(7, "$self->{peerhost}:$self->{peerport}: $msg");
345 $self->destroy;
346 }
347
348 sub connected {
349 my ($self) = @_;
350
351 delete $self->{keepalive};
352
353 (delete $self->{release})->()
354 if exists $self->{release};
355
356 $AnyEvent::MP::Kernel::WARN->(9, "$self->{peerhost}:$self->{peerport} connected as $self->{remote_node}");
357
358 my $node = AnyEvent::MP::Kernel::add_node ($self->{remote_node});
359 Scalar::Util::weaken ($self->{node} = $node);
360 $node->transport_connect ($self);
361 }
362
363 sub send {
364 $_[0]{hdl}->push_write ($_[0]{s_framing} => $_[1]);
365 }
366
367 sub destroy {
368 my ($self) = @_;
369
370 $self->{hdl}->destroy
371 if $self->{hdl};
372 }
373
374 sub DESTROY {
375 my ($self) = @_;
376
377 $self->destroy;
378 }
379
380 =back
381
382 =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 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
401 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 The fixed strings are:
411
412 =over 4
413
414 =item protocol identification
415
416 The constant C<aemp> to identify the protocol.
417
418 =item protocol version
419
420 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 are supposed to be handled through additional key-value pairs.
423
424 =item the node id
425
426 This is the node ID of the connecting node.
427
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 =back
444
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 The peer address (socket address of the other side) as seen locally.
458
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 =item timeout=<seconds>
465
466 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
471 =back
472
473 =head3 Second Greeting Line
474
475 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 I<< The two nonces B<must> be different, and an aemp implementation
482 B<must> check and fail when they are identical >>.
483
484 Example of a nonce line:
485
486 p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
487
488 =head2 TLS handshake
489
490 I<< If, after the handshake, both sides indicate interest in TLS, then the
491 connection B<must> use TLS, or fail. >>
492
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 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 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 =item tls_anon
551
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 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
577 =back
578
579 =item the authentication data
580
581 The authentication data itself, usually base64 or hex-encoded data, see
582 above.
583
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 Example of an authentication reply:
592
593 hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json
594
595 =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 =head2 FULL EXAMPLE
601
602 This is an actual protocol dump of a handshake, followed by a single data
603 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 > ["","lookup","pinger","10.0.0.1:4040#nndKd+gn.a","resolved"]
613
614 =head1 SEE ALSO
615
616 L<AnyEvent::MP>.
617
618 =head1 AUTHOR
619
620 Marc Lehmann <schmorp@schmorp.de>
621 http://home.schmorp.de/
622
623 =cut
624
625 1
626