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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.102 by root, Thu Jul 30 16:39:19 2009 UTC vs.
Revision 1.133 by root, Sat Aug 13 16:32:31 2011 UTC

…		…
45		45
46	use base 'Exporter';	46	use base 'Exporter';
47		47
48	our @EXPORT = qw(	48	our @EXPORT = qw(
49	getprotobyname	49	getprotobyname
50	parse_hostport	50	parse_hostport format_hostport
51	parse_ipv4 parse_ipv6	51	parse_ipv4 parse_ipv6
52	parse_ip parse_address	52	parse_ip parse_address
53	format_ipv4 format_ipv6	53	format_ipv4 format_ipv6
54	format_ip format_address	54	format_ip format_address
55	address_family	55	address_family
56	inet_aton	56	inet_aton
57	tcp_server	57	tcp_server
58	tcp_connect	58	tcp_connect
59	);	59	);
60		60
61	our $VERSION = 4.881;	61	our $VERSION = $AnyEvent::VERSION;
62		62
63	=item $ipn = parse_ipv4 $dotted_quad	63	=item $ipn = parse_ipv4 $dotted_quad
64		64
65	Tries to parse the given dotted quad IPv4 address and return it in	65	Tries to parse the given dotted quad IPv4 address and return it in
66	octet form (or undef when it isn't in a parsable format). Supports all	66	octet form (or undef when it isn't in a parsable format). Supports all
…		…
97	forms supported by parse_ipv4). Note that scope-id's are not supported	97	forms supported by parse_ipv4). Note that scope-id's are not supported
98	(and will not parse).	98	(and will not parse).
99		99
100	This function works similarly to C<inet_pton AF_INET6, ...>.	100	This function works similarly to C<inet_pton AF_INET6, ...>.
101		101
		102	Example:
		103
		104	print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1";
		105	# => 2002534500000000000000000a000001
		106
102	=cut	107	=cut
103		108
104	sub parse_ipv6($) {	109	sub parse_ipv6($) {
105	# quick test to avoid longer processing	110	# quick test to avoid longer processing
106	my $n = $_[0] =~ y/://;	111	my $n = $_[0] =~ y/://;
…		…
156	socket".	161	socket".
157		162
158	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),	163	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
159	then it will be treated as an IPv4 address. If you don't want that, you	164	then it will be treated as an IPv4 address. If you don't want that, you
160	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.	165	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
		166
		167	Example:
		168
		169	print unpack "H*", parse_address "10.1.2.3";
		170	# => 0a010203
161		171
162	=item $ipn = AnyEvent::Socket::aton $ip	172	=item $ipn = AnyEvent::Socket::aton $ip
163		173
164	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but	174	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
165	I<without> name resolution).	175	I<without> name resolution).
…		…
183		193
184	Works like the builtin function of the same name, except it tries hard to	194	Works like the builtin function of the same name, except it tries hard to
185	work even on broken platforms (well, that's windows), where getprotobyname	195	work even on broken platforms (well, that's windows), where getprotobyname
186	is traditionally very unreliable.	196	is traditionally very unreliable.
187		197
		198	Example: get the protocol number for TCP (usually 6)
		199
		200	my $proto = getprotobyname "tcp";
		201
188	=cut	202	=cut
189		203
190	# microsoft can't even get getprotobyname working (the etc/protocols file	204	# microsoft can't even get getprotobyname working (the etc/protocols file
191	# gets lost fairly often on windows), so we have to hardcode some common	205	# gets lost fairly often on windows), so we have to hardcode some common
192	# protocol numbers ourselves.	206	# protocol numbers ourselves.
…		…
280	return if $host =~ /:/ && !parse_ipv6 $host;	294	return if $host =~ /:/ && !parse_ipv6 $host;
281		295
282	($host, $port)	296	($host, $port)
283	}	297	}
284		298
		299	=item $string = format_hostport $host, $port
		300
		301	Takes a host (in textual form) and a port and formats in unambigiously in
		302	a way that C<parse_hostport> can parse it again. C<$port> can be C<undef>.
		303
		304	=cut
		305
		306	sub format_hostport($;$) {
		307	my ($host, $port) = @_;
		308
		309	$port = ":$port" if length $port;
		310	$host = "[$host]" if $host =~ /:/;
		311
		312	"$host$port"
		313	}
		314
285	=item $sa_family = address_family $ipn	315	=item $sa_family = address_family $ipn
286		316
287	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)	317	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
288	of the given host address in network format.	318	of the given host address in network format.
289		319
…		…
323		353
324	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just	354	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
325	the contained IPv4 address will be returned. If you do not want that, you	355	the contained IPv4 address will be returned. If you do not want that, you
326	have to call C<format_ipv6> manually.	356	have to call C<format_ipv6> manually.
327		357
		358	Example:
		359
		360	print format_address "\x01\x02\x03\x05";
		361	=> 1.2.3.5
		362
328	=item $text = AnyEvent::Socket::ntoa $ipn	363	=item $text = AnyEvent::Socket::ntoa $ipn
329		364
330	Same as format_address, but not exported (think C<inet_ntoa>).	365	Same as format_address, but not exported (think C<inet_ntoa>).
331		366
332	=cut	367	=cut
…		…
334	sub format_ipv4($) {	369	sub format_ipv4($) {
335	join ".", unpack "C4", $_[0]	370	join ".", unpack "C4", $_[0]
336	}	371	}
337		372
338	sub format_ipv6($) {	373	sub format_ipv6($) {
		374	if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) {
339	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {	375	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
340	return "::";	376	return "::";
341	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {	377	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
342	return "::1";	378	return "::1";
343	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {	379	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
344	# v4compatible	380	# v4compatible
345	return "::" . format_ipv4 substr $_[0], 12;	381	return "::" . format_ipv4 substr $_[0], 12;
346	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {	382	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
347	# v4mapped	383	# v4mapped
348	return "::ffff:" . format_ipv4 substr $_[0], 12;	384	return "::ffff:" . format_ipv4 substr $_[0], 12;
349	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {	385	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
350	# v4translated	386	# v4translated
351	return "::ffff:0:" . format_ipv4 substr $_[0], 12;	387	return "::ffff:0:" . format_ipv4 substr $_[0], 12;
352	} else {	388	}
		389	}
		390
353	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];	391	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
354		392
355	# this is rather sucky, I admit	393	# this is admittedly rather sucky
356	$ip =~ s/^0:(?:0:)*(0$)?/::/	394	$ip =~ s/(?:^\|:) 0:0:0:0:0:0:0 (?:$\|:)/::/x
357	or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/	395	or $ip =~ s/(?:^\|:) 0:0:0:0:0:0 (?:$\|:)/::/x
358	or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/	396	or $ip =~ s/(?:^\|:) 0:0:0:0:0 (?:$\|:)/::/x
359	or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/	397	or $ip =~ s/(?:^\|:) 0:0:0:0 (?:$\|:)/::/x
360	or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/	398	or $ip =~ s/(?:^\|:) 0:0:0 (?:$\|:)/::/x
361	or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/	399	or $ip =~ s/(?:^\|:) 0:0 (?:$\|:)/::/x
362	or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/	400	or $ip =~ s/(?:^\|:) 0 (?:$\|:)/::/x;
363	or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;	401
364	return $ip	402	$ip
365	}
366	}	403	}
367		404
368	sub format_address($) {	405	sub format_address($) {
369	my $af = address_family $_[0];	406	if (4 == length $_[0]) {
370	if ($af == AF_INET) {
371	return &format_ipv4;	407	return &format_ipv4;
372	} elsif ($af == AF_INET6) {	408	} elsif (16 == length $_[0]) {
373	return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12)	409	return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s
374	? format_ipv4 substr $_[0], 12	410	? format_ipv4 $1
375	: &format_ipv6;	411	: &format_ipv6;
376	} elsif ($af == AF_UNIX) {	412	} elsif (AF_UNIX == address_family $_[0]) {
377	return "unix/"	413	return "unix/"
378	} else {	414	} else {
379	return undef	415	return undef
380	}	416	}
381	}	417	}
…		…
383	*ntoa = \&format_address;	419	*ntoa = \&format_address;
384		420
385	=item inet_aton $name_or_address, $cb->(@addresses)	421	=item inet_aton $name_or_address, $cb->(@addresses)
386		422
387	Works similarly to its Socket counterpart, except that it uses a	423	Works similarly to its Socket counterpart, except that it uses a
388	callback. Also, if a host has only an IPv6 address, this might be passed	424	callback. Use the length to distinguish between ipv4 and ipv6 (4 octets
389	to the callback instead (use the length to detect this - 4 for IPv4, 16	425	for IPv4, 16 for IPv6), or use C<format_address> to convert it to a more
390	for IPv6).	426	readable format.
391		427
392	Unlike the L<Socket> function of the same name, you can get multiple IPv4	428	Note that C<resolve_sockaddr>, while initially a more complex interface,
393	and IPv6 addresses as result (and maybe even other adrdess types).	429	resolves host addresses, IDNs, service names and SRV records and gives you
		430	an ordered list of socket addresses to try and should be preferred over
		431	C<inet_aton>.
		432
		433	Example.
		434
		435	inet_aton "www.google.com", my $cv = AE::cv;
		436	say unpack "H*", $_
		437	for $cv->recv;
		438	# => d155e363
		439	# => d155e367 etc.
		440
		441	inet_aton "ipv6.google.com", my $cv = AE::cv;
		442	say unpack "H*", $_
		443	for $cv->recv;
		444	# => 20014860a00300000000000000000068
394		445
395	=cut	446	=cut
396		447
397	sub inet_aton {	448	sub inet_aton {
398	my ($name, $cb) = @_;	449	my ($name, $cb) = @_;
…		…
404	} elsif ($name eq "localhost") { # rfc2606 et al.	455	} elsif ($name eq "localhost") { # rfc2606 et al.
405	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);	456	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
406	} else {	457	} else {
407	require AnyEvent::DNS;	458	require AnyEvent::DNS;
408		459
409	# simple, bad suboptimal algorithm	460	my $ipv4 = $AnyEvent::PROTOCOL{ipv4};
		461	my $ipv6 = $AnyEvent::PROTOCOL{ipv6};
		462
		463	my @res;
		464
		465	my $cv = AE::cv {
		466	$cb->(map @$_, reverse @res);
		467	};
		468
		469	$cv->begin;
		470
		471	if ($ipv4) {
		472	$cv->begin;
410	AnyEvent::DNS::a ($name, sub {	473	AnyEvent::DNS::a ($name, sub {
411	if (@_) {	474	$res[$ipv4] = [map &parse_ipv4, @_];
412	$cb->(map +(parse_ipv4 $_), @_);
413	} else {
414	$cb->();	475	$cv->end;
415	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
416	}	476	});
417	});	477	};
		478
		479	if ($ipv6) {
		480	$cv->begin;
		481	AnyEvent::DNS::aaaa ($name, sub {
		482	$res[$ipv6] = [map &parse_ipv6, @_];
		483	$cv->end;
		484	});
		485	};
		486
		487	$cv->end;
418	}	488	}
419	}	489	}
420		490
421	BEGIN {	491	BEGIN {
422	*sockaddr_family = $Socket::VERSION >= 1.75	492	*sockaddr_family = $Socket::VERSION >= 1.75
…		…
426	\| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/	496	\| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
427	? sub { unpack "xC", $_[0] }	497	? sub { unpack "xC", $_[0] }
428	: sub { unpack "S" , $_[0] };	498	: sub { unpack "S" , $_[0] };
429	}	499	}
430		500
431	# check for broken platforms with extra field in sockaddr structure	501	# check for broken platforms with an extra field in sockaddr structure
432	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a	502	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
433	# unix vs. bsd issue, a iso C vs. bsd issue or simply a	503	# unix vs. bsd issue, a iso C vs. bsd issue or simply a
434	# correctness vs. bsd issue.)	504	# correctness vs. bsd issue.)
435	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")	505	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
436	? "xC" : "S";	506	? "xC" : "S";
…		…
439		509
440	Pack the given port/host combination into a binary sockaddr	510	Pack the given port/host combination into a binary sockaddr
441	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX	511	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
442	domain sockets (C<$host> == C<unix/> and C<$service> == absolute	512	domain sockets (C<$host> == C<unix/> and C<$service> == absolute
443	pathname).	513	pathname).
		514
		515	Example:
		516
		517	my $bind = AnyEvent::Socket::pack_sockaddr 43, v195.234.53.120;
		518	bind $socket, $bind
		519	or die "bind: $!";
444		520
445	=cut	521	=cut
446		522
447	sub pack_sockaddr($$) {	523	sub pack_sockaddr($$) {
448	my $af = address_family $_[1];	524	my $af = address_family $_[1];
…		…
475	is a special token that is understood by the other functions in this	551	is a special token that is understood by the other functions in this
476	module (C<format_address> converts it to C<unix/>).	552	module (C<format_address> converts it to C<unix/>).
477		553
478	=cut	554	=cut
479		555
		556	# perl contains a bug (imho) where it requires that the kernel always returns
		557	# sockaddr_un structures of maximum length (which is not, AFAICS, required
		558	# by any standard). try to 0-pad structures for the benefit of those platforms.
		559
		560	my $sa_un_zero = eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero;
		561
480	sub unpack_sockaddr($) {	562	sub unpack_sockaddr($) {
481	my $af = sockaddr_family $_[0];	563	my $af = sockaddr_family $_[0];
482		564
483	if ($af == AF_INET) {	565	if ($af == AF_INET) {
484	Socket::unpack_sockaddr_in $_[0]	566	Socket::unpack_sockaddr_in $_[0]
485	} elsif ($af == AF_INET6) {	567	} elsif ($af == AF_INET6) {
486	unpack "x2 n x4 a16", $_[0]	568	unpack "x2 n x4 a16", $_[0]
487	} elsif ($af == AF_UNIX) {	569	} elsif ($af == AF_UNIX) {
488	((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)	570	((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX)
489	} else {	571	} else {
490	Carp::croak "unpack_sockaddr: unsupported protocol family $af";	572	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
491	}	573	}
492	}	574	}
493		575
…		…
496	Tries to resolve the given nodename and service name into protocol families	578	Tries to resolve the given nodename and service name into protocol families
497	and sockaddr structures usable to connect to this node and service in a	579	and sockaddr structures usable to connect to this node and service in a
498	protocol-independent way. It works remotely similar to the getaddrinfo	580	protocol-independent way. It works remotely similar to the getaddrinfo
499	posix function.	581	posix function.
500		582
501	For internet addresses, C<$node> is either an IPv4 or IPv6 address or an	583	For internet addresses, C<$node> is either an IPv4 or IPv6 address, an
502	internet hostname, and C<$service> is either a service name (port name	584	internet hostname (DNS domain name or IDN), and C<$service> is either
503	from F</etc/services>) or a numerical port number. If both C<$node> and	585	a service name (port name from F</etc/services>) or a numerical port
504	C<$service> are names, then SRV records will be consulted to find the real	586	number. If both C<$node> and C<$service> are names, then SRV records
505	service, otherwise they will be used as-is. If you know that the service	587	will be consulted to find the real service, otherwise they will be
506	name is not in your services database, then you can specify the service in	588	used as-is. If you know that the service name is not in your services
507	the format C<name=port> (e.g. C<http=80>).	589	database, then you can specify the service in the format C<name=port>
		590	(e.g. C<http=80>).
508		591
509	For UNIX domain sockets, C<$node> must be the string C<unix/> and	592	For UNIX domain sockets, C<$node> must be the string C<unix/> and
510	C<$service> must be the absolute pathname of the socket. In this case,	593	C<$service> must be the absolute pathname of the socket. In this case,
511	C<$proto> will be ignored.	594	C<$proto> will be ignored.
512		595
…		…
558	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};	641	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
559		642
560	$proto \|\|= "tcp";	643	$proto \|\|= "tcp";
561	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;	644	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
562		645
563	my $proton = getprotobyname $proto	646	my $proton = AnyEvent::Socket::getprotobyname $proto
564	or Carp::croak "$proto: protocol unknown";	647	or Carp::croak "$proto: protocol unknown";
565		648
566	my $port;	649	my $port;
567		650
568	if ($service =~ /^(\S+)=(\d+)$/) {	651	if ($service =~ /^(\S+)=(\d+)$/) {
…		…
572	} else {	655	} else {
573	$port = (getservbyname $service, $proto)[2]	656	$port = (getservbyname $service, $proto)[2]
574	or Carp::croak "$service/$proto: service unknown";	657	or Carp::croak "$service/$proto: service unknown";
575	}	658	}
576		659
577	my @target = [$node, $port];
578
579	# resolve a records / provide sockaddr structures	660	# resolve a records / provide sockaddr structures
580	my $resolve = sub {	661	my $resolve = sub {
		662	my @target = @_;
		663
581	my @res;	664	my @res;
582	my $cv = AnyEvent->condvar (cb => sub {	665	my $cv = AE::cv {
583	$cb->(	666	$cb->(
584	map $_->[2],	667	map $_->[2],
585	sort {	668	sort {
586	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	669	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
587	or $a->[0] <=> $b->[0]	670	or $a->[0] <=> $b->[0]
588	}	671	}
589	@res	672	@res
590	)	673	)
591	});	674	};
592		675
593	$cv->begin;	676	$cv->begin;
594	for my $idx (0 .. $#target) {	677	for my $idx (0 .. $#target) {
595	my ($node, $port) = @{ $target[$idx] };	678	my ($node, $port) = @{ $target[$idx] };
596		679
…		…
631	}	714	}
632	}	715	}
633	$cv->end;	716	$cv->end;
634	};	717	};
635		718
		719	$node = AnyEvent::Util::idn_to_ascii $node
		720	if $node =~ /[^\x00-\x7f]/;
		721
636	# try srv records, if applicable	722	# try srv records, if applicable
637	if ($node eq "localhost") {	723	if ($node eq "localhost") {
638	@target = (["127.0.0.1", $port], ["::1", $port]);	724	$resolve->(["127.0.0.1", $port], ["::1", $port]);
639	&$resolve;
640	} elsif (defined $service && !parse_address $node) {	725	} elsif (defined $service && !parse_address $node) {
641	AnyEvent::DNS::srv $service, $proto, $node, sub {	726	AnyEvent::DNS::srv $service, $proto, $node, sub {
642	my (@srv) = @_;	727	my (@srv) = @_;
643		728
644	# no srv records, continue traditionally
645	@srv	729	if (@srv) {
646	or return &$resolve;
647
648	# the only srv record has "." ("" here) => abort	730	# the only srv record has "." ("" here) => abort
649	$srv[0][2] ne "" \|\| $#srv	731	$srv[0][2] ne "" \|\| $#srv
650	or return $cb->();	732	or return $cb->();
651		733
652	# use srv records then	734	# use srv records then
		735	$resolve->(
653	@target = map ["$_->[3].", $_->[2]],	736	map ["$_->[3].", $_->[2]],
654	grep $_->[3] ne ".",	737	grep $_->[3] ne ".",
655	@srv;	738	@srv
656		739	);
657	&$resolve;	740	} else {
		741	# no srv records, continue traditionally
		742	$resolve->([$node, $port]);
		743	}
658	};	744	};
659	} else {	745	} else {
660	&$resolve;	746	# most common case
		747	$resolve->([$node, $port]);
661	}	748	}
662	}	749	}
663		750
664	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	751	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
665		752
666	This is a convenience function that creates a TCP socket and makes a 100%	753	This is a convenience function that creates a TCP socket and makes a
667	non-blocking connect to the given C<$host> (which can be a hostname or	754	100% non-blocking connect to the given C<$host> (which can be a DNS/IDN
668	a textual IP address, or the string C<unix/> for UNIX domain sockets)	755	hostname or a textual IP address, or the string C<unix/> for UNIX domain
669	and C<$service> (which can be a numeric port number or a service name,	756	sockets) and C<$service> (which can be a numeric port number or a service
670	or a C<servicename=portnumber> string, or the pathname to a UNIX domain	757	name, or a C<servicename=portnumber> string, or the pathname to a UNIX
671	socket).	758	domain socket).
672		759
673	If both C<$host> and C<$port> are names, then this function will use SRV	760	If both C<$host> and C<$port> are names, then this function will use SRV
674	records to locate the real target(s).	761	records to locate the real target(s).
675		762
676	In either case, it will create a list of target hosts (e.g. for multihomed	763	In either case, it will create a list of target hosts (e.g. for multihomed
677	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to	764	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
678	each in turn.	765	each in turn.
679		766
680	If the connect is successful, then the C<$connect_cb> will be invoked with	767	After the connection is established, then the C<$connect_cb> will be
681	the socket file handle (in non-blocking mode) as first and the peer host	768	invoked with the socket file handle (in non-blocking mode) as first, and
682	(as a textual IP address) and peer port as second and third arguments,	769	the peer host (as a textual IP address) and peer port as second and third
683	respectively. The fourth argument is a code reference that you can call	770	arguments, respectively. The fourth argument is a code reference that you
684	if, for some reason, you don't like this connection, which will cause	771	can call if, for some reason, you don't like this connection, which will
685	C<tcp_connect> to try the next one (or call your callback without any	772	cause C<tcp_connect> to try the next one (or call your callback without
686	arguments if there are no more connections). In most cases, you can simply	773	any arguments if there are no more connections). In most cases, you can
687	ignore this argument.	774	simply ignore this argument.
688		775
689	$cb->($filehandle, $host, $port, $retry)	776	$cb->($filehandle, $host, $port, $retry)
690		777
691	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	778	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
692	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	779	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
693	indicating a DNS resolution failure).	780	indicating a DNS resolution failure).
694		781
		782	The callback will I<never> be invoked before C<tcp_connect> returns, even
		783	if C<tcp_connect> was able to connect immediately (e.g. on unix domain
		784	sockets).
		785
695	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but	786	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
696	can be used as a normal perl file handle as well.	787	can be used as a normal perl file handle as well.
697		788
698	Unless called in void context, C<tcp_connect> returns a guard object that	789	Unless called in void context, C<tcp_connect> returns a guard object that
699	will automatically abort connecting when it gets destroyed (it does not do	790	will automatically cancel the connection attempt when it gets destroyed
		791	- in which case the callback will not be invoked. Destroying it does not
700	anything to the socket after the connect was successful).	792	do anything to the socket after the connect was successful - you cannot
		793	"uncall" a callback that has been invoked already.
701		794
702	Sometimes you need to "prepare" the socket before connecting, for example,	795	Sometimes you need to "prepare" the socket before connecting, for example,
703	to C<bind> it to some port, or you want a specific connect timeout that	796	to C<bind> it to some port, or you want a specific connect timeout that
704	is lower than your kernel's default timeout. In this case you can specify	797	is lower than your kernel's default timeout. In this case you can specify
705	a second callback, C<$prepare_cb>. It will be called with the file handle	798	a second callback, C<$prepare_cb>. It will be called with the file handle
…		…
748	warn "done.\n";	841	warn "done.\n";
749	};	842	};
750		843
751	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	844	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
752		845
753	$handle->push_read_line ("\015\012\015\012", sub {	846	$handle->push_read (line => "\015\012\015\012", sub {
754	my ($handle, $line) = @_;	847	my ($handle, $line) = @_;
755		848
756	# print response header	849	# print response header
757	print "HEADER\n$line\n\nBODY\n";	850	print "HEADER\n$line\n\nBODY\n";
758		851
…		…
778	=cut	871	=cut
779		872
780	sub tcp_connect($$$;$) {	873	sub tcp_connect($$$;$) {
781	my ($host, $port, $connect, $prepare) = @_;	874	my ($host, $port, $connect, $prepare) = @_;
782		875
783	# see http://cr.yp.to/docs/connect.html for some background	876	# see http://cr.yp.to/docs/connect.html for some tricky aspects
784	# also http://advogato.org/article/672.html	877	# also http://advogato.org/article/672.html
785		878
786	my %state = ( fh => undef );	879	my %state = ( fh => undef );
787		880
788	# name/service to type/sockaddr resolution	881	# name/service to type/sockaddr resolution
…		…
791		884
792	$state{next} = sub {	885	$state{next} = sub {
793	return unless exists $state{fh};	886	return unless exists $state{fh};
794		887
795	my $target = shift @target	888	my $target = shift @target
796	or return (%state = (), $connect->());	889	or return AE::postpone {
		890	return unless exists $state{fh};
		891	%state = ();
		892	$connect->();
		893	};
797		894
798	my ($domain, $type, $proto, $sockaddr) = @$target;	895	my ($domain, $type, $proto, $sockaddr) = @$target;
799		896
800	# socket creation	897	# socket creation
801	socket $state{fh}, $domain, $type, $proto	898	socket $state{fh}, $domain, $type, $proto
…		…
805		902
806	my $timeout = $prepare && $prepare->($state{fh});	903	my $timeout = $prepare && $prepare->($state{fh});
807		904
808	$timeout \|\|= 30 if AnyEvent::WIN32;	905	$timeout \|\|= 30 if AnyEvent::WIN32;
809		906
810	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	907	$state{to} = AE::timer $timeout, 0, sub {
811	$! = Errno::ETIMEDOUT;	908	$! = Errno::ETIMEDOUT;
812	$state{next}();	909	$state{next}();
813	}) if $timeout;	910	} if $timeout;
814		911
815	# called when the connect was successful, which,	912	# now connect
816	# in theory, could be the case immediately (but never is in practise)	913	if (
817	$state{connected} = sub {	914	(connect $state{fh}, $sockaddr)
		915	\|\| ($! == Errno::EINPROGRESS # POSIX
		916	\|\| $! == Errno::EWOULDBLOCK
		917	# WSAEINPROGRESS intentionally not checked - it means something else entirely
		918	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
		919	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK)
		920	) {
		921	$state{ww} = AE::io $state{fh}, 1, sub {
818	# we are connected, or maybe there was an error	922	# we are connected, or maybe there was an error
819	if (my $sin = getpeername $state{fh}) {	923	if (my $sin = getpeername $state{fh}) {
820	my ($port, $host) = unpack_sockaddr $sin;	924	my ($port, $host) = unpack_sockaddr $sin;
821		925
822	delete $state{ww}; delete $state{to};	926	delete $state{ww}; delete $state{to};
823		927
824	my $guard = guard { %state = () };	928	my $guard = guard { %state = () };
825		929
826	$connect->(delete $state{fh}, format_address $host, $port, sub {	930	$connect->(delete $state{fh}, format_address $host, $port, sub {
827	$guard->cancel;	931	$guard->cancel;
		932	$state{next}();
		933	});
		934	} else {
		935	if ($! == Errno::ENOTCONN) {
		936	# dummy read to fetch real error code if !cygwin
		937	sysread $state{fh}, my $buf, 1;
		938
		939	# cygwin 1.5 continously reports "ready' but never delivers
		940	# an error with getpeername or sysread.
		941	# cygwin 1.7 only reports readyness once, but is otherwise
		942	# the same, which is actually more broken.
		943	# Work around both by using unportable SO_ERROR for cygwin.
		944	$! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) \|\| Errno::EAGAIN
		945	if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
		946	}
		947
		948	return if $! == Errno::EAGAIN; # skip spurious wake-ups
		949
		950	delete $state{ww}; delete $state{to};
		951
828	$state{next}();	952	$state{next}();
829	});	953	}
830	} else {
831	# dummy read to fetch real error code
832	sysread $state{fh}, my $buf, 1 if $! == Errno::ENOTCONN;
833
834	return if $! == Errno::EAGAIN; # skip spurious wake-ups
835
836	delete $state{ww}; delete $state{to};
837
838	$state{next}();
839	}	954	};
840	};
841
842	# now connect
843	if (connect $state{fh}, $sockaddr) {
844	$state{connected}->();
845	} elsif ($! == Errno::EINPROGRESS # POSIX
846	\|\| $! == Errno::EWOULDBLOCK
847	# WSAEINPROGRESS intentionally not checked - it means something else entirely
848	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
849	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK) {
850	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
851	} else {	955	} else {
852	$state{next}();	956	$state{next}();
853	}	957	}
854	};	958	};
855		959
…		…
878	a numeric port number (or C<0> or C<undef>, in which case an ephemeral	982	a numeric port number (or C<0> or C<undef>, in which case an ephemeral
879	port will be used).	983	port will be used).
880		984
881	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be	985	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
882	the absolute pathname of the socket. This function will try to C<unlink>	986	the absolute pathname of the socket. This function will try to C<unlink>
883	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,	987	the socket before it tries to bind to it, and will try to unlink it after
884	below.	988	it stops using it. See SECURITY CONSIDERATIONS, below.
885		989
886	For each new connection that could be C<accept>ed, call the C<<	990	For each new connection that could be C<accept>ed, call the C<<
887	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking	991	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
888	mode) as first and the peer host and port as second and third arguments	992	mode) as first, and the peer host and port as second and third arguments
889	(see C<tcp_connect> for details).	993	(see C<tcp_connect> for details).
890		994
891	Croaks on any errors it can detect before the listen.	995	Croaks on any errors it can detect before the listen.
892		996
893	If called in non-void context, then this function returns a guard object	997	If called in non-void context, then this function returns a guard object
894	whose lifetime it tied to the TCP server: If the object gets destroyed,	998	whose lifetime it tied to the TCP server: If the object gets destroyed,
895	the server will be stopped (but existing accepted connections will	999	the server will be stopped (but existing accepted connections will
896	continue).	1000	not be affected).
897		1001
898	If you need more control over the listening socket, you can provide a	1002	If you need more control over the listening socket, you can provide a
899	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the	1003	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
900	C<listen ()> call, with the listen file handle as first argument, and IP	1004	C<listen ()> call, with the listen file handle as first argument, and IP
901	address and port number of the local socket endpoint as second and third	1005	address and port number of the local socket endpoint as second and third
…		…
965	}	1069	}
966		1070
967	bind $state{fh}, pack_sockaddr $service, $ipn	1071	bind $state{fh}, pack_sockaddr $service, $ipn
968	or Carp::croak "bind: $!";	1072	or Carp::croak "bind: $!";
969		1073
		1074	if ($af == AF_UNIX) {
		1075	my $fh = $state{fh};
		1076	my $ino = (stat $fh)[1];
		1077	$state{unlink} = guard {
		1078	# this is racy, but is not designed to be foolproof, just best-effort
		1079	unlink $service
		1080	if $ino == (stat $fh)[1];
		1081	};
		1082	}
		1083
970	fh_nonblocking $state{fh}, 1;	1084	fh_nonblocking $state{fh}, 1;
971		1085
972	my $len;	1086	my $len;
973		1087
974	if ($prepare) {	1088	if ($prepare) {
…		…
979	$len \|\|= 128;	1093	$len \|\|= 128;
980		1094
981	listen $state{fh}, $len	1095	listen $state{fh}, $len
982	or Carp::croak "listen: $!";	1096	or Carp::croak "listen: $!";
983		1097
984	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1098	$state{aw} = AE::io $state{fh}, 0, sub {
985	# this closure keeps $state alive	1099	# this closure keeps $state alive
986	while (my $peer = accept my $fh, $state{fh}) {	1100	while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
987	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	1101	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
988		1102
989	my ($service, $host) = unpack_sockaddr $peer;	1103	my ($service, $host) = unpack_sockaddr $peer;
990	$accept->($fh, format_address $host, $service);	1104	$accept->($fh, format_address $host, $service);
991	}	1105	}
992	});	1106	};
993		1107
994	defined wantarray	1108	defined wantarray
995	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1109	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
996	: ()	1110	: ()
		1111	}
		1112
		1113	=item tcp_nodelay $fh, $enable
		1114
		1115	Enables (or disables) the C<TCP_NODELAY> socket option (also known as
		1116	Nagle's algorithm). Returns false on error, true otherwise.
		1117
		1118	=cut
		1119
		1120	sub tcp_nodelay($$) {
		1121	my $onoff = int ! ! $_[1];
		1122
		1123	setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
		1124	}
		1125
		1126	=item tcp_congestion $fh, $algorithm
		1127
		1128	Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
		1129	socket option). The default is OS-specific, but is usually
		1130	C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
		1131	C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
		1132	C<veno>, C<westwood> and C<yeah>.
		1133
		1134	=cut
		1135
		1136	sub tcp_congestion($$) {
		1137	defined TCP_CONGESTION
		1138	? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
		1139	: undef
997	}	1140	}
998		1141
999	1;	1142	1;
1000		1143
1001	=back	1144	=back

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.102 by root, Thu Jul 30 16:39:19 2009 UTC vs. Revision 1.133 by root, Sat Aug 13 16:32:31 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.102 by root, Thu Jul 30 16:39:19 2009 UTC vs.
Revision 1.133 by root, Sat Aug 13 16:32:31 2011 UTC