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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines