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.14 by root, Tue Aug 4 07:46:33 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, 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
408I<< The two nonces B<must> be different, and an aemp implementation
409B<must> check and fail when they are identical >>.
410
411Example of the two lines of greeting:
412
413 aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0
414 p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
415
416=head2 TLS handshake
417
418I<< If, after the handshake, both sides indicate interest in TLS, then the
419connection B<must> use TLS, or fail.>>
420
421Both sides compare their nonces, and the side who sent the lower nonce
422value ("string" comparison on the raw octet values) becomes the client,
423and the one with the higher nonce the server.
424
425=head2 AUTHENTICATION PHASE
426
427After the greeting is received (and the optional TLS handshake),
428the authentication phase begins, which consists of sending a single
429C<;>-separated line with three fixed strings and any number of
430C<KEY=VALUE> pairs.
431
432The three fixed strings are:
433
434=over 4
435
436=item the authentication method chosen
437
438This must be one of the methods offered by the other side in the greeting.
439
440The currently supported authentication methods are:
441
442=over 4
443
444=item cleartext
445
446This is simply the shared secret, lowercase-hex-encoded. This method is of
447course very insecure, unless TLS is used, which is why this module will
448accept, but not generate, cleartext auth replies.
449
450=item hmac_md6_64_256
451
452This method uses an MD6 HMAC with 64 bit blocksize and 256 bit hash. First, the shared secret
453is hashed with MD6:
454
455 key = MD6 (secret)
456
457This secret is then used to generate the "local auth reply", by taking
458the two local greeting lines and the two remote greeting lines (without
459line endings), appending \012 to all of them, concatenating them and
460calculating the MD6 HMAC with the key.
461
462 lauth = HMAC_MD6 key, "lgreeting1\012lgreeting2\012rgreeting1\012rgreeting2\012"
463
464This authentication token is then lowercase-hex-encoded and sent to the
465other side.
466
467Then the remote auth reply is generated using the same method, but local
468and remote greeting lines swapped:
469
470 rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"
471
472This is the token that is expected from the other side.
473
474=back
475
476=item the authentication data
477
478The authentication data itself, usually base64 or hex-encoded data, see
479above.
480
481=item the framing protocol chosen
482
483This must be one of the framing protocols offered by the other side in the
484greeting. Each side must accept the choice of the other side.
485
486=back
487
488Example:
489
490 hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json
491
492=head2 DATA PHASE
493
494After this, packets get exchanged using the chosen framing protocol. It is
495quite possible that both sides use a different framing protocol.
496
281=head1 SEE ALSO 497=head1 SEE ALSO
282 498
283L<AnyEvent>. 499L<AnyEvent>.
284 500
285=head1 AUTHOR 501=head1 AUTHOR

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines