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

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