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

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.5 by root, Sun Aug 2 14:44:37 2009 UTC vs.
Revision 1.10 by root, Mon Aug 3 15:02:42 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} \|\|= "connect";
132	$arg{tls_ctx} \|\|= { sslv2 => 0, sslv3 => 0, tlsv1 => 1, verify => 1 };	131	#$arg{tls_ctx} \|\|= { sslv2 => 0, sslv3 => 0, tlsv1 => 1, verify => 1 };
133	}
134		132
135	$arg{secret} = AnyEvent::MP::Base::default_secret ()	133	$arg{secret} = AnyEvent::MP::Base::default_secret ()
136	unless exists $arg{secret};	134	unless exists $arg{secret};
137		135
138	$self->{hdl} = new AnyEvent::Handle	136	$self->{hdl} = new AnyEvent::Handle
…		…
146	peername => delete $arg{peername},	144	peername => delete $arg{peername},
147	;	145	;
148		146
149	my $secret = $arg{secret};	147	my $secret = $arg{secret};
150	my $greeting_kv = $self->{greeting} \|\|= {};	148	my $greeting_kv = $self->{greeting} \|\|= {};
151	$greeting_kv->{"tls1.0"} \|\|= $arg{tls}	149	$greeting_kv->{"tls"} = "1.0"
152	if exists $arg{tls} && $arg{tls_ctx};	150	if $arg{tls_ctx};
153	$greeting_kv->{provider} = "AE-$VERSION";	151	$greeting_kv->{provider} = "AE-$VERSION";
		152	$greeting_kv->{peeraddr} = AnyEvent::Socket::format_hostport $self->{peerhost}, $self->{peerport};
154		153
155	# send greeting	154	# send greeting
156	my $lgreeting = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min	155	my $lgreeting1 = "aemp;$PROTOCOL_VERSION;$PROTOCOL_VERSION" # version, min
157	. ";$AnyEvent::MP::Base::UNIQ"	156	. ";$AnyEvent::MP::Base::UNIQ"
158	. ";$AnyEvent::MP::Base::NODE"	157	. ";$AnyEvent::MP::Base::NODE"
159	. ";" . (MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "")	158	. ";" . (join ",", @AUTH_RCV)
160	. ";hmac_md6_64_256" # hardcoded atm.	159	. ";" . (join ",", @FRAMINGS)
161	. ";json" # hardcoded atm.
162	. ";$self->{peerhost};$self->{peerport}"
163	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);	160	. (join "", map ";$_=$greeting_kv->{$_}", keys %$greeting_kv);
		161	my $lgreeting2 = MIME::Base64::encode_base64 AnyEvent::MP::Base::nonce (33), "";
164		162
165	$self->{hdl}->push_write ("$lgreeting\012");	163	$self->{hdl}->push_write ("$lgreeting1\012$lgreeting2\012");
166		164
167	# expect greeting	165	# expect greeting
168	$self->{hdl}->push_read (line => sub {	166	$self->{hdl}->push_read (line => sub {
169	my $rgreeting = $_[1];	167	my $rgreeting1 = $_[1];
170		168
171	my ($aemp, $version, $version_min, $uniq, $rnode, undef, $auth, $framing, $peerport, $peerhost, @kv) = split /;/, $rgreeting;	169	my ($aemp, $version, $version_min, $uniq, $rnode, $auths, $framings, @kv) = split /;/, $rgreeting1;
172		170
173	if ($aemp ne "aemp") {	171	if ($aemp ne "aemp") {
174	return $self->error ("unparsable greeting");	172	return $self->error ("unparsable greeting");
175	} elsif ($version_min > $PROTOCOL_VERSION) {	173	} elsif ($version_min > $PROTOCOL_VERSION) {
176	return $self->error ("version mismatch (we: $PROTOCOL_VERSION, they: $version_min .. $version)");	174	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	}	175	}
		176
		177	my $s_auth;
		178	for my $auth_ (split /,/, $auths) {
		179	if (grep $auth_ eq $_, @AUTH_SND) {
		180	$s_auth = $auth_;
		181	last;
		182	}
		183	}
		184
		185	defined $s_auth
		186	or return $self->error ("$auths: no common auth type supported");
		187
		188	die unless $s_auth eq "hmac_md6_64_256"; # hardcoded atm.
		189
		190	my $s_framing;
		191	for my $framing_ (split /,/, $framings) {
		192	if (grep $framing_ eq $_, @FRAMINGS) {
		193	$s_framing = $framing_;
		194	last;
		195	}
		196	}
		197
		198	defined $s_framing
		199	or return $self->error ("$framings: no common framing method supported");
182		200
183	$self->{remote_uniq} = $uniq;	201	$self->{remote_uniq} = $uniq;
184	$self->{remote_node} = $rnode;	202	$self->{remote_node} = $rnode;
185		203
186	$self->{remote_greeting} = {	204	$self->{remote_greeting} = {
187	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),	205	map /^([^=]+)(?:=(.*))?/ ? ($1 => $2) : (),
188	@kv	206	@kv
189	};	207	};
190		208
191	if (exists $self->{tls} and $self->{tls_ctx} and exists $self->{remote_greeting}{"tls1.0"}) {	209	# read nonce
		210	$self->{hdl}->push_read (line => sub {
		211	my $rgreeting2 = $_[1];
		212
192	if ($self->{tls} ne $self->{remote_greeting}{"tls1.0"}) {	213	if ($self->{tls_ctx} and 1 == int $self->{remote_greeting}{tls}) {
193	return $self->error ("TLS server/client mismatch");	214	$self->{tls} = $lgreeting2 lt $rgreeting2 ? "connect" : "accept";
		215	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
194	}	216	}
195	$self->{hdl}->starttls ($self->{tls}, $self->{tls_ctx});
196	}	217
197
198	# auth	218	# auth
199	require Digest::MD6;	219	require Digest::MD6;
200	require Digest::HMAC_MD6;	220	require Digest::HMAC_MD6;
201		221
202	my $key = Digest::MD6::md6_hex ($secret);	222	my $key = Digest::MD6::md6_hex ($secret);
203	my $lauth = Digest::HMAC_MD6::hmac_md6_base64 ($key, "$lgreeting\012$rgreeting", 64, 256);	223	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		224
		225	my $rauth =
		226	$s_auth eq "hmac_md6_64_256" ? Digest::HMAC_MD6::hmac_md6_base64 ($key, "$rgreeting1\012$rgreeting2\012$lgreeting1\012$lgreeting2\012", 64, 256)
		227	: $s_auth eq "hex_secret" ? unpack "H*", $secret
		228	: die;
		229
206	$lauth ne $rauth # echo attack?	230	$lauth ne $rauth # echo attack?
207	or return $self->error ("authentication error");	231	or return $self->error ("authentication error");
208		232
209	$self->{hdl}->push_write ("$auth;$lauth;$framing\012");	233	$self->{hdl}->push_write ("$s_auth;$lauth;$s_framing\012");
210		234
211	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so	235	$self->{hdl}->rbuf_max (64); # enough for 44 reply bytes or so
212	$self->{hdl}->push_read (line => sub {	236	$self->{hdl}->push_read (line => sub {
213	my ($hdl, $rline) = @_;	237	my ($hdl, $rline) = @_;
214		238
215	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;	239	my ($auth_method, $rauth2, $r_framing) = split /;/, $rline;
216		240
217	if ($rauth2 ne $rauth) {	241	if ($rauth2 ne $rauth) {
218	return $self->error ("authentication failure/shared secret mismatch");	242	return $self->error ("authentication failure/shared secret mismatch");
219	}	243	}
220		244
221	$self->{s_framing} = "json";#d#	245	$self->{s_framing} = $s_framing;
222		246
223	$hdl->rbuf_max (undef);	247	$hdl->rbuf_max (undef);
224	my $queue = delete $self->{queue}; # we are connected	248	my $queue = delete $self->{queue}; # we are connected
225		249
226	$self->connected;	250	$self->connected;
227		251
228	$hdl->push_write ($self->{s_framing} => $_)	252	$hdl->push_write ($self->{s_framing} => $_)
229	for @$queue;	253	for @$queue;
230		254
231	my $rmsg; $rmsg = sub {	255	my $rmsg; $rmsg = sub {
232	$_[0]->push_read ($r_framing => $rmsg);	256	$_[0]->push_read ($r_framing => $rmsg);
233		257
234	AnyEvent::MP::Base::_inject ($_[1]);	258	AnyEvent::MP::Base::_inject ($_[1]);
235	};	259	};
236	$hdl->push_read ($r_framing => $rmsg);	260	$hdl->push_read ($r_framing => $rmsg);
		261	});
237	});	262	});
238	});	263	});
239	}	264	}
240		265
241	$self	266	$self
…		…
245	my ($self, $msg) = @_;	270	my ($self, $msg) = @_;
246		271
247	if ($self->{node} && $self->{node}{transport} == $self) {	272	if ($self->{node} && $self->{node}{transport} == $self) {
248	$self->{node}->clr_transport;	273	$self->{node}->clr_transport;
249	}	274	}
250	# $self->{on_error}($self, $msg);	275	$AnyEvent::MP::Base::WARN->("$self->{peerhost}:$self->{peerport}: $msg");
251	$self->destroy;	276	$self->destroy;
252	}	277	}
253		278
254	sub connected {	279	sub connected {
255	my ($self) = @_;	280	my ($self) = @_;
…		…
276	$self->destroy;	301	$self->destroy;
277	}	302	}
278		303
279	=back	304	=back
280		305
		306	=head1 PROTOCOL
		307
		308	The protocol is relatively simple, and consists of three phases which are
		309	symmetrical for both sides: greeting (followed by optionally switching to
		310	TLS mode), authentication and packet exchange.
		311
		312	the protocol is designed to allow both full-text and binary streams.
		313
		314	The greeting consists of two text lines that are ended by either an ASCII
		315	CR LF pair, or a single ASCII LF (recommended).
		316
		317	=head2 GREETING
		318
		319	The first line contains strings separated (not ended) by C<;>
		320	characters. The first seven strings are fixed by the protocol, the
		321	remaining strings are C<KEY=VALUE> pairs. None of them may contain C<;>
		322	characters themselves.
		323
		324	The seven fixed strings are:
		325
		326	=over 4
		327
		328	=item C<aemp>
		329
		330	The constant C<aemp> to identify the protocol.
		331
		332	=item protocol version
		333
		334	The (maximum) protocol version supported by this end, currently C<0>.
		335
		336	=item minimum protocol version
		337
		338	The minimum protocol version supported by this end, currently C<0>.
		339
		340	=item a token uniquely identifying the current node instance
		341
		342	This is a string that must change between restarts. It usually contains
		343	things like the current time, the (OS) process id or similar values, but
		344	no meaning of the contents are assumed.
		345
		346	=item the node endpoint descriptors
		347
		348	for public nodes, this is a comma-separated list of protocol endpoints,
		349	i.e., the noderef. For slave nodes, this is a unique identifier.
		350
		351	=item the acceptable authentication methods
		352
		353	A comma-separated list of authentication methods supported by the
		354	node. Note that AnyEvent::MP supports a C<hex_secret> authentication
		355	method that accepts a cleartext password (hex-encoded), but will not use
		356	this auth method itself.
		357
		358	The receiving side should choose the first auth method it supports.
		359
		360	=item the acceptable framing formats
		361
		362	A comma-separated list of packet encoding/framign formats understood. The
		363	receiving side should choose the first framing format it supports for
		364	sending packets (which might be different from the format it has to accept).
		365
		366	=back
		367
		368	The remaining arguments are C<KEY=VALUE> pairs. The following key-value
		369	pairs are known at this time:
		370
		371	=over 4
		372
		373	=item provider=<module-version>
		374
		375	The software provider for this implementation. For AnyEvent::MP, this is
		376	C<AE-0.0> or whatever version it currently is at.
		377
		378	=item peeraddr=<host>:<port>
		379
		380	The peer address (socket address of the other side) as seen locally, in the same format
		381	as noderef endpoints.
		382
		383	=item tls=<major>.<minor>
		384
		385	Indicates that the other side supports TLS (version should be 1.0) and
		386	wishes to do a TLS handshake.
		387
		388	=back
		389
		390	After this greeting line there will be a second line containing a
		391	cryptographic nonce, i.e. random data of high quality. To keep the
		392	protocol text-only, these are usually 32 base64-encoded octets, but
		393	it could be anything that doesn't contain any ASCII CR or ASCII LF
		394	characters.
		395
		396	Example of the two lines of greeting:
		397
		398	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
		399	XntegV2Guvss0qNn7phCPnoU87xqxV+4Mqm/5y4iQm6a
		400
		401	=head2 TLS handshake
		402
		403	If, after the handshake, both sides indicate interest in TLS, then the
		404	connection I<must> use TLS, or fail.
		405
		406	Both sides compare their nonces, and the side who sent the lower nonce
		407	value ("string" comparison on the raw octet values) becomes the client,
		408	and the one with the higher nonce the server.
		409
		410	=head2 AUTHENTICATION PHASE
		411
		412	After the greeting is received (and the optional TLS handshake),
		413	the authentication phase begins, which consists of sending a single
		414	C<;>-separated line with three fixed strings and any number of
		415	C<KEY=VALUE> pairs.
		416
		417	The three fixed strings are:
		418
		419	=over 4
		420
		421	=item the authentication method chosen
		422
		423	This must be one of the methods offered by the other side in the greeting.
		424
		425	=item the authentication data
		426
		427	The authentication data itself, usually base64 or hex-encoded data.
		428
		429	=item the framing protocol chosen
		430
		431	This must be one of the framing protocols offered by the other side in the
		432	greeting. Each side must accept the choice of the other side.
		433
		434	=back
		435
		436	Example (the actual reply matching the previous example):
		437
		438	hmac_md6_64_256;wIlLedBY956UCGSISG9mBZRDTG8xUi73/sVse2DSQp0;json
		439
		440	=head2 DATA PHASE
		441
		442	After this, packets get exchanged using the chosen framing protocol. It is
		443	quite possible that both sides use a different framing protocol.
		444
281	=head1 SEE ALSO	445	=head1 SEE ALSO
282		446
283	L<AnyEvent>.	447	L<AnyEvent>.
284		448
285	=head1 AUTHOR	449	=head1 AUTHOR

Diff Legend

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

Comparing AnyEvent-MP/MP/Transport.pm (file contents): Revision 1.5 by root, Sun Aug 2 14:44:37 2009 UTC vs. Revision 1.10 by root, Mon Aug 3 15:02:42 2009 UTC

Diff Legend

Comparing AnyEvent-MP/MP/Transport.pm (file contents):
Revision 1.5 by root, Sun Aug 2 14:44:37 2009 UTC vs.
Revision 1.10 by root, Mon Aug 3 15:02:42 2009 UTC