[ViewVC] Diff of: cvs/AnyEvent-MP/MP/Transport.pm

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.6 by root, Sun Aug 2 14:52:41 2009 UTC vs.
Revision 1.11 by root, Mon Aug 3 15:40:53 2009 UTC

…		…
9	=head1 DESCRIPTION	9	=head1 DESCRIPTION
10		10
11	This is the superclass for MP transports, most of which is considered an	11	This is the superclass for MP transports, most of which is considered an
12	implementation detail.	12	implementation detail.
13		13
14	Future versions might document the actual protocol.	14	See the "PROTOCOL" section below if you want to write another client for
		15	this protocol.
15		16
16	=head1 FUNCTIONS/METHODS	17	=head1 FUNCTIONS/METHODS
17		18
18	=over 4	19	=over 4
19		20
…		…
42	Creates a listener on the given host/port using	43	Creates a listener on the given host/port using
43	C<AnyEvent::Socket::tcp_server>.	44	C<AnyEvent::Socket::tcp_server>.
44		45
45	See C<new>, below, for constructor arguments.	46	See C<new>, below, for constructor arguments.
46		47
47	Defaults for peerhost, peerport, fh and tls are provided.	48	Defaults for peerhost, peerport and fh are provided.
48		49
49	=cut	50	=cut
50		51
51	sub mp_server($$@) {	52	sub mp_server($$@) {
52	my $cb = pop;	53	my $cb = pop;
…		…
57		58
58	$cb->(new AnyEvent::MP::Transport	59	$cb->(new AnyEvent::MP::Transport
59	fh => $fh,	60	fh => $fh,
60	peerhost => $host,	61	peerhost => $host,
61	peerport => $port,	62	peerport => $port,
62	tls => "accept",
63	@args,	63	@args,
64	);	64	);
65	}	65	}
66	}	66	}
67		67
…		…
81	$cb->(new AnyEvent::MP::Transport	81	$cb->(new AnyEvent::MP::Transport
82	fh => $fh,	82	fh => $fh,
83	peername => $host,	83	peername => $host,
84	peerhost => $nhost,	84	peerhost => $nhost,
85	peerport => $nport,	85	peerport => $nport,
86	tls => "accept",
87	@args,	86	@args,
88	);	87	);
89	}	88	}
90	}	89	}
91		90
…		…
104	on_eof => sub { clean-close-callback },	103	on_eof => sub { clean-close-callback },
105	on_connect => sub { successful-connect-callback },	104	on_connect => sub { successful-connect-callback },
106	greeting => { key => value },	105	greeting => { key => value },
107		106
108	# tls support	107	# tls support
109	tls => "accept\|connect",
110	tls_ctx => AnyEvent::TLS,	108	tls_ctx => AnyEvent::TLS,
111	peername => $peername, # for verification	109	peername => $peername, # for verification
112	;	110	;
113		111
114	=cut	112	=cut
115		113
116	our @FRAMING_WANT = qw(json storable);#d##TODO#	114	our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference
		115	our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send
		116	our @AUTH_RCV = (@AUTH_SND, qw(hex_secret)); # auth types we accept
		117
		118	#AnyEvent::Handle::register_write_type mp_record => sub {
		119	#};
117		120
118	sub new {	121	sub new {
119	my ($class, %arg) = @_;	122	my ($class, %arg) = @_;
120		123
121	my $self = bless \%arg, $class;	124	my $self = bless \%arg, $class;
…		…
123	$self->{queue} = [];	126	$self->{queue} = [];
124		127
125	{	128	{
126	Scalar::Util::weaken (my $self = $self);	129	Scalar::Util::weaken (my $self = $self);
127		130
128	if (exists $arg{connect}) {	131	$arg{tls_ctx_disabled} \|\|= {
129	$arg{tls} \|\|= "connect";	132	sslv2 => 0,
130	$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,
131	}	139	};
132		140
133	$arg{secret} = AnyEvent::MP::Base::default_secret ()	141	$arg{secret} = AnyEvent::MP::Base::default_secret ()
134	unless exists $arg{secret};	142	unless exists $arg{secret};
135		143
136	$self->{hdl} = new AnyEvent::Handle	144	$self->{hdl} = new AnyEvent::Handle
…		…
144	peername => delete $arg{peername},	152	peername => delete $arg{peername},
145	;	153	;
146		154
147	my $secret = $arg{secret};	155	my $secret = $arg{secret};
148	my $greeting_kv = $self->{greeting} \|\|= {};	156	my $greeting_kv = $self->{greeting} \|\|= {};
149	$greeting_kv->{"tls1.0"} \|\|= $arg{tls}	157	$greeting_kv->{"tls"} = "1.0"
150	if exists $arg{tls} && $arg{tls_ctx};	158	if $arg{tls_ctx};
151	$greeting_kv->{provider} = "AE-$VERSION";	159	$greeting_kv->{provider} = "AE-$VERSION";
		160	$greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
152		161
153	# send greeting	162	# send greeting
154	my $lgreeting = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min	163	my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min
155	. ";$AnyEvent::MP::Base::UNIQ"	164	. ";$AnyEvent::MP::Base::UNIQ"
156	. ";$AnyEvent::MP::Base::NODE"	165	. ";$AnyEvent::MP::Base::NODE"
157	. ";" . (MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "")	166	. ";" . (join ",", @AUTH_RCV)
158	. ";hmac_md6_64_256" # hardcoded atm.	167	. ";" . (join ",", @FRAMINGS)
159	. ";json" # hardcoded atm.
160	. ";$self->{peerhost};$self->{peerport}"
161	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);	168	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
		169	my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
162		170
163	$self->{hdl}->push_write ("$lgreeting\012");	171	$self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
164		172
165	# expect greeting	173	# expect greeting
166	$self->{hdl}->push_read (line => sub {	174	$self->{hdl}->push_read (line => sub {
167	my $rgreeting = $_[1];	175	my $rgreeting1 = $_[1];
168		176
169	my ($aemp, $version, $version_min, $uniq, $rnode, undef, $auth, $framing, $peerport, $peerhost, @kv) = split /;/, $rgreeting;	177	my ($aemp, $version, $version_min, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
170		178
171	if ($aemp ne "aemp") {	179	if ($aemp ne "aemp") {
172	return $self->error ("unparsable greeting");	180	return $self->error ("unparsable greeting");
173	} elsif ($version_min > $PROTOCOL_VERSION) {	181	} elsif ($version_min > $PROTOCOL_VERSION) {
174	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)");	182	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	}	183	}
		184
		185	my $s_auth;
		186	for my $auth_ (split /,/, $auths) {
		187	if (grep $auth_ eq $_, @AUTH_SND) {
		188	$s_auth = $auth_;
		189	last;
		190	}
		191	}
		192
		193	defined $s_auth
		194	or return $self->error ("$auths: no common auth type supported");
		195
		196	die unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.
		197
		198	my $s_framing;
		199	for my $framing_ (split /,/, $framings) {
		200	if (grep $framing_ eq $_, @FRAMINGS) {
		201	$s_framing = $framing_;
		202	last;
		203	}
		204	}
		205
		206	defined $s_framing
		207	or return $self->error ("$framings: no common framing method supported");
180		208
181	$self->{remote_uniq} = $uniq;	209	$self->{remote_uniq} = $uniq;
182	$self->{remote_node} = $rnode;	210	$self->{remote_node} = $rnode;
183		211
184	$self->{remote_greeting} = {	212	$self->{remote_greeting} = {
185	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),	213	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
186	@kv	214	@kv
187	};	215	};
188		216
189	if (exists $self->{tls} and $self->{tls_ctx} and exists $self->{remote_greeting}{"tls1.0"}) {	217	# read nonce
		218	$self->{hdl}->push_read (line => sub {
		219	my $rgreeting2 = $_[1];
		220
190	if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {	221	if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
191	return $self->error ("TLS server/client mismatch");	222	$self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
		223	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
192	}	224	}
193	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
194	}	225
195
196	# auth	226	# auth
197	require Digest::MD6;	227	require Digest::MD6;
198	require Digest::HMAC_MD6;	228	require Digest::HMAC_MD6;
199		229
200	my $key = Digest::MD6::md6_hex ($secret);	230	my $key = Digest::MD6::md6 ($secret);
201	my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting\012$rgreeting", 64, 256);	231	my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
202	my $rauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting\012$lgreeting", 64, 256);
203		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
204	$lauth ne $rauth # echo attack?	238	$lauth ne $rauth # echo attack?
205	or return $self->error ("authentication error");	239	or return $self->error ("authentication error");
206		240
207	$self->{hdl}->push_write ("$auth;$lauth;$framing\012");	241	$self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
208		242
209	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so	243	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so
210	$self->{hdl}->push_read (line => sub {	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
252	sub connected {	287	sub 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
		316	The protocol is relatively simple, and consists of three phases which are
		317	symmetrical for both sides: greeting (followed by optionally switching to
		318	TLS mode), authentication and packet exchange.
		319
		320	the protocol is designed to allow both full-text and binary streams.
		321
		322	The greeting consists of two text lines that are ended by either an ASCII
		323	CR LF pair, or a single ASCII LF (recommended).
		324
		325	=head2 GREETING
		326
		327	The first line contains strings separated (not ended) by C<;>
		328	characters. The first seven strings are fixed by the protocol, the
		329	remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
		330	characters themselves.
		331
		332	The seven fixed strings are:
		333
		334	=over 4
		335
		336	=item C<aemp>
		337
		338	The constant C<aemp> to identify the protocol.
		339
		340	=item protocol version
		341
		342	The (maximum) protocol version supported by this end, currently C<0>.
		343
		344	=item minimum protocol version
		345
		346	The minimum protocol version supported by this end, currently C<0>.
		347
		348	=item a token uniquely identifying the current node instance
		349
		350	This is a string that must change between restarts. It usually contains
		351	things like the current time, the (OS) process id or similar values, but
		352	no meaning of the contents are assumed.
		353
		354	=item the node endpoint descriptors
		355
		356	for public nodes, this is a comma-separated list of protocol endpoints,
		357	i.e., the noderef. For slave nodes, this is a unique identifier.
		358
		359	=item the acceptable authentication methods
		360
		361	A comma-separated list of authentication methods supported by the
		362	node. Note that AnyEvent::MP supports a C<hex_secret> authentication
		363	method that accepts a cleartext password (hex-encoded), but will not use
		364	this auth method itself.
		365
		366	The receiving side should choose the first auth method it supports.
		367
		368	=item the acceptable framing formats
		369
		370	A comma-separated list of packet encoding/framign formats understood. The
		371	receiving side should choose the first framing format it supports for
		372	sending packets (which might be different from the format it has to accept).
		373
		374	=back
		375
		376	The remaining arguments are C<KEY=VALUE> pairs. The following key-value
		377	pairs are known at this time:
		378
		379	=over 4
		380
		381	=item provider=<module-version>
		382
		383	The software provider for this implementation. For AnyEvent::MP, this is
		384	C<AE-0.0> or whatever version it currently is at.
		385
		386	=item peeraddr=<host>:<port>
		387
		388	The peer address (socket address of the other side) as seen locally, in the same format
		389	as noderef endpoints.
		390
		391	=item tls=<major>.<minor>
		392
		393	Indicates that the other side supports TLS (version should be 1.0) and
		394	wishes to do a TLS handshake.
		395
		396	=back
		397
		398	After this greeting line there will be a second line containing a
		399	cryptographic nonce, i.e. random data of high quality. To keep the
		400	protocol text-only, these are usually 32 base64-encoded octets, but
		401	it could be anything that doesn't contain any ASCII CR or ASCII LF
		402	characters.
		403
		404	Example 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
		411	If, after the handshake, both sides indicate interest in TLS, then the
		412	connection I<must> use TLS, or fail.
		413
		414	Both sides compare their nonces, and the side who sent the lower nonce
		415	value ("string" comparison on the raw octet values) becomes the client,
		416	and the one with the higher nonce the server.
		417
		418	=head2 AUTHENTICATION PHASE
		419
		420	After the greeting is received (and the optional TLS handshake),
		421	the authentication phase begins, which consists of sending a single
		422	C<;>-separated line with three fixed strings and any number of
		423	C<KEY=VALUE> pairs.
		424
		425	The three fixed strings are:
		426
		427	=over 4
		428
		429	=item the authentication method chosen
		430
		431	This must be one of the methods offered by the other side in the greeting.
		432
		433	=item the authentication data
		434
		435	The authentication data itself, usually base64 or hex-encoded data.
		436
		437	=item the framing protocol chosen
		438
		439	This must be one of the framing protocols offered by the other side in the
		440	greeting. Each side must accept the choice of the other side.
		441
		442	=back
		443
		444	Example (the actual reply matching the previous example):
		445
		446	hmac_md6_64_256;wIlLedBY956UCGSISG9mBZRDTG8xUi73/sVse2DSQp0;json
		447
		448	=head2 DATA PHASE
		449
		450	After this, packets get exchanged using the chosen framing protocol. It is
		451	quite possible that both sides use a different framing protocol.
		452
279	=head1 SEE ALSO	453	=head1 SEE ALSO
280		454
281	L<AnyEvent>.	455	L<AnyEvent>.
282		456
283	=head1 AUTHOR	457	=head1 AUTHOR

Diff Legend

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

Comparing AnyEvent-MP/MP/Transport.pm (file contents): Revision 1.6 by root, Sun Aug 2 14:52:41 2009 UTC vs. Revision 1.11 by root, Mon Aug 3 15:40:53 2009 UTC

Diff Legend

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.6 by root, Sun Aug 2 14:52:41 2009 UTC vs.
Revision 1.11 by root, Mon Aug 3 15:40:53 2009 UTC