[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Socket.pm

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC vs.
Revision 1.111 by elmex, Mon Aug 10 13:36:00 2009 UTC

…		…
2		2
3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.	3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use AnyEvent::Socket;	7	use AnyEvent::Socket;
8		8
9	tcp_connect "gameserver.deliantra.net", 13327, sub {	9	tcp_connect "gameserver.deliantra.net", 13327, sub {
10	my ($fh) = @_	10	my ($fh) = @_
11	or die "gameserver.deliantra.net connect failed: $!";	11	or die "gameserver.deliantra.net connect failed: $!";
12		12
13	# enjoy your filehandle	13	# enjoy your filehandle
14	};	14	};
15		15
16	# a simple tcp server	16	# a simple tcp server
17	tcp_server undef, 8888, sub {	17	tcp_server undef, 8888, sub {
18	my ($fh, $host, $port) = @_;	18	my ($fh, $host, $port) = @_;
19		19
20	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	20	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
21	};	21	};
22		22
23	=head1 DESCRIPTION	23	=head1 DESCRIPTION
24		24
25	This module implements various utility functions for handling internet	25	This module implements various utility functions for handling internet
26	protocol addresses and sockets, in an as transparent and simple way as	26	protocol addresses and sockets, in an as transparent and simple way as
…		…
33		33
34	=cut	34	=cut
35		35
36	package AnyEvent::Socket;	36	package AnyEvent::Socket;
37		37
38	no warnings;
39	use strict;
40
41	use Carp ();	38	use Carp ();
42	use Errno ();	39	use Errno ();
43	use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);	40	use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
44		41
45	use AnyEvent ();	42	use AnyEvent (); BEGIN { AnyEvent::common_sense }
46	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);	43	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47	use AnyEvent::DNS ();	44	use AnyEvent::DNS ();
48		45
49	use base 'Exporter';	46	use base 'Exporter';
50		47
51	our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);	48	our @EXPORT = qw(
		49	getprotobyname
		50	parse_hostport format_hostport
		51	parse_ipv4 parse_ipv6
		52	parse_ip parse_address
		53	format_ipv4 format_ipv6
		54	format_ip format_address
		55	address_family
		56	inet_aton
		57	tcp_server
		58	tcp_connect
		59	);
52		60
53	our $VERSION = '1.0';	61	our $VERSION = $AnyEvent::VERSION;
		62
		63	# used in cases where we may return immediately but want the
		64	# caller to do stuff first
		65	sub _postpone {
		66	my ($cb, @args) = @_;
		67
		68	my $w; $w = AE::timer 0, 0, sub {
		69	undef $w;
		70	$cb->(@args);
		71	};
		72	}
54		73
55	=item $ipn = parse_ipv4 $dotted_quad	74	=item $ipn = parse_ipv4 $dotted_quad
56		75
57	Tries to parse the given dotted quad IPv4 address and return it in	76	Tries to parse the given dotted quad IPv4 address and return it in
58	octet form (or undef when it isn't in a parsable format). Supports all	77	octet form (or undef when it isn't in a parsable format). Supports all
…		…
70		89
71	# check leading parts against range	90	# check leading parts against range
72	return undef if grep $_ >= 256, @_[0 .. @_ - 2];	91	return undef if grep $_ >= 256, @_[0 .. @_ - 2];
73		92
74	# check trailing part against range	93	# check trailing part against range
75	return undef if $_[-1] >= 1 << (8 * (4 - $#_));	94	return undef if $_[-1] >= 2 ** (8 * (4 - $#_));
76		95
77	pack "N", (pop)	96	pack "N", (pop)
78	+ ($_[0] << 24)	97	+ ($_[0] << 24)
79	+ ($_[1] << 16)	98	+ ($_[1] << 16)
80	+ ($_[2] << 8);	99	+ ($_[2] << 8);
…		…
128		147
129	# and done	148	# and done
130	pack "n*", map hex, @h, @t	149	pack "n*", map hex, @h, @t
131	}	150	}
132		151
133	=item $ipn = parse_ip $text	152	sub parse_unix($) {
		153	$_[0] eq "unix/"
		154	? pack "S", AF_UNIX
		155	: undef
134		156
		157	}
		158
		159	=item $ipn = parse_address $ip
		160
135	Combines C<parse_ipv4> and C<parse_ipv6> in one function.	161	Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
		162	here refers to the host address (not socket address) in network form
		163	(binary).
136		164
137	=cut	165	If the C<$text> is C<unix/>, then this function returns a special token
		166	recognised by the other functions in this module to mean "UNIX domain
		167	socket".
138		168
		169	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
		170	then it will be treated as an IPv4 address. If you don't want that, you
		171	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
		172
		173	=item $ipn = AnyEvent::Socket::aton $ip
		174
		175	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
		176	I<without> name resolution).
		177
		178	=cut
		179
139	sub parse_ip($) {	180	sub parse_address($) {
140	&parse_ipv4 \|\| &parse_ipv6	181	for (&parse_ipv6) {
		182	if ($_) {
		183	s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//;
		184	return $_;
		185	} else {
		186	return &parse_ipv4 \|\| &parse_unix
		187	}
		188	}
141	}	189	}
142		190
		191	*aton = \&parse_address;
		192
		193	=item ($name, $aliases, $proto) = getprotobyname $name
		194
		195	Works like the builtin function of the same name, except it tries hard to
		196	work even on broken platforms (well, that's windows), where getprotobyname
		197	is traditionally very unreliable.
		198
		199	=cut
		200
		201	# microsoft can't even get getprotobyname working (the etc/protocols file
		202	# gets lost fairly often on windows), so we have to hardcode some common
		203	# protocol numbers ourselves.
		204	our %PROTO_BYNAME;
		205
		206	$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP;
		207	$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP;
		208	$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
		209
		210	sub getprotobyname($) {
		211	my $name = lc shift;
		212
		213	defined (my $proton = $PROTO_BYNAME{$name} \|\| (getprotobyname $name)[2])
		214	or return;
		215
		216	($name, uc $name, $proton)
		217	}
		218
		219	=item ($host, $service) = parse_hostport $string[, $default_service]
		220
		221	Splitting a string of the form C<hostname:port> is a common
		222	problem. Unfortunately, just splitting on the colon makes it hard to
		223	specify IPv6 addresses and doesn't support the less common but well
		224	standardised C<[ip literal]> syntax.
		225
		226	This function tries to do this job in a better way, it supports the
		227	following formats, where C<port> can be a numerical port number of a
		228	service name, or a C<name=port> string, and the C< port> and C<:port>
		229	parts are optional. Also, everywhere where an IP address is supported
		230	a hostname or unix domain socket address is also supported (see
		231	C<parse_unix>).
		232
		233	hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
		234	ipv4:port e.g. "198.182.196.56", "127.1:22"
		235	ipv6 e.g. "::1", "affe::1"
		236	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
		237	[ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"
		238	ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
		239
		240	It also supports defaulting the service name in a simple way by using
		241	C<$default_service> if no service was detected. If neither a service was
		242	detected nor a default was specified, then this function returns the
		243	empty list. The same happens when a parse error was detected, such as a
		244	hostname with a colon in it (the function is rather conservative, though).
		245
		246	Example:
		247
		248	print join ",", parse_hostport "localhost:443";
		249	# => "localhost,443"
		250
		251	print join ",", parse_hostport "localhost", "https";
		252	# => "localhost,https"
		253
		254	print join ",", parse_hostport "[::1]";
		255	# => "," (empty list)
		256
		257	=cut
		258
		259	sub parse_hostport($;$) {
		260	my ($host, $port);
		261
		262	for ("$_[0]") { # work on a copy, just in case, and also reset pos
		263
		264	# parse host, special cases: "ipv6" or "ipv6 port"
		265	unless (
		266	($host) = /^\s* ([0-9a-fA-F:]:[0-9a-fA-F:]:[0-9a-fA-F\.:]*)/xgc
		267	and parse_ipv6 $host
		268	) {
		269	/^\s*/xgc;
		270
		271	if (/^ \[ ([^\[\]]+) \]/xgc) {
		272	$host = $1;
		273	} elsif (/^ ([^\[\]:\ ]+) /xgc) {
		274	$host = $1;
		275	} else {
		276	return;
		277	}
		278	}
		279
		280	# parse port
		281	if (/\G (?:\s+\|:) ([^:[:space:]]+) \s*$/xgc) {
		282	$port = $1;
		283	} elsif (/\G\s*$/gc && length $_[1]) {
		284	$port = $_[1];
		285	} else {
		286	return;
		287	}
		288	}
		289
		290	# hostnames must not contain :'s
		291	return if $host =~ /:/ && !parse_ipv6 $host;
		292
		293	($host, $port)
		294	}
		295
		296	=item $string = format_hostport $host, $port
		297
		298	Takes a host (in textual form) and a port and formats in unambigiously in
		299	a way that C<parse_hostport> can parse it again. C<$port> can be C<undef>.
		300
		301	=cut
		302
		303	sub format_hostport($;$) {
		304	my ($host, $port) = @_;
		305
		306	$port = ":$port" if length $port;
		307	$host = "[$host]" if $host =~ /:/;
		308
		309	"$host$port"
		310	}
		311
		312	=item $sa_family = address_family $ipn
		313
		314	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
		315	of the given host address in network format.
		316
		317	=cut
		318
		319	sub address_family($) {
		320	4 == length $_[0]
		321	? AF_INET
		322	: 16 == length $_[0]
		323	? AF_INET6
		324	: unpack "S", $_[0]
		325	}
		326
143	=item $text = format_ip $ipn	327	=item $text = format_ipv4 $ipn
144		328
145	Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)	329	Expects a four octet string representing a binary IPv4 address and returns
		330	its textual format. Rarely used, see C<format_address> for a nicer
		331	interface.
		332
		333	=item $text = format_ipv6 $ipn
		334
		335	Expects a sixteen octet string representing a binary IPv6 address and
		336	returns its textual format. Rarely used, see C<format_address> for a
		337	nicer interface.
		338
		339	=item $text = format_address $ipn
		340
		341	Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
146	and converts it into textual form.	342	octets for IPv6) and convert it into textual form.
		343
		344	Returns C<unix/> for UNIX domain sockets.
147		345
148	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,	346	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,
149	except it automatically detects the address type.	347	except it automatically detects the address type.
150		348
151	=cut	349	Returns C<undef> if it cannot detect the type.
152		350
153	sub format_ip;	351	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
		352	the contained IPv4 address will be returned. If you do not want that, you
		353	have to call C<format_ipv6> manually.
		354
		355	=item $text = AnyEvent::Socket::ntoa $ipn
		356
		357	Same as format_address, but not exported (think C<inet_ntoa>).
		358
		359	=cut
		360
154	sub format_ip($) {	361	sub format_ipv4($) {
155	if (4 == length $_[0]) {
156	return join ".", unpack "C4", $_[0]	362	join ".", unpack "C4", $_[0]
157	} elsif (16 == length $_[0]) {	363	}
		364
		365	sub format_ipv6($) {
		366	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
		367	return "::";
		368	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
		369	return "::1";
		370	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
		371	# v4compatible
		372	return "::" . format_ipv4 substr $_[0], 12;
158	if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {	373	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
159	# v4mapped	374	# v4mapped
160	return "::ffff:" . format_ip substr $_[0], 12;	375	return "::ffff:" . format_ipv4 substr $_[0], 12;
		376	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
		377	# v4translated
		378	return "::ffff:0:" . format_ipv4 substr $_[0], 12;
161	} else {	379	} else {
162	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];	380	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
163		381
		382	# this is rather sucky, I admit
164	$ip =~ s/^0:(?:0:)*(0$)?/::/	383	$ip =~ s/^0:(?:0:)*(0$)?/::/
165	or $ip =~ s/(:0)+$/::/	384	or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
166	or $ip =~ s/(:0)+/:/;	385	or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
		386	or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
		387	or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
		388	or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
		389	or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
		390	or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
167	return $ip	391	return $ip
168	}	392	}
		393	}
		394
		395	sub format_address($) {
		396	my $af = address_family $_[0];
		397	if ($af == AF_INET) {
		398	return &format_ipv4;
		399	} elsif ($af == AF_INET6) {
		400	return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12)
		401	? format_ipv4 substr $_[0], 12
		402	: &format_ipv6;
		403	} elsif ($af == AF_UNIX) {
		404	return "unix/"
169	} else {	405	} else {
170	return undef	406	return undef
171	}	407	}
172	}	408	}
		409
		410	*ntoa = \&format_address;
173		411
174	=item inet_aton $name_or_address, $cb->(@addresses)	412	=item inet_aton $name_or_address, $cb->(@addresses)
175		413
176	Works similarly to its Socket counterpart, except that it uses a	414	Works similarly to its Socket counterpart, except that it uses a
177	callback. Also, if a host has only an IPv6 address, this might be passed	415	callback. Also, if a host has only an IPv6 address, this might be passed
178	to the callback instead (use the length to detect this - 4 for IPv4, 16	416	to the callback instead (use the length to detect this - 4 for IPv4, 16
179	for IPv6).	417	for IPv6).
180		418
181	Unlike the L<Socket> function of the same name, you can get multiple IPv4	419	Unlike the L<Socket> function of the same name, you can get multiple IPv4
182	and IPv6 addresses as result.	420	and IPv6 addresses as result (and maybe even other adrdess types).
183		421
184	=cut	422	=cut
185		423
186	sub inet_aton {	424	sub inet_aton {
187	my ($name, $cb) = @_;	425	my ($name, $cb) = @_;
…		…
205	}	443	}
206	});	444	});
207	}	445	}
208	}	446	}
209		447
		448	BEGIN {
		449	*sockaddr_family = $Socket::VERSION >= 1.75
		450	? \&Socket::sockaddr_family
		451	: # for 5.6.x, we need to do something much more horrible
		452	(Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55"
		453	\| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
		454	? sub { unpack "xC", $_[0] }
		455	: sub { unpack "S" , $_[0] };
		456	}
		457
		458	# check for broken platforms with extra field in sockaddr structure
		459	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
		460	# unix vs. bsd issue, a iso C vs. bsd issue or simply a
		461	# correctness vs. bsd issue.)
		462	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
		463	? "xC" : "S";
		464
210	=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host	465	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
211		466
212	Pack the given port/host combination into a binary sockaddr structure. Handles	467	Pack the given port/host combination into a binary sockaddr
213	both IPv4 and IPv6 host addresses.	468	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
		469	domain sockets (C<$host> == C<unix/> and C<$service> == absolute
		470	pathname).
214		471
215	=cut	472	=cut
216		473
217	sub pack_sockaddr($$) {	474	sub pack_sockaddr($$) {
218	if (4 == length $_[1]) {	475	my $af = address_family $_[1];
		476
		477	if ($af == AF_INET) {
219	Socket::pack_sockaddr_in $_[0], $_[1]	478	Socket::pack_sockaddr_in $_[0], $_[1]
220	} elsif (16 == length $_[1]) {	479	} elsif ($af == AF_INET6) {
221	pack "SnL a16 L",	480	pack "$pack_family nL a16 L",
222	AF_INET6,	481	AF_INET6,
223	$_[0], # port	482	$_[0], # port
224	0, # flowinfo	483	0, # flowinfo
225	$_[1], # addr	484	$_[1], # addr
226	0 # scope id	485	0 # scope id
		486	} elsif ($af == AF_UNIX) {
		487	Socket::pack_sockaddr_un $_[0]
227	} else {	488	} else {
228	Carp::croak "pack_sockaddr: invalid host";	489	Carp::croak "pack_sockaddr: invalid host";
229	}	490	}
230	}	491	}
231		492
232	=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa	493	=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa
233		494
234	Unpack the given binary sockaddr structure (as used by bind, getpeername	495	Unpack the given binary sockaddr structure (as used by bind, getpeername
235	etc.) into a C<$port, $host> combination.	496	etc.) into a C<$service, $host> combination.
236		497
237	Handles both IPv4 and IPv6 sockaddr structures.	498	For IPv4 and IPv6, C<$service> is the port number and C<$host> the host
		499	address in network format (binary).
		500
		501	For UNIX domain sockets, C<$service> is the absolute pathname and C<$host>
		502	is a special token that is understood by the other functions in this
		503	module (C<format_address> converts it to C<unix/>).
238		504
239	=cut	505	=cut
240		506
241	sub unpack_sockaddr($) {	507	sub unpack_sockaddr($) {
242	my $af = unpack "S", $_[0];	508	my $af = sockaddr_family $_[0];
243		509
244	if ($af == AF_INET) {	510	if ($af == AF_INET) {
245	Socket::unpack_sockaddr_in $_[0]	511	Socket::unpack_sockaddr_in $_[0]
246	} elsif ($af == AF_INET6) {	512	} elsif ($af == AF_INET6) {
247	unpack "x2 n x4 a16", $_[0]	513	unpack "x2 n x4 a16", $_[0]
		514	} elsif ($af == AF_UNIX) {
		515	((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)
248	} else {	516	} else {
249	Carp::croak "unpack_sockaddr: unsupported protocol family $af";	517	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
250	}	518	}
251	}	519	}
252		520
253	sub _tcp_port($) {	521	=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
254	$_[0] =~ /^(\d)$/ and return $11;
255		522
256	(getservbyname $_[0], "tcp")[2]	523	Tries to resolve the given nodename and service name into protocol families
		524	and sockaddr structures usable to connect to this node and service in a
		525	protocol-independent way. It works remotely similar to the getaddrinfo
		526	posix function.
		527
		528	For internet addresses, C<$node> is either an IPv4 or IPv6 address or an
		529	internet hostname, and C<$service> is either a service name (port name
		530	from F</etc/services>) or a numerical port number. If both C<$node> and
		531	C<$service> are names, then SRV records will be consulted to find the real
		532	service, otherwise they will be used as-is. If you know that the service
		533	name is not in your services database, then you can specify the service in
		534	the format C<name=port> (e.g. C<http=80>).
		535
		536	For UNIX domain sockets, C<$node> must be the string C<unix/> and
		537	C<$service> must be the absolute pathname of the socket. In this case,
		538	C<$proto> will be ignored.
		539
		540	C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
		541	C<sctp>. The default is currently C<tcp>, but in the future, this function
		542	might try to use other protocols such as C<sctp>, depending on the socket
		543	type and any SRV records it might find.
		544
		545	C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
		546	only IPv4) or C<6> (use only IPv6). The default is influenced by
		547	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
		548
		549	C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
		550	C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
		551	unless C<$proto> is C<udp>).
		552
		553	The callback will receive zero or more array references that contain
		554	C<$family, $type, $proto> for use in C<socket> and a binary
		555	C<$sockaddr> for use in C<connect> (or C<bind>).
		556
		557	The application should try these in the order given.
		558
		559	Example:
		560
		561	resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
		562
		563	=cut
		564
		565	sub resolve_sockaddr($$$$$$) {
		566	my ($node, $service, $proto, $family, $type, $cb) = @_;
		567
		568	if ($node eq "unix/") {
		569	return $cb->() if $family \|\| $service !~ /^\//; # no can do
		570
		571	return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
		572	}
		573
		574	unless (AF_INET6) {
		575	$family != 6
		576	or return $cb->();
		577
		578	$family = 4;
		579	}
		580
		581	$cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
		582	$cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
		583
		584	$family \|\|= 4 unless $AnyEvent::PROTOCOL{ipv6};
		585	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
		586
		587	$proto \|\|= "tcp";
		588	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
		589
		590	my $proton = getprotobyname $proto
257	or Carp::croak "$_[0]: service unknown"	591	or Carp::croak "$proto: protocol unknown";
		592
		593	my $port;
		594
		595	if ($service =~ /^(\S+)=(\d+)$/) {
		596	($service, $port) = ($1, $2);
		597	} elsif ($service =~ /^\d+$/) {
		598	($service, $port) = (undef, $service);
		599	} else {
		600	$port = (getservbyname $service, $proto)[2]
		601	or Carp::croak "$service/$proto: service unknown";
		602	}
		603
		604	my @target = [$node, $port];
		605
		606	# resolve a records / provide sockaddr structures
		607	my $resolve = sub {
		608	my @res;
		609	my $cv = AE::cv {
		610	$cb->(
		611	map $_->[2],
		612	sort {
		613	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
		614	or $a->[0] <=> $b->[0]
		615	}
		616	@res
		617	)
		618	};
		619
		620	$cv->begin;
		621	for my $idx (0 .. $#target) {
		622	my ($node, $port) = @{ $target[$idx] };
		623
		624	if (my $noden = parse_address $node) {
		625	my $af = address_family $noden;
		626
		627	if ($af == AF_INET && $family != 6) {
		628	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
		629	pack_sockaddr $port, $noden]]
		630	}
		631
		632	if ($af == AF_INET6 && $family != 4) {
		633	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
		634	pack_sockaddr $port, $noden]]
		635	}
		636	} else {
		637	# ipv4
		638	if ($family != 6) {
		639	$cv->begin;
		640	AnyEvent::DNS::a $node, sub {
		641	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
		642	pack_sockaddr $port, parse_ipv4 $_]]
		643	for @_;
		644	$cv->end;
		645	};
		646	}
		647
		648	# ipv6
		649	if ($family != 4) {
		650	$cv->begin;
		651	AnyEvent::DNS::aaaa $node, sub {
		652	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
		653	pack_sockaddr $port, parse_ipv6 $_]]
		654	for @_;
		655	$cv->end;
		656	};
		657	}
		658	}
		659	}
		660	$cv->end;
		661	};
		662
		663	# try srv records, if applicable
		664	if ($node eq "localhost") {
		665	@target = (["127.0.0.1", $port], ["::1", $port]);
		666	&$resolve;
		667	} elsif (defined $service && !parse_address $node) {
		668	AnyEvent::DNS::srv $service, $proto, $node, sub {
		669	my (@srv) = @_;
		670
		671	# no srv records, continue traditionally
		672	@srv
		673	or return &$resolve;
		674
		675	# the only srv record has "." ("" here) => abort
		676	$srv[0][2] ne "" \|\| $#srv
		677	or return $cb->();
		678
		679	# use srv records then
		680	@target = map ["$_->[3].", $_->[2]],
		681	grep $_->[3] ne ".",
		682	@srv;
		683
		684	&$resolve;
		685	};
		686	} else {
		687	&$resolve;
		688	}
258	}	689	}
259		690
260	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	691	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
261		692
262	This is a convenience function that creates a TCP socket and makes a 100%	693	This is a convenience function that creates a TCP socket and makes a 100%
263	non-blocking connect to the given C<$host> (which can be a hostname or a	694	non-blocking connect to the given C<$host> (which can be a hostname or
		695	a textual IP address, or the string C<unix/> for UNIX domain sockets)
264	textual IP address) and C<$service> (which can be a numeric port number or	696	and C<$service> (which can be a numeric port number or a service name,
265	a service name, or a C<servicename=portnumber> string).	697	or a C<servicename=portnumber> string, or the pathname to a UNIX domain
		698	socket).
266		699
267	If both C<$host> and C<$port> are names, then this function will use SRV	700	If both C<$host> and C<$port> are names, then this function will use SRV
268	records to locate the real target(s).	701	records to locate the real target(s).
269		702
270	In either case, it will create a list of target hosts (e.g. for multihomed	703	In either case, it will create a list of target hosts (e.g. for multihomed
271	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to	704	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
272	each in turn.	705	each in turn.
273		706
274	If the connect is successful, then the C<$connect_cb> will be invoked with	707	After the connection is established, then the C<$connect_cb> will be
275	the socket file handle (in non-blocking mode) as first and the peer host	708	invoked with the socket file handle (in non-blocking mode) as first and
276	(as a textual IP address) and peer port as second and third arguments,	709	the peer host (as a textual IP address) and peer port as second and third
277	respectively. The fourth argument is a code reference that you can call	710	arguments, respectively. The fourth argument is a code reference that you
278	if, for some reason, you don't like this connection, which will cause	711	can call if, for some reason, you don't like this connection, which will
279	C<tcp_connect> to try the next one (or call your callback without any	712	cause C<tcp_connect> to try the next one (or call your callback without
280	arguments if there are no more connections). In most cases, you can simply	713	any arguments if there are no more connections). In most cases, you can
281	ignore this argument.	714	simply ignore this argument.
282		715
283	$cb->($filehandle, $host, $port, $retry)	716	$cb->($filehandle, $host, $port, $retry)
284		717
285	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	718	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
286	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	719	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
287	indicating a DNS resolution failure).	720	indicating a DNS resolution failure).
		721
		722	The callback will I<never> be invoked before C<tcp_connect> returns, even
		723	if C<tcp_connect> was able to connect immediately (e.g. on unix domain
		724	sockets).
288		725
289	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but	726	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
290	can be used as a normal perl file handle as well.	727	can be used as a normal perl file handle as well.
291		728
292	Unless called in void context, C<tcp_connect> returns a guard object that	729	Unless called in void context, C<tcp_connect> returns a guard object that
…		…
302	timeout is to be used).	739	timeout is to be used).
303		740
304	Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP	741	Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
305	socket (although only IPv4 is currently supported by this module).	742	socket (although only IPv4 is currently supported by this module).
306		743
307	Note to Microsoft Windows users: Windows (of course) doesn't correctly	744	Note to the poor Microsoft Windows users: Windows (of course) doesn't
308	signal connection errors at all, so unless your event library works around	745	correctly signal connection errors, so unless your event library works
309	this failed connections will simply hang and time-out. The only event	746	around this, failed connections will simply hang. The only event libraries
310	library that handles this condition correctly is L<EV>, so this is highly	747	that handle this condition correctly are L<EV> and L<Glib>. Additionally,
		748	AnyEvent works around this bug with L<Event> and in its pure-perl
		749	backend. All other libraries cannot correctly handle this condition. To
311	recommended. To lessen the impact of this windows bug, a default timeout	750	lessen the impact of this windows bug, a default timeout of 30 seconds
312	of 30 seconds will be imposed on windows. Cygwin is not affected.	751	will be imposed on windows. Cygwin is not affected.
313		752
314	Simple Example: connect to localhost on port 22.	753	Simple Example: connect to localhost on port 22.
315		754
316	tcp_connect localhost => 22, sub {	755	tcp_connect localhost => 22, sub {
317	my $fh = shift	756	my $fh = shift
318	or die "unable to connect: $!";	757	or die "unable to connect: $!";
319	# do something	758	# do something
320	};	759	};
321		760
322	Complex Example: connect to www.google.com on port 80 and make a simple	761	Complex Example: connect to www.google.com on port 80 and make a simple
323	GET request without much error handling. Also limit the connection timeout	762	GET request without much error handling. Also limit the connection timeout
324	to 15 seconds.	763	to 15 seconds.
325		764
…		…
329	or die "unable to connect: $!";	768	or die "unable to connect: $!";
330		769
331	my $handle; # avoid direct assignment so on_eof has it in scope.	770	my $handle; # avoid direct assignment so on_eof has it in scope.
332	$handle = new AnyEvent::Handle	771	$handle = new AnyEvent::Handle
333	fh => $fh,	772	fh => $fh,
		773	on_error => sub {
		774	warn "error $_[2]\n";
		775	$_[0]->destroy;
		776	},
334	on_eof => sub {	777	on_eof => sub {
335	undef $handle; # keep it alive till eof	778	$handle->destroy; # destroy handle
336	warn "done.\n";	779	warn "done.\n";
337	};	780	};
338		781
339	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	782	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
340		783
341	$handle->push_read_line ("\015\012\015\012", sub {	784	$handle->push_read (line => "\015\012\015\012", sub {
342	my ($handle, $line) = @_;	785	my ($handle, $line) = @_;
343		786
344	# print response header	787	# print response header
345	print "HEADER\n$line\n\nBODY\n";	788	print "HEADER\n$line\n\nBODY\n";
346		789
…		…
355	# could call $fh->bind etc. here	798	# could call $fh->bind etc. here
356		799
357	15	800	15
358	};	801	};
359		802
		803	Example: connect to a UNIX domain socket.
		804
		805	tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
		806	...
		807	}
		808
360	=cut	809	=cut
361		810
362	sub tcp_connect($$$;$) {	811	sub tcp_connect($$$;$) {
363	my ($host, $port, $connect, $prepare) = @_;	812	my ($host, $port, $connect, $prepare) = @_;
364		813
365	# see http://cr.yp.to/docs/connect.html for some background	814	# see http://cr.yp.to/docs/connect.html for some background
		815	# also http://advogato.org/article/672.html
366		816
367	my %state = ( fh => undef );	817	my %state = ( fh => undef );
368		818
369	# name resolution	819	# name/service to type/sockaddr resolution
370	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {	820	resolve_sockaddr $host, $port, 0, 0, undef, sub {
371	my @target = @_;	821	my @target = @_;
372		822
373	$state{next} = sub {	823	$state{next} = sub {
374	return unless exists $state{fh};	824	return unless exists $state{fh};
375		825
376	my $target = shift @target	826	my $target = shift @target
377	or do {	827	or return (%state = (), _postpone $connect);
378	%state = ();
379	return $connect->();
380	};
381		828
382	my ($domain, $type, $proto, $sockaddr) = @$target;	829	my ($domain, $type, $proto, $sockaddr) = @$target;
383		830
384	# socket creation	831	# socket creation
385	socket $state{fh}, $domain, $type, $proto	832	socket $state{fh}, $domain, $type, $proto
…		…
387		834
388	fh_nonblocking $state{fh}, 1;	835	fh_nonblocking $state{fh}, 1;
389		836
390	my $timeout = $prepare && $prepare->($state{fh});	837	my $timeout = $prepare && $prepare->($state{fh});
391		838
392	$timeout \|\|= 30 if $^O =~ /mswin32/i;	839	$timeout \|\|= 30 if AnyEvent::WIN32;
393		840
394	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	841	$state{to} = AE::timer $timeout, 0, sub {
395	$! = &Errno::ETIMEDOUT;	842	$! = Errno::ETIMEDOUT;
396	$state{next}();	843	$state{next}();
397	}) if $timeout;	844	} if $timeout;
398		845
399	# called when the connect was successful, which,	846	# now connect
400	# in theory, could be the case immediately (but never is in practise)	847	if (
401	my $connected = sub {	848	(connect $state{fh}, $sockaddr)
402	delete $state{ww};	849	\|\| ($! == Errno::EINPROGRESS # POSIX
403	delete $state{to};	850	\|\| $! == Errno::EWOULDBLOCK
404		851	# WSAEINPROGRESS intentionally not checked - it means something else entirely
		852	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
		853	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK)
		854	) {
		855	$state{ww} = AE::io $state{fh}, 1, sub {
405	# we are connected, or maybe there was an error	856	# we are connected, or maybe there was an error
406	if (my $sin = getpeername $state{fh}) {	857	if (my $sin = getpeername $state{fh}) {
407	my ($port, $host) = unpack_sockaddr $sin;	858	my ($port, $host) = unpack_sockaddr $sin;
408		859
		860	delete $state{ww}; delete $state{to};
		861
409	my $guard = guard {	862	my $guard = guard { %state = () };
410	%state = ();
411	};
412		863
413	$connect->($state{fh}, format_ip $host, $port, sub {	864	$connect->(delete $state{fh}, format_address $host, $port, sub {
414	$guard->cancel;	865	$guard->cancel;
		866	$state{next}();
		867	});
		868	} else {
		869	# dummy read to fetch real error code
		870	sysread $state{fh}, my $buf, 1 if $! == Errno::ENOTCONN;
		871
		872	return if $! == Errno::EAGAIN; # skip spurious wake-ups
		873
		874	delete $state{ww}; delete $state{to};
		875
415	$state{next}();	876	$state{next}();
416	});	877	}
417	} else {
418	# dummy read to fetch real error code
419	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
420	$state{next}();
421	}	878	};
422	};
423
424	# now connect
425	if (connect $state{fh}, $sockaddr) {
426	$connected->();
427	} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
428	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
429	} else {	879	} else {
430	%state = ();	880	$state{next}();
431	$connect->();
432	}	881	}
433	};	882	};
434		883
435	$! = &Errno::ENXIO;	884	$! = Errno::ENXIO;
436	$state{next}();	885	$state{next}();
437	};	886	};
438		887
439	defined wantarray && guard { %state = () }	888	defined wantarray && guard { %state = () }
440	}	889	}
441		890
442	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]	891	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
443		892
444	Create and bind a TCP socket to the given host, and port, set the	893	Create and bind a stream socket to the given host, and port, set the
445	SO_REUSEADDR flag and call C<listen>.	894	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
		895	implies, this function can also bind on UNIX domain sockets.
446		896
447	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it	897	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
448	binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the	898	C<undef>, in which case it binds either to C<0> or to C<::>, depending
449	preferred protocol).	899	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
		900	future versions, as applicable).
450		901
451	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6	902	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
452	wildcard address, use C<::>.	903	wildcard address, use C<::>.
453		904
454	The port is specified by C<$port>, which must be either a service name or	905	The port is specified by C<$service>, which must be either a service name or
455	a numeric port number (or C<0> or C<undef>, in which case an ephemeral	906	a numeric port number (or C<0> or C<undef>, in which case an ephemeral
456	port will be used).	907	port will be used).
		908
		909	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
		910	the absolute pathname of the socket. This function will try to C<unlink>
		911	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
		912	below.
457		913
458	For each new connection that could be C<accept>ed, call the C<<	914	For each new connection that could be C<accept>ed, call the C<<
459	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking	915	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
460	mode) as first and the peer host and port as second and third arguments	916	mode) as first and the peer host and port as second and third arguments
461	(see C<tcp_connect> for details).	917	(see C<tcp_connect> for details).
…		…
473	address and port number of the local socket endpoint as second and third	929	address and port number of the local socket endpoint as second and third
474	arguments.	930	arguments.
475		931
476	It should return the length of the listen queue (or C<0> for the default).	932	It should return the length of the listen queue (or C<0> for the default).
477		933
		934	Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on
		935	C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack
		936	hosts. Unfortunately, only GNU/Linux seems to implement this properly, so
		937	if you want both IPv4 and IPv6 listening sockets you should create the
		938	IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore
		939	any C<EADDRINUSE> errors.
		940
478	Example: bind on some TCP port on the local machine and tell each client	941	Example: bind on some TCP port on the local machine and tell each client
479	to go away.	942	to go away.
480		943
481	tcp_server undef, undef, sub {	944	tcp_server undef, undef, sub {
482	my ($fh, $host, $port) = @_;	945	my ($fh, $host, $port) = @_;
…		…
485	}, sub {	948	}, sub {
486	my ($fh, $thishost, $thisport) = @_;	949	my ($fh, $thishost, $thisport) = @_;
487	warn "bound to $thishost, port $thisport\n";	950	warn "bound to $thishost, port $thisport\n";
488	};	951	};
489		952
		953	Example: bind a server on a unix domain socket.
		954
		955	tcp_server "unix/", "/tmp/mydir/mysocket", sub {
		956	my ($fh) = @_;
		957	};
		958
490	=cut	959	=cut
491		960
492	sub tcp_server($$$;$) {	961	sub tcp_server($$$;$) {
493	my ($host, $port, $accept, $prepare) = @_;	962	my ($host, $service, $accept, $prepare) = @_;
494		963
495	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6	964	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
496	? "::" : "0"	965	? "::" : "0"
497	unless defined $host;	966	unless defined $host;
498		967
499	my $ipn = parse_ip $host	968	my $ipn = parse_address $host
500	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";	969	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
501		970
502	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;	971	my $af = address_family $ipn;
503		972
504	my %state;	973	my %state;
505		974
		975	# win32 perl is too stupid to get this right :/
		976	Carp::croak "tcp_server/socket: address family not supported"
		977	if AnyEvent::WIN32 && $af == AF_UNIX;
		978
506	socket $state{fh}, $domain, SOCK_STREAM, 0	979	socket $state{fh}, $af, SOCK_STREAM, 0
507	or Carp::croak "socket: $!";	980	or Carp::croak "tcp_server/socket: $!";
508		981
		982	if ($af == AF_INET \|\| $af == AF_INET6) {
509	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1	983	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
510	or Carp::croak "so_reuseaddr: $!";	984	or Carp::croak "tcp_server/so_reuseaddr: $!"
		985	unless AnyEvent::WIN32; # work around windows bug
511		986
		987	unless ($service =~ /^\d*$/) {
		988	$service = (getservbyname $service, "tcp")[2]
		989	or Carp::croak "$service: service unknown"
		990	}
		991	} elsif ($af == AF_UNIX) {
		992	unlink $service;
		993	}
		994
512	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn	995	bind $state{fh}, pack_sockaddr $service, $ipn
513	or Carp::croak "bind: $!";	996	or Carp::croak "bind: $!";
514		997
515	fh_nonblocking $state{fh}, 1;	998	fh_nonblocking $state{fh}, 1;
516		999
517	my $len;	1000	my $len;
518		1001
519	if ($prepare) {	1002	if ($prepare) {
520	my ($port, $host) = unpack_sockaddr getsockname $state{fh};	1003	my ($service, $host) = unpack_sockaddr getsockname $state{fh};
521	$len = $prepare && $prepare->($state{fh}, format_ip $host, $port);	1004	$len = $prepare && $prepare->($state{fh}, format_address $host, $service);
522	}	1005	}
523		1006
524	$len \|\|= 128;	1007	$len \|\|= 128;
525		1008
526	listen $state{fh}, $len	1009	listen $state{fh}, $len
527	or Carp::croak "listen: $!";	1010	or Carp::croak "listen: $!";
528		1011
529	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1012	$state{aw} = AE::io $state{fh}, 0, sub {
530	# this closure keeps $state alive	1013	# this closure keeps $state alive
531	while (my $peer = accept my $fh, $state{fh}) {	1014	while (my $peer = accept my $fh, $state{fh}) {
532	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	1015	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
		1016
533	my ($port, $host) = unpack_sockaddr $peer;	1017	my ($service, $host) = unpack_sockaddr $peer;
534	$accept->($fh, format_ip $host, $port);	1018	$accept->($fh, format_address $host, $service);
535	}	1019	}
536	});	1020	};
537		1021
538	defined wantarray	1022	defined wantarray
539	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1023	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
540	: ()	1024	: ()
541	}	1025	}
542		1026
543	1;	1027	1;
544		1028
545	=back	1029	=back
546		1030
		1031	=head1 SECURITY CONSIDERATIONS
		1032
		1033	This module is quite powerful, with with power comes the ability to abuse
		1034	as well: If you accept "hostnames" and ports from untrusted sources,
		1035	then note that this can be abused to delete files (host=C<unix/>). This
		1036	is not really a problem with this module, however, as blindly accepting
		1037	any address and protocol and trying to bind a server or connect to it is
		1038	harmful in general.
		1039
547	=head1 AUTHOR	1040	=head1 AUTHOR
548		1041
549	Marc Lehmann <schmorp@schmorp.de>	1042	Marc Lehmann <schmorp@schmorp.de>
550	http://home.schmorp.de/	1043	http://home.schmorp.de/
551		1044

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC vs. Revision 1.111 by elmex, Mon Aug 10 13:36:00 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC vs.
Revision 1.111 by elmex, Mon Aug 10 13:36:00 2009 UTC