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

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.2 by root, Fri Jul 31 20:55:46 2009 UTC vs.
Revision 1.13 by root, Mon Aug 3 22:05:55 2009 UTC

…		…
1	=head1 NAME	1	=head1 NAME
2		2
3	AnyEvent::MP::Transport - actual transport protocol	3	AnyEvent::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
11	This is the superclass for MP transports, most of which is considered an	11	This implements the actual transport protocol for MP (it represents a
12	implementation detail.	12	single link), most of which is considered an 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
30		31
31	use AE ();	32	use AE ();
32	use AnyEvent::Socket ();	33	use AnyEvent::Socket ();
33	use AnyEvent::Handle ();	34	use AnyEvent::Handle ();
34		35
35	use AnyEvent::MP::Util ();
36
37	use base Exporter::;	36	use base Exporter::;
38		37
39	our $VERSION = '0.0';	38	our $VERSION = '0.0';
40	our $PROTOCOL_VERSION = 0;	39	our $PROTOCOL_VERSION = 0;
41		40
…		…
44	Creates a listener on the given host/port using	43	Creates a listener on the given host/port using
45	C<AnyEvent::Socket::tcp_server>.	44	C<AnyEvent::Socket::tcp_server>.
46		45
47	See C<new>, below, for constructor arguments.	46	See C<new>, below, for constructor arguments.
48		47
49	Defaults for peerhost, peerport, fh and tls are provided.	48	Defaults for peerhost, peerport and fh are provided.
50		49
51	=cut	50	=cut
52		51
53	sub mp_server($$@) {	52	sub 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
		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(cleartext)); # auth types we accept
		117
		118	#AnyEvent::Handle::register_write_type mp_record => sub {
		119	#};
		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;
122		125
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::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
137	fh => delete $arg{fh},	145	fh => delete $arg{fh},
138	rbuf_max => 64 * 1024,	146	autocork => 1,
		147	no_delay => 1,
139	on_error => sub {	148	on_error => sub {
140	$self->error ($_[2]);	149	$self->error ($_[2]);
141	},	150	},
142	peername => delete $arg{peername},	151	peername => delete $arg{peername},
143	;	152	;
144		153
145	my $secret = $arg{secret};	154	my $secret = $arg{secret};
146	my $greeting_kv = $self->{greeting} \|\|= {};	155	my $greeting_kv = $self->{greeting} \|\|= {};
147	$greeting_kv->{"tls1.0"} \|\|= $arg{tls}	156	$greeting_kv->{"tls"} = "1.0"
148	if exists $arg{tls} && $arg{tls_ctx};	157	if $arg{tls_ctx};
149	$greeting_kv->{provider} = "AE-$VERSION";	158	$greeting_kv->{provider} = "AE-$VERSION";
		159	$greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
150		160
151	# send greeting	161	# send greeting
152	my $lgreeting = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min	162	my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
153	. ";$AnyEvent::MP::UNIQ"	163	. ";$AnyEvent::MP::Base::UNIQ"
154	. ";$AnyEvent::MP::NODE"	164	. ";$AnyEvent::MP::Base::NODE"
155	. ";" . (MIME::Base64::encode_base64 AnyEvent::MP::Util::nonce 33, "")	165	. ";" . (join ",", @AUTH_RCV)
156	. ";hmac_md6_64_256" # hardcoded atm.	166	. ";" . (join ",", @FRAMINGS)
157	. ";json" # hardcoded atm.
158	. ";$self->{peerhost};$self->{peerport}"
159	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);	167	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
160		168
		169	my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
		170
161	$self->{hdl}->push_write ("$lgreeting\012");	171	$self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
162		172
163	# expect greeting	173	# expect greeting
		174	$self->{hdl}->rbuf_max (4 * 1024);
164	$self->{hdl}->push_read (line => sub {	175	$self->{hdl}->push_read (line => sub {
165	my $rgreeting = $_[1];	176	my $rgreeting1 = $_[1];
166		177
167	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;
168		179
169	if ($aemp ne "aemp") {	180	if ($aemp ne "aemp") {
170	return $self->error ("unparsable greeting");	181	return $self->error ("unparsable greeting");
171	} elsif ($version_min > $PROTOCOL_VERSION) {	182	} elsif ($version != $PROTOCOL_VERSION) {
172	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)");	183	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version)");
173	} elsif ($auth ne "hmac_md6_64_256") {
174	return $self->error ("unsupported auth method ($auth)");
175	} elsif ($framing ne "json") {
176	return $self->error ("unsupported framing method ($auth)");
177	}	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");
178		209
179	$self->{remote_uniq} = $uniq;	210	$self->{remote_uniq} = $uniq;
180	$self->{remote_node} = $rnode;	211	$self->{remote_node} = $rnode;
181		212
182	$self->{remote_greeting} = {	213	$self->{remote_greeting} = {
183	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),	214	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
184	@kv	215	@kv
185	};	216	};
186		217
187	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
188	if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {	222	if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
189	return $self->error ("TLS server/client mismatch");	223	$self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
		224	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
190	}	225	}
191	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
192	}	226
193
194	# auth	227	# auth
195	require Digest::MD6;	228	require Digest::MD6;
196	require Digest::HMAC_MD6;	229	require Digest::HMAC_MD6;
197		230
198	my $key = Digest::MD6::md6_hex ($secret);	231	my $key = Digest::MD6::md6 ($secret);
199	my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting$rgreeting", 64, 256);	232	my $lauth = Digest::HMAC_MD6::hmac_md6_hex ($key, "$lgreeting1\012$lgreeting2\012$rgreeting1\012$rgreeting2\012", 64, 256);
200	my $rauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting$lgreeting", 64, 256);
201		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
202	$lauth ne $rauth # echo attack?	239	$lauth ne $rauth # echo attack?
203	or return $self->error ("authentication error");	240	or return $self->error ("authentication error");
204		241
205	$self->{hdl}->push_write ("$auth;$lauth;$framing\012");	242	$self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
206		243
207	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so	244	# reasd the authentication response
208	$self->{hdl}->push_read (line => sub {	245	$self->{hdl}->push_read (line => sub {
209	my ($hdl, $rline) = @_;	246	my ($hdl, $rline) = @_;
210		247
211	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;	248	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
212		249
213	if ($rauth2 ne $rauth) {	250	if ($rauth2 ne $rauth) {
214	return $self->error ("authentication failure/shared secret mismatch");	251	return $self->error ("authentication failure/shared secret mismatch");
215	}	252	}
216		253
217	$self->{s_framing} = "json";#d#	254	$self->{s_framing} = $s_framing;
218		255
219	$hdl->rbuf_max (undef);	256	$hdl->rbuf_max (undef);
220	my $queue = delete $self->{queue}; # we are connected	257	my $queue = delete $self->{queue}; # we are connected
221		258
222	$self->connected;	259	$self->connected;
223		260
		261	my $src_node = $self->{node};
		262
224	$hdl->push_write ($self->{s_framing} => $_)	263	$hdl->push_write ($self->{s_framing} => $_)
225	for @$queue;	264	for @$queue;
226		265
227	my $rmsg; $rmsg = sub {	266	my $rmsg; $rmsg = sub {
228	$_[0]->push_read ($r_framing => $rmsg);	267	$_[0]->push_read ($r_framing => $rmsg);
229		268
		269	local $AnyEvent::MP::Base::SRCNODE = $src_node;
230	AnyEvent::MP::_inject ($_[1]);	270	AnyEvent::MP::Base::_inject (@{ $_[1] });
231	};	271	};
232	$hdl->push_read ($r_framing => $rmsg);	272	$hdl->push_read ($r_framing => $rmsg);
		273	});
233	});	274	});
234	});	275	});
235	}	276	}
236		277
237	$self	278	$self
238	}	279	}
239		280
240	sub error {	281	sub error {
241	my ($self, $msg) = @_;	282	my ($self, $msg) = @_;
242		283
243	$self->{on_error}($self, $msg);	284	if ($self->{node} && $self->{node}{transport} == $self) {
		285	$self->{node}->clr_transport;
		286	}
		287	$AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
244	$self->{hdl}->destroy;	288	$self->destroy;
245	}	289	}
246		290
247	sub connected {	291	sub connected {
248	my ($self) = @_;	292	my ($self) = @_;
249		293
250	(AnyEvent::MP::add_node ($self->{remote_node}))	294	my $node = AnyEvent::MP::Base::add_node ($self->{remote_node});
		295	Scalar::Util::weaken ($self->{node} = $node);
251	->set_transport ($self);	296	$node->set_transport ($self);
252	}	297	}
253		298
254	sub send {	299	sub send {
255	$_[0]{hdl}->push_write ($_[0]{s_framing} => $_[1]);	300	$_[0]{hdl}->push_write ($_[0]{s_framing} => $_[1]);
256	}	301	}
…		…
268	$self->destroy;	313	$self->destroy;
269	}	314	}
270		315
271	=back	316	=back
272		317
		318	=head1 PROTOCOL
		319
		320	The protocol is relatively simple, and consists of three phases which are
		321	symmetrical for both sides: greeting (followed by optionally switching to
		322	TLS mode), authentication and packet exchange.
		323
		324	the protocol is designed to allow both full-text and binary streams.
		325
		326	The greeting consists of two text lines that are ended by either an ASCII
		327	CR LF pair, or a single ASCII LF (recommended).
		328
		329	=head2 GREETING
		330
		331	The first line contains strings separated (not ended) by C<;>
		332	characters. The first even ixtrings are fixed by the protocol, the
		333	remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
		334	characters themselves.
		335
		336	All the lines until after authentication must not exceed 4kb in length, including delimiter.
		337
		338	The fixed strings are:
		339
		340	=over 4
		341
		342	=item C<aemp>
		343
		344	The constant C<aemp> to identify the protocol.
		345
		346	=item protocol version
		347
		348	The protocol version supported by this end, currently C<0>. If the
		349	versions don't match then no communication is possible. Minor extensions
		350	are supposed to be handled by addign additional key-value pairs.
		351
		352	=item a token uniquely identifying the current node instance
		353
		354	This is a string that must change between restarts. It usually contains
		355	things like the current time, the (OS) process id or similar values, but
		356	no meaning of the contents are assumed.
		357
		358	=item the node endpoint descriptors
		359
		360	for public nodes, this is a comma-separated list of protocol endpoints,
		361	i.e., the noderef. For slave nodes, this is a unique identifier.
		362
		363	=item the acceptable authentication methods
		364
		365	A comma-separated list of authentication methods supported by the
		366	node. Note that AnyEvent::MP supports a C<hex_secret> authentication
		367	method that accepts a cleartext password (hex-encoded), but will not use
		368	this auth method itself.
		369
		370	The receiving side should choose the first auth method it supports.
		371
		372	=item the acceptable framing formats
		373
		374	A comma-separated list of packet encoding/framign formats understood. The
		375	receiving side should choose the first framing format it supports for
		376	sending packets (which might be different from the format it has to accept).
		377
		378	=back
		379
		380	The remaining arguments are C<KEY=VALUE> pairs. The following key-value
		381	pairs are known at this time:
		382
		383	=over 4
		384
		385	=item provider=<module-version>
		386
		387	The software provider for this implementation. For AnyEvent::MP, this is
		388	C<AE-0.0> or whatever version it currently is at.
		389
		390	=item peeraddr=<host>:<port>
		391
		392	The peer address (socket address of the other side) as seen locally, in the same format
		393	as noderef endpoints.
		394
		395	=item tls=<major>.<minor>
		396
		397	Indicates that the other side supports TLS (version should be 1.0) and
		398	wishes to do a TLS handshake.
		399
		400	=back
		401
		402	After this greeting line there will be a second line containing a
		403	cryptographic nonce, i.e. random data of high quality. To keep the
		404	protocol text-only, these are usually 32 base64-encoded octets, but
		405	it could be anything that doesn't contain any ASCII CR or ASCII LF
		406	characters.
		407
		408	Example of the two lines of greeting:
		409
		410	aemp;0;fec.4a7720fc;127.0.0.1:1235,[::1]:1235;hmac_md6_64_256;json,storable;provider=AE-0.0
		411	p/I122ql7kJR8lumW3lXlXCeBnyDAvz8NQo3x5IFowE4
		412
		413	=head2 TLS handshake
		414
		415	If, after the handshake, both sides indicate interest in TLS, then the
		416	connection I<must> use TLS, or fail.
		417
		418	Both sides compare their nonces, and the side who sent the lower nonce
		419	value ("string" comparison on the raw octet values) becomes the client,
		420	and the one with the higher nonce the server.
		421
		422	=head2 AUTHENTICATION PHASE
		423
		424	After the greeting is received (and the optional TLS handshake),
		425	the authentication phase begins, which consists of sending a single
		426	C<;>-separated line with three fixed strings and any number of
		427	C<KEY=VALUE> pairs.
		428
		429	The three fixed strings are:
		430
		431	=over 4
		432
		433	=item the authentication method chosen
		434
		435	This must be one of the methods offered by the other side in the greeting.
		436
		437	The currently supported authentication methods are:
		438
		439	=over 4
		440
		441	=item cleartext
		442
		443	This is simply the shared secret, lowercase-hex-encoded. This method is of
		444	course very insecure, unless TLS is used, which is why this module will
		445	accept, but not generate, cleartext auth replies.
		446
		447	=item hmac_md6_64_256
		448
		449	This method uses an MD6 HMAC with 64 bit blocksize and 256 bit hash. First, the shared secret
		450	is hashed with MD6:
		451
		452	key = MD6 (secret)
		453
		454	This secret is then used to generate the "local auth reply", by taking
		455	the two local greeting lines and the two remote greeting lines (without
		456	line endings), appending \012 to all of them, concatenating them and
		457	calculating the MD6 HMAC with the key.
		458
		459	lauth = HMAC_MD6 key, "lgreeting1\012lgreeting2\012rgreeting1\012rgreeting2\012"
		460
		461	This authentication token is then lowercase-hex-encoded and sent to the
		462	other side.
		463
		464	Then the remote auth reply is generated using the same method, but local
		465	and remote greeting lines swapped:
		466
		467	rauth = HMAC_MD6 key, "rgreeting1\012rgreeting2\012lgreeting1\012lgreeting2\012"
		468
		469	This is the token that is expected from the other side.
		470
		471	=back
		472
		473	=item the authentication data
		474
		475	The authentication data itself, usually base64 or hex-encoded data, see
		476	above.
		477
		478	=item the framing protocol chosen
		479
		480	This must be one of the framing protocols offered by the other side in the
		481	greeting. Each side must accept the choice of the other side.
		482
		483	=back
		484
		485	Example:
		486
		487	hmac_md6_64_256;363d5175df38bd9eaddd3f6ca18aa1c0c4aa22f0da245ac638d048398c26b8d3;json
		488
		489	=head2 DATA PHASE
		490
		491	After this, packets get exchanged using the chosen framing protocol. It is
		492	quite possible that both sides use a different framing protocol.
		493
273	=head1 SEE ALSO	494	=head1 SEE ALSO
274		495
275	L<AnyEvent>.	496	L<AnyEvent>.
276		497
277	=head1 AUTHOR	498	=head1 AUTHOR

Diff Legend

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

Comparing AnyEvent-MP/MP/Transport.pm (file contents): Revision 1.2 by root, Fri Jul 31 20:55:46 2009 UTC vs. Revision 1.13 by root, Mon Aug 3 22:05:55 2009 UTC

Diff Legend

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.2 by root, Fri Jul 31 20:55:46 2009 UTC vs.
Revision 1.13 by root, Mon Aug 3 22:05:55 2009 UTC