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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.3 by elmex, Sun Apr 27 19:40:21 2008 UTC vs.
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC

		1	=head1 NAME
		2
		3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.
		4
		5	=head1 SYNOPSIS
		6
		7	use AnyEvent::Socket;
		8
		9	tcp_connect "gameserver.deliantra.net", 13327, sub {
		10	my ($fh) = @_
		11	or die "gameserver.deliantra.net connect failed: $!";
		12
		13	# enjoy your filehandle
		14	};
		15
		16	# a simple tcp server
		17	tcp_server undef, 8888, sub {
		18	my ($fh, $host, $port) = @_;
		19
		20	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
		21	};
		22
		23	=head1 DESCRIPTION
		24
		25	This module implements various utility functions for handling internet
		26	protocol addresses and sockets, in an as transparent and simple way as
		27	possible.
		28
		29	All functions documented without C<AnyEvent::Socket::> prefix are exported
		30	by default.
		31
		32	=over 4
		33
		34	=cut
		35
1	package AnyEvent::Socket;	36	package AnyEvent::Socket;
2		37
3	use warnings;	38	no warnings;
4	use strict;	39	use strict;
5		40
6	use Carp;	41	use Carp ();
7	use Errno qw/ENXIO ETIMEDOUT/;	42	use Errno ();
8	use Socket;	43	use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
9	use IO::Socket::INET;	44
10	use AnyEvent;	45	use AnyEvent ();
		46	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
11	use AnyEvent::Util;	47	use AnyEvent::DNS ();
12	use AnyEvent::Handle;
13		48
14	our @ISA = qw/AnyEvent::Handle/;	49	use base 'Exporter';
15		50
16	=head1 NAME	51	our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);
17		52
18	AnyEvent::Socket - Connecting sockets for non-blocking I/O	53	our $VERSION = '1.0';
19		54
20	=head1 SYNOPSIS	55	=item $ipn = parse_ipv4 $dotted_quad
21		56
22	use AnyEvent;	57	Tries to parse the given dotted quad IPv4 address and return it in
23	use AnyEvent::Socket;	58	octet form (or undef when it isn't in a parsable format). Supports all
		59	forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>,
		60	C<0x12345678> or C<0377.0377.0377.0377>).
24		61
25	my $cv = AnyEvent->condvar;	62	=cut
26		63
27	my $ae_sock =	64	sub parse_ipv4($) {
28	AnyEvent::Socket->new (	65	$_[0] =~ /^ (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* )
29	PeerAddr => "www.google.de:80",	66	(?:\. (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* ) ){0,3}$/x
30	on_eof => sub { $cv->broadcast },	67	or return undef;
		68
		69	@_ = map /^0/ ? oct : $_, split /\./, $_[0];
		70
		71	# check leading parts against range
		72	return undef if grep $_ >= 256, @_[0 .. @_ - 2];
		73
		74	# check trailing part against range
		75	return undef if $_[-1] >= 1 << (8 * (4 - $#_));
		76
		77	pack "N", (pop)
		78	+ ($_[0] << 24)
		79	+ ($_[1] << 16)
		80	+ ($_[2] << 8);
		81	}
		82
		83	=item $ipn = parse_ipv6 $textual_ipv6_address
		84
		85	Tries to parse the given IPv6 address and return it in
		86	octet form (or undef when it isn't in a parsable format).
		87
		88	Should support all forms specified by RFC 2373 (and additionally all IPv4
		89	forms supported by parse_ipv4). Note that scope-id's are not supported
		90	(and will not parse).
		91
		92	This function works similarly to C<inet_pton AF_INET6, ...>.
		93
		94	=cut
		95
		96	sub parse_ipv6($) {
		97	# quick test to avoid longer processing
		98	my $n = $_[0] =~ y/://;
		99	return undef if $n < 2 \|\| $n > 8;
		100
		101	my ($h, $t) = split /::/, $_[0], 2;
		102
		103	unless (defined $t) {
		104	($h, $t) = (undef, $h);
		105	}
		106
		107	my @h = split /:/, $h;
		108	my @t = split /:/, $t;
		109
		110	# check for ipv4 tail
		111	if (@t && $t[-1]=~ /\./) {
		112	return undef if $n > 6;
		113
		114	my $ipn = parse_ipv4 pop @t
		115	or return undef;
		116
		117	push @t, map +(sprintf "%x", $_), unpack "nn", $ipn;
		118	}
		119
		120	# no :: then we need to have exactly 8 components
		121	return undef unless @h + @t == 8 \|\| $_[0] =~ /::/;
		122
		123	# now check all parts for validity
		124	return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t;
		125
		126	# now pad...
		127	push @h, 0 while @h + @t < 8;
		128
		129	# and done
		130	pack "n*", map hex, @h, @t
		131	}
		132
		133	=item $ipn = parse_ip $text
		134
		135	Combines C<parse_ipv4> and C<parse_ipv6> in one function.
		136
		137	=cut
		138
		139	sub parse_ip($) {
		140	&parse_ipv4 \|\| &parse_ipv6
		141	}
		142
		143	=item $text = format_ip $ipn
		144
		145	Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)
		146	and converts it into textual form.
		147
		148	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,
		149	except it automatically detects the address type.
		150
		151	=cut
		152
		153	sub format_ip;
		154	sub format_ip($) {
		155	if (4 == length $_[0]) {
		156	return join ".", unpack "C4", $_[0]
		157	} elsif (16 == length $_[0]) {
		158	if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
		159	# v4mapped
		160	return "::ffff:" . format_ip substr $_[0], 12;
		161	} else {
		162	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
		163
		164	$ip =~ s/^0:(?:0:)*(0$)?/::/
		165	or $ip =~ s/(:0)+$/::/
		166	or $ip =~ s/(:0)+/:/;
		167	return $ip
		168	}
		169	} else {
		170	return undef
		171	}
		172	}
		173
		174	=item inet_aton $name_or_address, $cb->(@addresses)
		175
		176	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
		178	to the callback instead (use the length to detect this - 4 for IPv4, 16
		179	for IPv6).
		180
		181	Unlike the L<Socket> function of the same name, you can get multiple IPv4
		182	and IPv6 addresses as result.
		183
		184	=cut
		185
		186	sub inet_aton {
		187	my ($name, $cb) = @_;
		188
		189	if (my $ipn = &parse_ipv4) {
		190	$cb->($ipn);
		191	} elsif (my $ipn = &parse_ipv6) {
		192	$cb->($ipn);
		193	} elsif ($name eq "localhost") { # rfc2606 et al.
		194	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
		195	} else {
		196	require AnyEvent::DNS;
		197
		198	# simple, bad suboptimal algorithm
		199	AnyEvent::DNS::a ($name, sub {
		200	if (@_) {
		201	$cb->(map +(parse_ipv4 $_), @_);
		202	} else {
		203	$cb->();
		204	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
		205	}
		206	});
		207	}
		208	}
		209
		210	=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
		211
		212	Pack the given port/host combination into a binary sockaddr structure. Handles
		213	both IPv4 and IPv6 host addresses.
		214
		215	=cut
		216
		217	sub pack_sockaddr($$) {
		218	if (4 == length $_[1]) {
		219	Socket::pack_sockaddr_in $_[0], $_[1]
		220	} elsif (16 == length $_[1]) {
		221	pack "SnL a16 L",
		222	AF_INET6,
		223	$_[0], # port
		224	0, # flowinfo
		225	$_[1], # addr
		226	0 # scope id
		227	} else {
		228	Carp::croak "pack_sockaddr: invalid host";
		229	}
		230	}
		231
		232	=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa
		233
		234	Unpack the given binary sockaddr structure (as used by bind, getpeername
		235	etc.) into a C<$port, $host> combination.
		236
		237	Handles both IPv4 and IPv6 sockaddr structures.
		238
		239	=cut
		240
		241	sub unpack_sockaddr($) {
		242	my $af = unpack "S", $_[0];
		243
		244	if ($af == AF_INET) {
		245	Socket::unpack_sockaddr_in $_[0]
		246	} elsif ($af == AF_INET6) {
		247	unpack "x2 n x4 a16", $_[0]
		248	} else {
		249	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
		250	}
		251	}
		252
		253	sub _tcp_port($) {
		254	$_[0] =~ /^(\d)$/ and return $11;
		255
		256	(getservbyname $_[0], "tcp")[2]
		257	or Carp::croak "$_[0]: service unknown"
		258	}
		259
		260	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
		261
		262	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
		264	textual IP address) and C<$service> (which can be a numeric port number or
		265	a service name, or a C<servicename=portnumber> string).
		266
		267	If both C<$host> and C<$port> are names, then this function will use SRV
		268	records to locate the real target(s).
		269
		270	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
		272	each in turn.
		273
		274	If the connect is successful, then the C<$connect_cb> will be invoked with
		275	the socket file handle (in non-blocking mode) as first and the peer host
		276	(as a textual IP address) and peer port as second and third arguments,
		277	respectively. The fourth argument is a code reference that you can call
		278	if, for some reason, you don't like this connection, which will cause
		279	C<tcp_connect> to try the next one (or call your callback without any
		280	arguments if there are no more connections). In most cases, you can simply
		281	ignore this argument.
		282
		283	$cb->($filehandle, $host, $port, $retry)
		284
		285	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>
		287	indicating a DNS resolution failure).
		288
		289	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.
		291
		292	Unless called in void context, C<tcp_connect> returns a guard object that
		293	will automatically abort connecting when it gets destroyed (it does not do
		294	anything to the socket after the connect was successful).
		295
		296	Sometimes you need to "prepare" the socket before connecting, for example,
		297	to C<bind> it to some port, or you want a specific connect timeout that
		298	is lower than your kernel's default timeout. In this case you can specify
		299	a second callback, C<$prepare_cb>. It will be called with the file handle
		300	in not-yet-connected state as only argument and must return the connection
		301	timeout value (or C<0>, C<undef> or the empty list to indicate the default
		302	timeout is to be used).
		303
		304	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).
		306
		307	Note to Microsoft Windows users: Windows (of course) doesn't correctly
		308	signal connection errors at all, so unless your event library works around
		309	this failed connections will simply hang and time-out. The only event
		310	library that handles this condition correctly is L<EV>, so this is highly
		311	recommended. To lessen the impact of this windows bug, a default timeout
		312	of 30 seconds will be imposed on windows. Cygwin is not affected.
		313
		314	Simple Example: connect to localhost on port 22.
		315
		316	tcp_connect localhost => 22, sub {
		317	my $fh = shift
		318	or die "unable to connect: $!";
		319	# do something
		320	};
		321
		322	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
		324	to 15 seconds.
		325
		326	tcp_connect "www.google.com", "http",
		327	sub {
		328	my ($fh) = @_
		329	or die "unable to connect: $!";
		330
		331	my $handle; # avoid direct assignment so on_eof has it in scope.
		332	$handle = new AnyEvent::Handle
		333	fh => $fh,
		334	on_eof => sub {
		335	undef $handle; # keep it alive till eof
		336	warn "done.\n";
		337	};
		338
		339	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
		340
		341	$handle->push_read_line ("\015\012\015\012", sub {
		342	my ($handle, $line) = @_;
		343
		344	# print response header
		345	print "HEADER\n$line\n\nBODY\n";
		346
		347	$handle->on_read (sub {
		348	# print response body
		349	print $_[0]->rbuf;
		350	$_[0]->rbuf = "";
		351	});
		352	});
		353	}, sub {
		354	my ($fh) = @_;
		355	# could call $fh->bind etc. here
		356
		357	15
		358	};
		359
		360	=cut
		361
		362	sub tcp_connect($$$;$) {
		363	my ($host, $port, $connect, $prepare) = @_;
		364
		365	# see http://cr.yp.to/docs/connect.html for some background
		366
		367	my %state = ( fh => undef );
		368
		369	# name resolution
		370	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
		371	my @target = @_;
		372
		373	$state{next} = sub {
		374	return unless exists $state{fh};
		375
		376	my $target = shift @target
		377	or do {
		378	%state = ();
		379	return $connect->();
		380	};
		381
		382	my ($domain, $type, $proto, $sockaddr) = @$target;
		383
		384	# socket creation
		385	socket $state{fh}, $domain, $type, $proto
		386	or return $state{next}();
		387
		388	fh_nonblocking $state{fh}, 1;
		389
		390	my $timeout = $prepare && $prepare->($state{fh});
		391
		392	$timeout \|\|= 30 if $^O =~ /mswin32/i;
		393
		394	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
		395	$! = &Errno::ETIMEDOUT;
		396	$state{next}();
		397	}) if $timeout;
		398
		399	# called when the connect was successful, which,
		400	# in theory, could be the case immediately (but never is in practise)
31	on_connect => sub {	401	my $connected = sub {
32	my ($ae_sock, $error) = @_;	402	delete $state{ww};
33	if ($error) {	403	delete $state{to};
34	warn "couldn't connect: $!";	404
		405	# we are connected, or maybe there was an error
		406	if (my $sin = getpeername $state{fh}) {
		407	my ($port, $host) = unpack_sockaddr $sin;
		408
		409	my $guard = guard {
		410	%state = ();
35	return;	411	};
		412
		413	$connect->($state{fh}, format_ip $host, $port, sub {
		414	$guard->cancel;
		415	$state{next}();
		416	});
36	} else {	417	} else {
37	print "connected to ".$ae_sock->fh->peerhost.":".$ae_sock->fh->peerport."\n";	418	# dummy read to fetch real error code
		419	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
		420	$state{next}();
38	}	421	}
39
40	$ae_sock->on_read (sub {
41	my ($ae_sock) = @_;
42	print "got data: [".${$ae_sock->rbuf}."]\n";
43	$ae_sock->rbuf = '';
44	});	422	};
45		423
46	$ae_sock->write ("GET / HTTP/1.0\015\012\015\012");	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 {
		430	%state = ();
		431	$connect->();
47	}	432	}
48	);
49
50	$cv->wait;
51
52	=head1 DESCRIPTION
53
54	L<AnyEvent::Socket> provides method to connect sockets and accept clients
55	on listening sockets.
56
57	=head1 EXAMPLES
58
59	See the C<eg/> directory of the L<AnyEvent> distribution for examples and also
60	the tests in C<t/handle/> can be helpful.
61
62	=head1 METHODS
63
64	=over 4
65
66	=item B<new (%args)>
67
68	The constructor gets the same arguments as the L<IO::Socket::INET> constructor.
69	Except that blocking will always be disabled and the hostname lookup is done by
70	L<AnyEvent::Util::inet_aton> before the socket (currently a L<IO::Socket::INET> instance)
71	is created.
72
73	Additionally you can set the callbacks that can be set in the L<AnyEvent::Handle>
74	constructor and these:
75
76	=over 4
77
78	=item on_connect => $cb
79
80	Installs a connect callback, that will be called when the name was successfully
81	resolved and the connection was successfully established or an error occured in
82	the lookup or connect.
83
84	The first argument to the callback C<$cb> will be the L<AnyEvent::Socket> itself
85	and the second is either a true value in case an error occured or undef.
86	The variable C<$!> will be set to one of these values:
87
88	=over 4
89
90	=item ENXIO
91
92	When the DNS lookup failed.
93
94	=item ETIMEDOUT
95
96	When the connect timed out.
97
98	=item *
99
100	Or any other errno as set by L<IO::Socket::INET> when it's constructor
101	failed or the connection couldn't be established for any other reason.
102
103	=back
104
105	=item on_accept
106
107	This sets the C<on_accept> callback by calling the C<on_accept> method.
108	See also below.
109
110	=back
111
112	=cut
113
114	sub new {
115	my $this = shift;
116	my $class = ref($this) \|\| $this;
117	my %args = @_;
118	my %self_args;
119
120	$self_args{$_} = delete $args{$_}
121	for grep { /^on_/ } keys %args;
122
123	my $self = $class->SUPER::new (%self_args);
124	$self->{sock_args} = \%args;
125
126	if (exists $args{PeerAddr} \|\| exists $args{PeerHost}) {
127	$self->{on_connect} \|\|= sub {
128	Carp::croak "Couldn't connect to $args{PeerHost}:$args{PeerPort}: $!"
129	if $_[1];
130	};	433	};
131	$self->_connect;	434
		435	$! = &Errno::ENXIO;
		436	$state{next}();
132	}	437	};
133		438
134	if ($self->{on_accept}) {	439	defined wantarray && guard { %state = () }
135	$self->on_accept ($self->{on_accept});	440	}
		441
		442	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
		443
		444	Create and bind a TCP socket to the given host, and port, set the
		445	SO_REUSEADDR flag and call C<listen>.
		446
		447	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
		448	binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
		449	preferred protocol).
		450
		451	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
		452	wildcard address, use C<::>.
		453
		454	The port is specified by C<$port>, which must be either a service name or
		455	a numeric port number (or C<0> or C<undef>, in which case an ephemeral
		456	port will be used).
		457
		458	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
		460	mode) as first and the peer host and port as second and third arguments
		461	(see C<tcp_connect> for details).
		462
		463	Croaks on any errors it can detect before the listen.
		464
		465	If called in non-void context, then this function returns a guard object
		466	whose lifetime it tied to the TCP server: If the object gets destroyed,
		467	the server will be stopped (but existing accepted connections will
		468	continue).
		469
		470	If you need more control over the listening socket, you can provide a
		471	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
		472	C<listen ()> call, with the listen file handle as first argument, and IP
		473	address and port number of the local socket endpoint as second and third
		474	arguments.
		475
		476	It should return the length of the listen queue (or C<0> for the default).
		477
		478	Example: bind on some TCP port on the local machine and tell each client
		479	to go away.
		480
		481	tcp_server undef, undef, sub {
		482	my ($fh, $host, $port) = @_;
		483
		484	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
		485	}, sub {
		486	my ($fh, $thishost, $thisport) = @_;
		487	warn "bound to $thishost, port $thisport\n";
		488	};
		489
		490	=cut
		491
		492	sub tcp_server($$$;$) {
		493	my ($host, $port, $accept, $prepare) = @_;
		494
		495	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
		496	? "::" : "0"
		497	unless defined $host;
		498
		499	my $ipn = parse_ip $host
		500	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";
		501
		502	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
		503
		504	my %state;
		505
		506	socket $state{fh}, $domain, SOCK_STREAM, 0
		507	or Carp::croak "socket: $!";
		508
		509	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
		510	or Carp::croak "so_reuseaddr: $!";
		511
		512	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
		513	or Carp::croak "bind: $!";
		514
		515	fh_nonblocking $state{fh}, 1;
		516
		517	my $len;
		518
		519	if ($prepare) {
		520	my ($port, $host) = unpack_sockaddr getsockname $state{fh};
		521	$len = $prepare && $prepare->($state{fh}, format_ip $host, $port);
136	}	522	}
137		523
138	return $self	524	$len \|\|= 128;
139	}
140		525
141	sub _connect {	526	listen $state{fh}, $len
142	my ($self) = @_;	527	or Carp::croak "listen: $!";
143		528
144	if (defined $self->{sock_args}->{Listen}) {	529	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
145	Carp::croak "connect can be done on a socket that has 'Listen' set!";	530	# this closure keeps $state alive
146	}	531	while (my $peer = accept my $fh, $state{fh}) {
147		532	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
148	if ($self->{sock_args}->{PeerAddr} =~ /^([^:]+)(?::(\d+))?$/) {	533	my ($port, $host) = unpack_sockaddr $peer;
149	$self->{sock_args}->{PeerHost} = $1;	534	$accept->($fh, format_ip $host, $port);
150	$self->{sock_args}->{PeerPort} = $2 if defined $2;
151	delete $self->{sock_args}->{PeerAddr};
152
153	$self->_lookup ($1);
154	return;
155
156	} elsif (my $h = $self->{sock_args}->{PeerHost}) {
157	$self->_lookup ($h);
158	return;
159
160	} else {
161	Carp::croak "no PeerAddr or PeerHost provided!";
162	}
163	}
164
165	=item B<on_accept ($cb)>
166
167	When the socket is run in listening mode (the C<Listen> argument of the socket
168	is set) this callback will be called when a new client connected.
169	The first argument to the callback will be the L<AnyEvent::Socket> object itself,
170	the second the L<AnyEvent::Handle> of the client socket and the third
171	is the peer address (depending on what C<accept> of L<IO::Socket> gives you>).
172
173	=cut
174
175	sub on_accept {
176	my ($self, $cb) = @_;
177
178	unless (defined $self->{sock_args}->{Listen}) {
179	$self->{sock_args}->{Listen} = 10;
180	}
181
182	$self->{fh} =
183	IO::Socket::INET->new (%{$self->{sock_args}}, Blocking => 0)
184	or Carp::croak ("couldn't create listening socket: $!");
185
186	$self->{list_w} =
187	AnyEvent->io (poll => 'r', fh => $self->{fh}, cb => sub {
188	my ($new_sock, $paddr) = $self->{fh}->accept ();
189	unless ($new_sock) {
190	$cb->($self);
191	delete $self->{list_w};
192	return;
193	}
194	my $ae_hdl = AnyEvent::Handle->new (fh => $new_sock);
195	$cb->($self, $ae_hdl, $paddr);
196	});
197	}
198
199	sub _lookup {
200	my ($self, $host) = @_;
201
202	AnyEvent::Util::inet_aton ($host, sub {
203	my ($addr) = @_;
204
205	if ($addr) {
206	$self->{sock_args}->{PeerHost} = inet_ntoa $addr;
207	$self->_real_connect;
208
209	} else {
210	$! = ENXIO;
211	$self->{on_connect}->($self, 1);
212	}	535	}
213	});	536	});
214	}
215		537
216	sub _real_connect {	538	defined wantarray
217	my ($self) = @_;	539	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
218		540	: ()
219	if (defined $self->{sock_args}->{Timeout}) {
220	$self->{dns_tmout} =
221	AnyEvent->timer (after => $self->{sock_args}->{Timeout}, cb => sub {
222	$! = ETIMEDOUT;
223	$self->{on_connect}->($self, 1);
224	});
225	}
226
227	$self->{fh} = IO::Socket::INET->new (%{$self->{sock_args}}, Blocking => 0);
228	unless ($self->{fh}) {
229	$self->{on_connect}->($self, 1);
230	return;
231	}
232
233	$self->{con_w} =
234	AnyEvent->io (poll => 'w', fh => $self->{fh}, cb => sub {
235	delete $self->{con_w};
236
237	if ($! = $self->{fh}->sockopt (SO_ERROR)) {
238	$self->{on_connect}->($self, 1);
239
240	} else {
241	$self->{on_connect}->($self);
242	}
243	});
244	}	541	}
		542
		543	1;
245		544
246	=back	545	=back
247		546
248	=head1 AUTHOR	547	=head1 AUTHOR
249		548
250	Robin Redeker, C<< <elmex at ta-sa.org> >>	549	Marc Lehmann <schmorp@schmorp.de>
		550	http://home.schmorp.de/
251		551
252	=head1 COPYRIGHT & LICENSE
253
254	Copyright 2008 Robin Redeker, all rights reserved.
255
256	This program is free software; you can redistribute it and/or modify it
257	under the same terms as Perl itself.
258
259	=cut	552	=cut
260		553
261	1; # End of AnyEvent

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.3 by elmex, Sun Apr 27 19:40:21 2008 UTC vs. Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.3 by elmex, Sun Apr 27 19:40:21 2008 UTC vs.
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC