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