ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/MP/Transport.pm
Revision: 1.17
Committed: Tue Aug 4 14:10:51 2009 UTC (14 years, 10 months ago) by root
Branch: MAIN
Changes since 1.16: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

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