[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.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
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(cleartext)); # 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
137	fh => delete $arg{fh},	145	fh => delete $arg{fh},
138	rbuf_max => 64 * 1024,
139	autocork => 1,	146	autocork => 1,
140	no_delay => 1,	147	no_delay => 1,
141	on_error => sub {	148	on_error => sub {
142	$self->error ($_[2]);	149	$self->error ($_[2]);
143	},	150	},
144	peername => delete $arg{peername},	151	peername => delete $arg{peername},
145	;	152	;
146		153
147	my $secret = $arg{secret};	154	my $secret = $arg{secret};
148	my $greeting_kv = $self->{greeting} \|\|= {};	155	my $greeting_kv = $self->{greeting} \|\|= {};
149	$greeting_kv->{"tls1.0"} \|\|= $arg{tls}	156	$greeting_kv->{"tls"} = "1.0"
150	if exists $arg{tls} && $arg{tls_ctx};	157	if $arg{tls_ctx};
151	$greeting_kv->{provider} = "AE-$VERSION";	158	$greeting_kv->{provider} = "AE-$VERSION";
		159	$greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
152		160
153	# send greeting	161	# send greeting
154	my $lgreeting = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min	162	my $lgreeting1 = "aemp;$PROTOCOL_VERSION"
155	. ";$AnyEvent::MP::Base::UNIQ"	163	. ";$AnyEvent::MP::Base::UNIQ"
156	. ";$AnyEvent::MP::Base::NODE"	164	. ";$AnyEvent::MP::Base::NODE"
157	. ";" . (MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "")	165	. ";" . (join ",", @AUTH_RCV)
158	. ";hmac_md6_64_256" # hardcoded atm.	166	. ";" . (join ",", @FRAMINGS)
159	. ";json" # hardcoded atm.
160	. ";$self->{peerhost};$self->{peerport}"
161	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);	167	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
162		168
		169	my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
		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
		174	$self->{hdl}->rbuf_max (4 * 1024);
166	$self->{hdl}->push_read (line => sub {	175	$self->{hdl}->push_read (line => sub {
167	my $rgreeting = $_[1];	176	my $rgreeting1 = $_[1];
168		177
169	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;
170		179
171	if ($aemp ne "aemp") {	180	if ($aemp ne "aemp") {
172	return $self->error ("unparsable greeting");	181	return $self->error ("unparsable greeting");
173	} elsif ($version_min > $PROTOCOL_VERSION) {	182	} elsif ($version != $PROTOCOL_VERSION) {
174	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)");	183	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $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	}	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");
180		209
181	$self->{remote_uniq} = $uniq;	210	$self->{remote_uniq} = $uniq;
182	$self->{remote_node} = $rnode;	211	$self->{remote_node} = $rnode;
183		212
184	$self->{remote_greeting} = {	213	$self->{remote_greeting} = {
185	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),	214	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
186	@kv	215	@kv
187	};	216	};
188		217
189	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
190	if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {	222	if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
191	return $self->error ("TLS server/client mismatch");	223	$self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
		224	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
192	}	225	}
193	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
194	}	226
195
196	# auth	227	# auth
197	require Digest::MD6;	228	require Digest::MD6;
198	require Digest::HMAC_MD6;	229	require Digest::HMAC_MD6;
199		230
200	my $key = Digest::MD6::md6_hex ($secret);	231	my $key = Digest::MD6::md6 ($secret);
201	my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting\012$rgreeting", 64, 256);	232	my $lauth = Digest::HMAC_MD6::hmac_md6_hex ($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		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
204	$lauth ne $rauth # echo attack?	239	$lauth ne $rauth # echo attack?
205	or return $self->error ("authentication error");	240	or return $self->error ("authentication error");
206		241
207	$self->{hdl}->push_write ("$auth;$lauth;$framing\012");	242	$self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
208		243
209	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so	244	# reasd the authentication response
210	$self->{hdl}->push_read (line => sub {	245	$self->{hdl}->push_read (line => sub {
211	my ($hdl, $rline) = @_;	246	my ($hdl, $rline) = @_;
212		247
213	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;	248	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
214		249
215	if ($rauth2 ne $rauth) {	250	if ($rauth2 ne $rauth) {
216	return $self->error ("authentication failure/shared secret mismatch");	251	return $self->error ("authentication failure/shared secret mismatch");
217	}	252	}
218		253
219	$self->{s_framing} = "json";#d#	254	$self->{s_framing} = $s_framing;
220		255
221	$hdl->rbuf_max (undef);	256	$hdl->rbuf_max (undef);
222	my $queue = delete $self->{queue}; # we are connected	257	my $queue = delete $self->{queue}; # we are connected
223		258
224	$self->connected;	259	$self->connected;
225		260
		261	my $src_node = $self->{node};
		262
226	$hdl->push_write ($self->{s_framing} => $_)	263	$hdl->push_write ($self->{s_framing} => $_)
227	for @$queue;	264	for @$queue;
228		265
229	my $rmsg; $rmsg = sub {	266	my $rmsg; $rmsg = sub {
230	$_[0]->push_read ($r_framing => $rmsg);	267	$_[0]->push_read ($r_framing => $rmsg);
231		268
		269	local $AnyEvent::MP::Base::SRCNODE = $src_node;
232	AnyEvent::MP::Base::_inject ($_[1]);	270	AnyEvent::MP::Base::_inject (@{ $_[1] });
233	};	271	};
234	$hdl->push_read ($r_framing => $rmsg);	272	$hdl->push_read ($r_framing => $rmsg);
		273	});
235	});	274	});
236	});	275	});
237	}	276	}
238		277
239	$self	278	$self
…		…
243	my ($self, $msg) = @_;	282	my ($self, $msg) = @_;
244		283
245	if ($self->{node} && $self->{node}{transport} == $self) {	284	if ($self->{node} && $self->{node}{transport} == $self) {
246	$self->{node}->clr_transport;	285	$self->{node}->clr_transport;
247	}	286	}
248	# $self->{on_error}($self, $msg);	287	$AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
249	$self->destroy;	288	$self->destroy;
250	}	289	}
251		290
252	sub connected {	291	sub connected {
253	my ($self) = @_;	292	my ($self) = @_;
…		…
274	$self->destroy;	313	$self->destroy;
275	}	314	}
276		315
277	=back	316	=back
278		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
279	=head1 SEE ALSO	494	=head1 SEE ALSO
280		495
281	L<AnyEvent>.	496	L<AnyEvent>.
282		497
283	=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.6 by root, Sun Aug 2 14:52:41 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.6 by root, Sun Aug 2 14:52:41 2009 UTC vs.
Revision 1.13 by root, Mon Aug 3 22:05:55 2009 UTC