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