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.8 by root, Mon Aug 3 14:58:13 2009 UTC vs.
Revision 1.12 by root, Mon Aug 3 21:35:03 2009 UTC

… …
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
… …
82 $cb->(new AnyEvent::MP::Transport 81 $cb->(new AnyEvent::MP::Transport
83 fh => $fh, 82 fh => $fh,
84 peername => $host, 83 peername => $host,
85 peerhost => $nhost, 84 peerhost => $nhost,
86 peerport => $nport, 85 peerport => $nport,
87 tls => "accept",
88 @args, 86 @args,
89 ); 87 );
90 } 88 }
91} 89}
92 90
… …
105 on_eof => sub { clean-close-callback }, 103 on_eof => sub { clean-close-callback },
106 on_connect => sub { successful-connect-callback }, 104 on_connect => sub { successful-connect-callback },
107 greeting => { key => value }, 105 greeting => { key => value },
108 106
109 # tls support 107 # tls support
110 tls => "accept|connect",
111 tls_ctx => AnyEvent::TLS, 108 tls_ctx => AnyEvent::TLS,
112 peername => $peername, # for verification 109 peername => $peername, # for verification
113 ; 110 ;
114 111
115=cut 112=cut
… …
129 $self->{queue} = []; 126 $self->{queue} = [];
130 127
131 { 128 {
132 Scalar::Util::weaken (my $self = $self); 129 Scalar::Util::weaken (my $self = $self);
133 130
134 if (exists $arg{connect}) { 131 $arg{tls_ctx_disabled} ||= {
135 $arg{tls_ctx} ||= { sslv2 => 0, sslv3 => 0, tlsv1 => 1, verify => 1 }; 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,
136 } 139 };
137 140
138 $arg{secret} = AnyEvent::MP::Base::default_secret () 141 $arg{secret} = AnyEvent::MP::Base::default_secret ()
139 unless exists $arg{secret}; 142 unless exists $arg{secret};
140 143
141 $self->{hdl} = new AnyEvent::Handle 144 $self->{hdl} = new AnyEvent::Handle
142 fh => delete $arg{fh}, 145 fh => delete $arg{fh},
143 rbuf_max => 64 * 1024,
144 autocork => 1, 146 autocork => 1,
145 no_delay => 1, 147 no_delay => 1,
146 on_error => sub { 148 on_error => sub {
147 $self->error ($_[2]); 149 $self->error ($_[2]);
148 }, 150 },
… …
155 if $arg{tls_ctx}; 157 if $arg{tls_ctx};
156 $greeting_kv->{provider} = "AE-$VERSION"; 158 $greeting_kv->{provider} = "AE-$VERSION";
157 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; 159 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
158 160
159 # send greeting 161 # send greeting
160 my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min 162 my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
161 . ";$AnyEvent::MP::Base::UNIQ" 163 . ";$AnyEvent::MP::Base::UNIQ"
162 . ";$AnyEvent::MP::Base::NODE" 164 . ";$AnyEvent::MP::Base::NODE"
163 . ";" . (join ",", @AUTH_RCV) 165 . ";" . (join ",", @AUTH_RCV)
164 . ";" . (join ",", @FRAMINGS) 166 . ";" . (join ",", @FRAMINGS)
165 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); 167 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
168
166 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), ""; 169 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
167 170
168 $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012"); 171 $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
169 172
170 # expect greeting 173 # expect greeting
174 $self->{hdl}->rbuf_max (4 * 1024);
171 $self->{hdl}->push_read (line => sub { 175 $self->{hdl}->push_read (line => sub {
172 my $rgreeting1 = $_[1]; 176 my $rgreeting1 = $_[1];
173 177
174 my ($aemp, $version, $version_min, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1; 178 my ($aemp, $version, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
175 179
176 if ($aemp ne "aemp") { 180 if ($aemp ne "aemp") {
177 return $self->error ("unparsable greeting"); 181 return $self->error ("unparsable greeting");
178 } elsif ($version_min > $PROTOCOL_VERSION) { 182 } elsif ($version != $PROTOCOL_VERSION) {
179 return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)"); 183 return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
180 } 184 }
181 185
182 my $s_auth; 186 my $s_auth;
183 for my $auth_ (split /,/, $auths) { 187 for my $auth_ (split /,/, $auths) {
184 if (grep $auth_ eq $_, @AUTH_SND) { 188 if (grep $auth_ eq $_, @AUTH_SND) {
… …
213 217
214 # read nonce 218 # read nonce
215 $self->{hdl}->push_read (line => sub { 219 $self->{hdl}->push_read (line => sub {
216 my $rgreeting2 = $_[1]; 220 my $rgreeting2 = $_[1];
217 221
218 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{"tls"}) { 222 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
219 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept"; 223 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
220 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); 224 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
221 } 225 }
222 226
223 # auth 227 # auth
224 require Digest::MD6; 228 require Digest::MD6;
225 require Digest::HMAC_MD6; 229 require Digest::HMAC_MD6;
226 230
227 my $key = Digest::MD6::md6_hex ($secret); 231 my $key = Digest::MD6::md6 ($secret);
228 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256); 232 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
229 233
230 my $rauth = 234 my $rauth =
231 $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256) 235 $s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256)
232 : $s_auth eq "hex_secret" ? unpack "H*", $secret 236 : $s_auth eq "hex_secret" ? unpack "H*", $secret
… …
235 $lauth ne $rauth # echo attack? 239 $lauth ne $rauth # echo attack?
236 or return $self->error ("authentication error"); 240 or return $self->error ("authentication error");
237 241
238 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012"); 242 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
239 243
240 $self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so 244 # reasd the authentication response
241 $self->{hdl}->push_read (line => sub { 245 $self->{hdl}->push_read (line => sub {
242 my ($hdl, $rline) = @_; 246 my ($hdl, $rline) = @_;
243 247
244 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; 248 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
245 249
… …
252 $hdl->rbuf_max (undef); 256 $hdl->rbuf_max (undef);
253 my $queue = delete $self->{queue}; # we are connected 257 my $queue = delete $self->{queue}; # we are connected
254 258
255 $self->connected; 259 $self->connected;
256 260
261 my $src_node = $self->{node};
262
257 $hdl->push_write ($self->{s_framing} => $_) 263 $hdl->push_write ($self->{s_framing} => $_)
258 for @$queue; 264 for @$queue;
259 265
260 my $rmsg; $rmsg = sub { 266 my $rmsg; $rmsg = sub {
261 $_[0]->push_read ($r_framing => $rmsg); 267 $_[0]->push_read ($r_framing => $rmsg);
262 268
269 local $AnyEvent::MP::Base::SRCNODE = $src_node;
263 AnyEvent::MP::Base::_inject ($_[1]); 270 AnyEvent::MP::Base::_inject (@{ $_[1] });
264 }; 271 };
265 $hdl->push_read ($r_framing => $rmsg); 272 $hdl->push_read ($r_framing => $rmsg);
266 }); 273 });
267 }); 274 });
268 }); 275 });
… …
320CR LF pair, or a single ASCII LF (recommended). 327CR LF pair, or a single ASCII LF (recommended).
321 328
322=head2 GREETING 329=head2 GREETING
323 330
324The first line contains strings separated (not ended) by C<;> 331The first line contains strings separated (not ended) by C<;>
325characters. The first seven strings are fixed by the protocol, the 332characters. The first even ixtrings are fixed by the protocol, the
326remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;> 333remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
327characters themselves. 334characters themselves.
328 335
336All the lines until after authentication must not exceed 4kb in length, including delimiter.
337
329The seven fixed strings are: 338The fixed strings are:
330 339
331=over 4 340=over 4
332 341
333=item C<aemp> 342=item C<aemp>
334 343
335The constant C<aemp> to identify the protocol. 344The constant C<aemp> to identify the protocol.
336 345
337=item protocol version 346=item protocol version
338 347
339The (maximum) protocol version supported by this end, currently C<0>.
340
341=item minimum protocol version
342
343The minimum protocol version supported by this end, currently C<0>. 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.
344 351
345=item a token uniquely identifying the current node instance 352=item a token uniquely identifying the current node instance
346 353
347This is a string that must change between restarts. It usually contains 354This is a string that must change between restarts. It usually contains
348things like the current time, the (OS) process id or similar values, but 355things like the current time, the (OS) process id or similar values, but
… …
366 373
367A comma-separated list of packet encoding/framign formats understood. The 374A comma-separated list of packet encoding/framign formats understood. The
368receiving side should choose the first framing format it supports for 375receiving side should choose the first framing format it supports for
369sending packets (which might be different from the format it has to accept). 376sending packets (which might be different from the format it has to accept).
370 377
371=cut 378=back
372 379
373The remaining arguments are C<KEY=VALUE> pairs. The following key-value 380The remaining arguments are C<KEY=VALUE> pairs. The following key-value
374pairs are known at this time: 381pairs are known at this time:
375 382
376=over 4 383=over 4
… …
398it could be anything that doesn't contain any ASCII CR or ASCII LF 405it could be anything that doesn't contain any ASCII CR or ASCII LF
399characters. 406characters.
400 407
401Example of the two lines of greeting: 408Example of the two lines of greeting:
402 409
403 aemp;0;0;e7d.4a76f48f;10.0.0.1:4040;hmac_md6_64_256,hex_secret;json,storable;provider=AE-0.0;peeraddr=127.0.0.1:1235 410 aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0
404 XntegV2Guvss0qNn7phCPnoU87xqxV+4Mqm/5y4iQm6a 411 p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
405 412
406=head2 TLS handshake 413=head2 TLS handshake
407 414
408If, after the handshake, both sides indicate interest in TLS, then the 415If, after the handshake, both sides indicate interest in TLS, then the
409connection I<must> use TLS, or fail. 416connection I<must> use TLS, or fail.
… …
436This must be one of the framing protocols offered by the other side in the 443This must be one of the framing protocols offered by the other side in the
437greeting. Each side must accept the choice of the other side. 444greeting. Each side must accept the choice of the other side.
438 445
439=back 446=back
440 447
448Example:
449
450 hmac_md6_64_256;wIlLedBY956UCGSISG9mBZRDTG8xUi73/sVse2DSQp0;json
451
441=head2 DATA PHASE 452=head2 DATA PHASE
442 453
443After this, packets get exchanged using the chosen framing protocol. It is 454After this, packets get exchanged using the chosen framing protocol. It is
444quite possible that both sides use a different framing protocol. 455quite possible that both sides use a different framing protocol.
445 456

Diff Legend

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