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

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