ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/MP/Transport.pm
(Generate patch)

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.1 by root, Thu Jul 30 08:38:50 2009 UTC vs.
Revision 1.13 by root, Mon Aug 3 22:05:55 2009 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines