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.7 by root, Mon Aug 3 14:47:25 2009 UTC vs.
Revision 1.11 by root, Mon Aug 3 15:40:53 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} ||= "connect"; 132 sslv2 => 0,
136 $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,
137 } 139 };
138 140
139 $arg{secret} = AnyEvent::MP::Base::default_secret () 141 $arg{secret} = AnyEvent::MP::Base::default_secret ()
140 unless exists $arg{secret}; 142 unless exists $arg{secret};
141 143
142 $self->{hdl} = new AnyEvent::Handle 144 $self->{hdl} = new AnyEvent::Handle
150 peername => delete $arg{peername}, 152 peername => delete $arg{peername},
151 ; 153 ;
152 154
153 my $secret = $arg{secret}; 155 my $secret = $arg{secret};
154 my $greeting_kv = $self->{greeting} ||= {}; 156 my $greeting_kv = $self->{greeting} ||= {};
155 $greeting_kv->{"tls1.0"} ||= $arg{tls} 157 $greeting_kv->{"tls"} = "1.0"
156 if exists $arg{tls} && $arg{tls_ctx}; 158 if $arg{tls_ctx};
157 $greeting_kv->{provider} = "AE-$VERSION"; 159 $greeting_kv->{provider} = "AE-$VERSION";
158 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport}; 160 $greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
159 161
160 # send greeting 162 # send greeting
161 my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min 163 my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min
210 $self->{remote_greeting} = { 212 $self->{remote_greeting} = {
211 map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (), 213 map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
212 @kv 214 @kv
213 }; 215 };
214 216
215 if (exists $self->{tls} and $self->{tls_ctx} and exists $self->{remote_greeting}{"tls1.0"}) {
216 if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {
217 return $self->error ("TLS server/client mismatch");
218 }
219 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
220 }
221
222 # read nonce 217 # read nonce
223 $self->{hdl}->push_read (line => sub { 218 $self->{hdl}->push_read (line => sub {
224 my $rgreeting2 = $_[1]; 219 my $rgreeting2 = $_[1];
225 220
221 if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
222 $self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
223 $self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
224 }
225
226 # auth 226 # auth
227 require Digest::MD6; 227 require Digest::MD6;
228 require Digest::HMAC_MD6; 228 require Digest::HMAC_MD6;
229 229
230 my $key = Digest::MD6::md6_hex ($secret); 230 my $key = Digest::MD6::md6 ($secret);
231 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256); 231 my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
232 232
233 my $rauth = 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) 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 235 : $s_auth eq "hex_secret" ? unpack "H*", $secret
322The greeting consists of two text lines that are ended by either an ASCII 322The greeting consists of two text lines that are ended by either an ASCII
323CR LF pair, or a single ASCII LF (recommended). 323CR LF pair, or a single ASCII LF (recommended).
324 324
325=head2 GREETING 325=head2 GREETING
326 326
327The first line contains strings seperated (not ended) by C<;> 327The first line contains strings separated (not ended) by C<;>
328characters. The first seven strings are fixed by the protocol, the 328characters. The first seven strings are fixed by the protocol, the
329remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;> 329remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
330characters themselves. 330characters themselves.
331 331
332The seven fixed strings are: 332The seven fixed strings are:
369 369
370A comma-separated list of packet encoding/framign formats understood. The 370A comma-separated list of packet encoding/framign formats understood. The
371receiving side should choose the first framing format it supports for 371receiving side should choose the first framing format it supports for
372sending packets (which might be different from the format it has to accept). 372sending packets (which might be different from the format it has to accept).
373 373
374 . ";$self->{peerhost};$self->{peerport}" 374=back
375 . (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv); 375
376 my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), ""; 376The remaining arguments are C<KEY=VALUE> pairs. The following key-value
377pairs are known at this time:
378
379=over 4
380
381=item provider=<module-version>
382
383The software provider for this implementation. For AnyEvent::MP, this is
384C<AE-0.0> or whatever version it currently is at.
385
386=item peeraddr=<host>:<port>
387
388The peer address (socket address of the other side) as seen locally, in the same format
389as noderef endpoints.
390
391=item tls=<major>.<minor>
392
393Indicates that the other side supports TLS (version should be 1.0) and
394wishes to do a TLS handshake.
395
396=back
397
398After this greeting line there will be a second line containing a
399cryptographic nonce, i.e. random data of high quality. To keep the
400protocol text-only, these are usually 32 base64-encoded octets, but
401it could be anything that doesn't contain any ASCII CR or ASCII LF
402characters.
403
404Example of the two lines of greeting:
405
406 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
407 XntegV2Guvss0qNn7phCPnoU87xqxV+4Mqm/5y4iQm6a
408
409=head2 TLS handshake
410
411If, after the handshake, both sides indicate interest in TLS, then the
412connection I<must> use TLS, or fail.
413
414Both sides compare their nonces, and the side who sent the lower nonce
415value ("string" comparison on the raw octet values) becomes the client,
416and the one with the higher nonce the server.
417
418=head2 AUTHENTICATION PHASE
419
420After the greeting is received (and the optional TLS handshake),
421the authentication phase begins, which consists of sending a single
422C<;>-separated line with three fixed strings and any number of
423C<KEY=VALUE> pairs.
424
425The three fixed strings are:
426
427=over 4
428
429=item the authentication method chosen
430
431This must be one of the methods offered by the other side in the greeting.
432
433=item the authentication data
434
435The authentication data itself, usually base64 or hex-encoded data.
436
437=item the framing protocol chosen
438
439This must be one of the framing protocols offered by the other side in the
440greeting. Each side must accept the choice of the other side.
441
442=back
443
444Example (the actual reply matching the previous example):
445
446 hmac_md6_64_256;wIlLedBY956UCGSISG9mBZRDTG8xUi73/sVse2DSQp0;json
447
448=head2 DATA PHASE
449
450After this, packets get exchanged using the chosen framing protocol. It is
451quite possible that both sides use a different framing protocol.
452
377=head1 SEE ALSO 453=head1 SEE ALSO
378 454
379L<AnyEvent>. 455L<AnyEvent>.
380 456
381=head1 AUTHOR 457=head1 AUTHOR

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines