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

Comparing cvsroot/AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.6 by root, Sun Aug 2 14:52:41 2009 UTC vs.
Revision 1.7 by root, Mon Aug 3 14:47:25 2009 UTC

… …
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11This is the superclass for MP transports, most of which is considered an 11This is the superclass for MP transports, most of which is considered an
12implementation detail. 12implementation 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
… …
111 peername => $peername, # for verification 112 peername => $peername, # for verification
112 ; 113 ;
113 114
114=cut 115=cut
115 116
116our @FRAMING_WANT = qw(json storable);#d##TODO# 117our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
118our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send
119our @AUTH_RCV = (@AUTH_SND, qw(hex_secret)); # auth types we accept
120
121#AnyEvent::Handle::register_write_type mp_record => sub {
122#};
117 123
118sub new { 124sub new {
119 my ($class, %arg) = @_; 125 my ($class, %arg) = @_;
120 126
121 my $self = bless \%arg, $class; 127 my $self = bless \%arg, $class;
… …
147 my $secret = $arg{secret}; 153 my $secret = $arg{secret};
148 my $greeting_kv = $self->{greeting} ||= {}; 154 my $greeting_kv = $self->{greeting} ||= {};
149 $greeting_kv->{"tls1.0"} ||= $arg{tls} 155 $greeting_kv->{"tls1.0"} ||= $arg{tls}
150 if exists $arg{tls} && $arg{tls_ctx}; 156 if exists $arg{tls} && $arg{tls_ctx};
151 $greeting_kv->{provider} = "AE-$VERSION"; 157 $greeting_kv->{provider} = "AE-$VERSION";
158 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
152 159
153 # send greeting 160 # send greeting
154 my $lgreeting = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min 161 my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min
155 . ";$AnyEvent::MP::Base::UNIQ" 162 . ";$AnyEvent::MP::Base::UNIQ"
156 . ";$AnyEvent::MP::Base::NODE" 163 . ";$AnyEvent::MP::Base::NODE"
157 . ";" . (MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "") 164 . ";" . (join ",", @AUTH_RCV)
158 . ";hmac_md6_64_256" # hardcoded atm. 165 . ";" . (join ",", @FRAMINGS)
159 . ";json" # hardcoded atm.
160 . ";$self->{peerhost};$self->{peerport}"
161 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); 166 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
167 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
162 168
163 $self->{hdl}->push_write ("$lgreeting\012"); 169 $self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
164 170
165 # expect greeting 171 # expect greeting
166 $self->{hdl}->push_read (line => sub { 172 $self->{hdl}->push_read (line => sub {
167 my $rgreeting = $_[1]; 173 my $rgreeting1 = $_[1];
168 174
169 my ($aemp, $version, $version_min, $uniq, $rnode, undef, $auth, $framing, $peerport, $peerhost, @kv) = split /;/, $rgreeting; 175 my ($aemp, $version, $version_min, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
170 176
171 if ($aemp ne "aemp") { 177 if ($aemp ne "aemp") {
172 return $self->error ("unparsable greeting"); 178 return $self->error ("unparsable greeting");
173 } elsif ($version_min > $PROTOCOL_VERSION) { 179 } elsif ($version_min > $PROTOCOL_VERSION) {
174 return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)"); 180 return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)");
175 } elsif ($auth ne "hmac_md6_64_256") {
176 return $self->error ("unsupported auth method ($auth)");
177 } elsif ($framing ne "json") {
178 return $self->error ("unsupported framing method ($auth)");
179 } 181 }
182
183 my $s_auth;
184 for my $auth_ (split /,/, $auths) {
185 if (grep $auth_ eq $_, @AUTH_SND) {
186 $s_auth = $auth_;
187 last;
188 }
189 }
190
191 defined $s_auth
192 or return $self->error ("$auths: no common auth type supported");
193
194 die unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.
195
196 my $s_framing;
197 for my $framing_ (split /,/, $framings) {
198 if (grep $framing_ eq $_, @FRAMINGS) {
199 $s_framing = $framing_;
200 last;
201 }
202 }
203
204 defined $s_framing
205 or return $self->error ("$framings: no common framing method supported");
180 206
181 $self->{remote_uniq} = $uniq; 207 $self->{remote_uniq} = $uniq;
182 $self->{remote_node} = $rnode; 208 $self->{remote_node} = $rnode;
183 209
184 $self->{remote_greeting} = { 210 $self->{remote_greeting} = {
… …
190 if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) { 216 if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {
191 return $self->error ("TLS server/client mismatch"); 217 return $self->error ("TLS server/client mismatch");
192 } 218 }
193 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx}); 219 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
194 } 220 }
195
196 # auth 221
197 require Digest::MD6; 222 # read nonce
198 require Digest::HMAC_MD6;
199
200 my $key = Digest::MD6::md6_hex ($secret);
201 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting\012$rgreeting", 64, 256);
202 my $rauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting\012$lgreeting", 64, 256);
203
204 $lauth ne $rauth # echo attack?
205 or return $self->error ("authentication error");
206
207 $self->{hdl}->push_write ("$auth;$lauth;$framing\012");
208
209 $self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so
210 $self->{hdl}->push_read (line => sub { 223 $self->{hdl}->push_read (line => sub {
224 my $rgreeting2 = $_[1];
225
226 # auth
227 require Digest::MD6;
228 require Digest::HMAC_MD6;
229
230 my $key = Digest::MD6::md6_hex ($secret);
231 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
232
233 my $rauth =
234 $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 "hex_secret" ? unpack "H*", $secret
236 : die;
237
238 $lauth ne $rauth # echo attack?
239 or return $self->error ("authentication error");
240
241 $self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
242
243 $self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so
244 $self->{hdl}->push_read (line => sub {
211 my ($hdl, $rline) = @_; 245 my ($hdl, $rline) = @_;
212 246
213 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline; 247 my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
214 248
215 if ($rauth2 ne $rauth) { 249 if ($rauth2 ne $rauth) {
216 return $self->error ("authentication failure/shared secret mismatch"); 250 return $self->error ("authentication failure/shared secret mismatch");
217 } 251 }
218 252
219 $self->{s_framing} = "json";#d# 253 $self->{s_framing} = $s_framing;
220 254
221 $hdl->rbuf_max (undef); 255 $hdl->rbuf_max (undef);
222 my $queue = delete $self->{queue}; # we are connected 256 my $queue = delete $self->{queue}; # we are connected
223 257
224 $self->connected; 258 $self->connected;
225 259
226 $hdl->push_write ($self->{s_framing} => $_) 260 $hdl->push_write ($self->{s_framing} => $_)
227 for @$queue; 261 for @$queue;
228 262
229 my $rmsg; $rmsg = sub { 263 my $rmsg; $rmsg = sub {
230 $_[0]->push_read ($r_framing => $rmsg); 264 $_[0]->push_read ($r_framing => $rmsg);
231 265
232 AnyEvent::MP::Base::_inject ($_[1]); 266 AnyEvent::MP::Base::_inject ($_[1]);
233 }; 267 };
234 $hdl->push_read ($r_framing => $rmsg); 268 $hdl->push_read ($r_framing => $rmsg);
269 });
235 }); 270 });
236 }); 271 });
237 } 272 }
238 273
239 $self 274 $self
… …
243 my ($self, $msg) = @_; 278 my ($self, $msg) = @_;
244 279
245 if ($self->{node} && $self->{node}{transport} == $self) { 280 if ($self->{node} && $self->{node}{transport} == $self) {
246 $self->{node}->clr_transport; 281 $self->{node}->clr_transport;
247 } 282 }
248# $self->{on_error}($self, $msg); 283 $AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
249 $self->destroy; 284 $self->destroy;
250} 285}
251 286
252sub connected { 287sub connected {
253 my ($self) = @_; 288 my ($self) = @_;
… …
274 $self->destroy; 309 $self->destroy;
275} 310}
276 311
277=back 312=back
278 313
314=head1 PROTOCOL
315
316The protocol is relatively simple, and consists of three phases which are
317symmetrical for both sides: greeting (followed by optionally switching to
318TLS mode), authentication and packet exchange.
319
320the protocol is designed to allow both full-text and binary streams.
321
322The greeting consists of two text lines that are ended by either an ASCII
323CR LF pair, or a single ASCII LF (recommended).
324
325=head2 GREETING
326
327The first line contains strings seperated (not ended) by C<;>
328characters. The first seven strings are fixed by the protocol, the
329remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
330characters themselves.
331
332The seven fixed strings are:
333
334=over 4
335
336=item C<aemp>
337
338The constant C<aemp> to identify the protocol.
339
340=item protocol version
341
342The (maximum) protocol version supported by this end, currently C<0>.
343
344=item minimum protocol version
345
346The minimum protocol version supported by this end, currently C<0>.
347
348=item a token uniquely identifying the current node instance
349
350This is a string that must change between restarts. It usually contains
351things like the current time, the (OS) process id or similar values, but
352no meaning of the contents are assumed.
353
354=item the node endpoint descriptors
355
356for public nodes, this is a comma-separated list of protocol endpoints,
357i.e., the noderef. For slave nodes, this is a unique identifier.
358
359=item the acceptable authentication methods
360
361A comma-separated list of authentication methods supported by the
362node. Note that AnyEvent::MP supports a C<hex_secret> authentication
363method that accepts a cleartext password (hex-encoded), but will not use
364this auth method itself.
365
366The receiving side should choose the first auth method it supports.
367
368=item the acceptable framing formats
369
370A comma-separated list of packet encoding/framign formats understood. The
371receiving side should choose the first framing format it supports for
372sending packets (which might be different from the format it has to accept).
373
374 . ";$self->{peerhost};$self->{peerport}"
375 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
376 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
279=head1 SEE ALSO 377=head1 SEE ALSO
280 378
281L<AnyEvent>. 379L<AnyEvent>.
282 380
283=head1 AUTHOR 381=head1 AUTHOR

Diff Legend

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