lib/AnyEvent/Socket.pm

=head1 NAME

AnyEvent::Socket - useful IPv4 and IPv6 stuff.

=head1 SYNOPSIS

 use AnyEvent::Socket;

 tcp_connect "gameserver.deliantra.net", 13327, sub {
    my ($fh) = @_
       or die "gameserver.deliantra.net connect failed: $!";

    # enjoy your filehandle
 };

=head1 DESCRIPTION

This module implements various utility functions for handling internet
protocol addresses and sockets, in an as transparent and simple way as
possible.

All functions documented without C<AnyEvent::Socket::> prefix are exported
by default.

=over 4

=cut

package AnyEvent::Socket;

no warnings;
use strict;

use Carp ();
use Errno ();
use Socket ();

use AnyEvent ();
use AnyEvent::Util qw(guard fh_nonblocking);
use AnyEvent::DNS ();

use base 'Exporter';

BEGIN {
   *socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
}

BEGIN {
   my $af_inet6 = eval { &Socket::AF_INET6 };
   eval "sub AF_INET6() { $af_inet6 }"; die if $@;

   delete $AnyEvent::PROTOCOL{ipv6} unless $af_inet6;
}

our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);

our $VERSION = '1.0';

=item $ipn = parse_ipv4 $dotted_quad

Tries to parse the given dotted quad IPv4 address and return it in
octet form (or undef when it isn't in a parsable format). Supports all
forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>,
C<0x12345678> or C<0377.0377.0377.0377>).

=cut

sub parse_ipv4($) {
   $_[0] =~ /^      (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* )
              (?:\. (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) ){0,3}$/x
      or return undef;

   @_ = map /^0/ ? oct : $_, split /\./, $_[0];

   # check leading parts against range
   return undef if grep $_ >= 256, @_[0 .. @_ - 2];

   # check trailing part against range
   return undef if $_[-1] >= 1 << (8 * (4 - $#_));

   pack "N", (pop)
             + ($_[0] << 24)
             + ($_[1] << 16)
             + ($_[2] <<  8);
}

=item $ipn = parse_ipv6 $textual_ipv6_address

Tries to parse the given IPv6 address and return it in
octet form (or undef when it isn't in a parsable format).

Should support all forms specified by RFC 2373 (and additionally all IPv4
forms supported by parse_ipv4).

This function works similarly to C<inet_pton AF_INET6, ...>.

=cut

sub parse_ipv6($) {
   # quick test to avoid longer processing
   my $n = $_[0] =~ y/://;
   return undef if $n < 2 || $n > 8;

   my ($h, $t) = split /::/, $_[0], 2;

   unless (defined $t) {
      ($h, $t) = (undef, $h);
   }

   my @h = split /:/, $h;
   my @t = split /:/, $t;

   # check for ipv4 tail
   if (@t && $t[-1]=~ /\./) {
      return undef if $n > 6;

      my $ipn = parse_ipv4 pop @t
         or return undef;

      push @t, map +(sprintf "%x", $_), unpack "nn", $ipn;
   }

   # no :: then we need to have exactly 8 components
   return undef unless @h + @t == 8 || $_[0] =~ /::/;

   # now check all parts for validity
   return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t;

   # now pad...
   push @h, 0 while @h + @t < 8;

   # and done
   pack "n*", map hex, @h, @t
}

=item $ipn = parse_ip $text

Combines C<parse_ipv4> and C<parse_ipv6> in one function.

=cut

sub parse_ip($) {
   &parse_ipv4 || &parse_ipv6
}

=item $text = format_ip $ipn

Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)
and converts it into textual form.

This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
except it automatically detects the address type.

=cut

sub format_ip;
sub format_ip($) {
   if (4 == length $_[0]) {
      return join ".", unpack "C4", $_[0]
   } elsif (16 == length $_[0]) {
      if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
         # v4mapped
         return "::ffff:" . format_ip substr $_[0], 12;
      } else {
         my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];

         $ip =~ s/^0:(?:0:)*/::/
            or $ip =~ s/(:0)+$/::/
            or $ip =~ s/(:0)+/:/;
         return $ip
      }
   } else {
      return undef
   }
}

=item inet_aton $name_or_address, $cb->(@addresses)

Works similarly to its Socket counterpart, except that it uses a
callback. Also, if a host has only an IPv6 address, this might be passed
to the callback instead (use the length to detect this - 4 for IPv4, 16
for IPv6).

Unlike the L<Socket> function of the same name, you can get multiple IPv4
and IPv6 addresses as result.

=cut

sub inet_aton {
   my ($name, $cb) = @_;

   if (my $ipn = &parse_ipv4) {
      $cb->($ipn);
   } elsif (my $ipn = &parse_ipv6) {
      $cb->($ipn);
   } elsif ($name eq "localhost") { # rfc2606 et al.
      $cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
   } else {
      require AnyEvent::DNS;

      # simple, bad suboptimal algorithm
      AnyEvent::DNS::a ($name, sub {
         if (@_) {
            $cb->(map +(parse_ipv4 $_), @_);
         } else {
            $cb->();
            #AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
         }
      });
   }
}

=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host

Pack the given port/host combination into a binary sockaddr structure. Handles
both IPv4 and IPv6 host addresses.

=cut

sub pack_sockaddr($$) {
   if (4 == length $_[1]) {
      Socket::pack_sockaddr_in $_[0], $_[1]
   } elsif (16 == length $_[1]) {
      pack "SnL a16 L",
         Socket::AF_INET6,
         $_[0], # port
         0,     # flowinfo
         $_[1], # addr
         0      # scope id
   } else {
      Carp::croak "pack_sockaddr: invalid host";
   }
}

=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa

Unpack the given binary sockaddr structure (as used by bind, getpeername
etc.) into a C<$port, $host> combination.

Handles both IPv4 and IPv6 sockaddr structures.

=cut

sub unpack_sockaddr($) {
   my $af = unpack "S", $_[0];

   if ($af == &Socket::AF_INET) {
      Socket::unpack_sockaddr_in $_[0]
   } elsif ($af == AF_INET6) {
      (unpack "SnL a16 L")[1, 3]
   } else {
      Carp::croak "unpack_sockaddr: unsupported protocol family $af";
   }
}

sub _tcp_port($) {
   $_[0] =~ /^(\d*)$/ and return $1*1;

   (getservbyname $_[0], "tcp")[2]
      or Carp::croak "$_[0]: service unknown"
}

=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]

This is a convenience function that creates a TCP socket and makes a 100%
non-blocking connect to the given C<$host> (which can be a hostname or a
textual IP address) and C<$service> (which can be a numeric port number or
a service name, or a C<servicename=portnumber> string).

If both C<$host> and C<$port> are names, then this function will use SRV
records to locate the real target(s).

In either case, it will create a list of target hosts (e.g. for multihomed
hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
each in turn.

If the connect is successful, then the C<$connect_cb> will be invoked with
the socket file handle (in non-blocking mode) as first and the peer host
(as a textual IP address) and peer port as second and third arguments,
respectively. The fourth argument is a code reference that you can call
if, for some reason, you don't like this connection, which will cause
C<tcp_connect> to try the next one (or call your callback without any
arguments if there are no more connections). In most cases, you can simply
ignore this argument.

   $cb->($filehandle, $host, $port, $retry)

If the connect is unsuccessful, then the C<$connect_cb> will be invoked
without any arguments and C<$!> will be set appropriately (with C<ENXIO>
indicating a DNS resolution failure).

The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
can be used as a normal perl file handle as well.

Unless called in void context, C<tcp_connect> returns a guard object that
will automatically abort connecting when it gets destroyed (it does not do
anything to the socket after the connect was successful).

Sometimes you need to "prepare" the socket before connecting, for example,
to C<bind> it to some port, or you want a specific connect timeout that
is lower than your kernel's default timeout. In this case you can specify
a second callback, C<$prepare_cb>. It will be called with the file handle
in not-yet-connected state as only argument and must return the connection
timeout value (or C<0>, C<undef> or the empty list to indicate the default
timeout is to be used).

Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
socket (although only IPv4 is currently supported by this module).

Simple Example: connect to localhost on port 22.

  tcp_connect localhost => 22, sub {
     my $fh = shift
        or die "unable to connect: $!";
     # do something
  };

Complex Example: connect to www.google.com on port 80 and make a simple
GET request without much error handling. Also limit the connection timeout
to 15 seconds.

   tcp_connect "www.google.com", "http",
      sub {
         my ($fh) = @_
            or die "unable to connect: $!";

         my $handle; # avoid direct assignment so on_eof has it in scope.
         $handle = new AnyEvent::Handle
            fh     => $fh,
            on_eof => sub {
               undef $handle; # keep it alive till eof
               warn "done.\n";
            };

         $handle->push_write ("GET / HTTP/1.0\015\012\015\012");

         $handle->push_read_line ("\015\012\015\012", sub {
            my ($handle, $line) = @_;

            # print response header
            print "HEADER\n$line\n\nBODY\n";

            $handle->on_read (sub {
               # print response body
               print $_[0]->rbuf;
               $_[0]->rbuf = "";
            });
         });
      }, sub {
         my ($fh) = @_;
         # could call $fh->bind etc. here

         15
      };

=cut

sub tcp_connect($$$;$) {
   my ($host, $port, $connect, $prepare) = @_;

   # see http://cr.yp.to/docs/connect.html for some background

   my %state = ( fh => undef );

   # name resolution
   AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
      my @target = @_;

      $state{next} = sub {
         return unless exists $state{fh};

         my $target = shift @target
            or do {
               %state = ();
               return $connect->();
            };

         my ($domain, $type, $proto, $sockaddr) = @$target;

         # socket creation
         socket $state{fh}, $domain, $type, $proto
            or return $state{next}();

         fh_nonblocking $state{fh}, 1;
         
         # prepare and optional timeout
         if ($prepare) {
            my $timeout = $prepare->($state{fh});

            $state{to} = AnyEvent->timer (after => $timeout, cb => sub {
               $! = &Errno::ETIMEDOUT;
               $state{next}();
            }) if $timeout;
         }

         # called when the connect was successful, which,
         # in theory, could be the case immediately (but never is in practise)
         my $connected = sub {
            delete $state{ww};
            delete $state{to};

            # we are connected, or maybe there was an error
            if (my $sin = getpeername $state{fh}) {
               my ($port, $host) = unpack_sockaddr $sin;

               my $guard = guard {
                  %state = ();
               };

               $connect->($state{fh}, format_ip $host, $port, sub {
                  $guard->cancel;
                  $state{next}();
               });
            } else {
               # dummy read to fetch real error code
               sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
               $state{next}();
            }
         };

         # now connect       
         if (connect $state{fh}, $sockaddr) {
            $connected->();
         } elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
            $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
         } else {
            %state = ();
            $connect->();
         }
      };

      $! = &Errno::ENXIO;
      $state{next}();
   };

   defined wantarray && guard { %state = () }
}

=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]

Create and bind a TCP socket to the given host (any IPv4 host if undef,
otherwise it must be an IPv4 or IPv6 address) and port (service name or
numeric port number, or an ephemeral port if given as zero or undef), set
the SO_REUSEADDR flag and call C<listen>.

For each new connection that could be C<accept>ed, call the C<$accept_cb>
with the file handle (in non-blocking mode) as first and the peer host and
port as second and third arguments (see C<tcp_connect> for details).

Croaks on any errors.

If called in non-void context, then this function returns a guard object
whose lifetime it tied to the TCP server: If the object gets destroyed,
the server will be stopped (but existing accepted connections will
continue).

If you need more control over the listening socket, you can provide a
C<$prepare_cb>, which is called just before the C<listen ()> call, with
the listen file handle as first argument.

It should return the length of the listen queue (or C<0> for the default).

Example: bind on TCP port 8888 on the local machine and tell each client
to go away.

   tcp_server undef, 8888, sub {
      my ($fh, $host, $port) = @_;

      syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
   };

=cut

sub tcp_server($$$;$) {
   my ($host, $port, $accept, $prepare) = @_;

   my %state;

   socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
      or Carp::croak "socket: $!";

   setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1
      or Carp::croak "so_reuseaddr: $!";

   bind $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, socket_inet_aton ($host || "0.0.0.0")
      or Carp::croak "bind: $!";

   fh_nonblocking $state{fh}, 1;

   my $len = ($prepare && $prepare->($state{fh})) || 128;

   listen $state{fh}, $len
      or Carp::croak "listen: $!";

   $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
      # this closure keeps $state alive
      while (my $peer = accept my $fh, $state{fh}) {
         fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
         my ($port, $host) = Socket::unpack_sockaddr_in $peer;
         $accept->($fh, (Socket::inet_ntoa $host), $port);
      }
   });

   defined wantarray
      ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
      : ()
}

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.18
Committed:	Sat May 24 18:50:40 2008 UTC (16 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.17:	+7 -0 lines
Log Message:	* empty log message *
#	Content
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	=head1 DESCRIPTION
17
18	This module implements various utility functions for handling internet
19	protocol addresses and sockets, in an as transparent and simple way as
20	possible.
21
22	All functions documented without C<AnyEvent::Socket::> prefix are exported
23	by default.
24
25	=over 4
26
27	=cut
28
29	package AnyEvent::Socket;
30
31	no warnings;
32	use strict;
33
34	use Carp ();
35	use Errno ();
36	use Socket ();
37
38	use AnyEvent ();
39	use AnyEvent::Util qw(guard fh_nonblocking);
40	use AnyEvent::DNS ();
41
42	use base 'Exporter';
43
44	BEGIN {
45	*socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
46	}
47
48	BEGIN {
49	my $af_inet6 = eval { &Socket::AF_INET6 };
50	eval "sub AF_INET6() { $af_inet6 }"; die if $@;
51
52	delete $AnyEvent::PROTOCOL{ipv6} unless $af_inet6;
53	}
54
55	our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);
56
57	our $VERSION = '1.0';
58
59	=item $ipn = parse_ipv4 $dotted_quad
60
61	Tries to parse the given dotted quad IPv4 address and return it in
62	octet form (or undef when it isn't in a parsable format). Supports all
63	forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>,
64	C<0x12345678> or C<0377.0377.0377.0377>).
65
66	=cut
67
68	sub parse_ipv4($) {
69	$_[0] =~ /^ (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* )
70	(?:\. (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* ) ){0,3}$/x
71	or return undef;
72
73	@_ = map /^0/ ? oct : $_, split /\./, $_[0];
74
75	# check leading parts against range
76	return undef if grep $_ >= 256, @_[0 .. @_ - 2];
77
78	# check trailing part against range
79	return undef if $_[-1] >= 1 << (8 * (4 - $#_));
80
81	pack "N", (pop)
82	+ ($_[0] << 24)
83	+ ($_[1] << 16)
84	+ ($_[2] << 8);
85	}
86
87	=item $ipn = parse_ipv6 $textual_ipv6_address
88
89	Tries to parse the given IPv6 address and return it in
90	octet form (or undef when it isn't in a parsable format).
91
92	Should support all forms specified by RFC 2373 (and additionally all IPv4
93	forms supported by parse_ipv4).
94
95	This function works similarly to C<inet_pton AF_INET6, ...>.
96
97	=cut
98
99	sub parse_ipv6($) {
100	# quick test to avoid longer processing
101	my $n = $_[0] =~ y/://;
102	return undef if $n < 2 \|\| $n > 8;
103
104	my ($h, $t) = split /::/, $_[0], 2;
105
106	unless (defined $t) {
107	($h, $t) = (undef, $h);
108	}
109
110	my @h = split /:/, $h;
111	my @t = split /:/, $t;
112
113	# check for ipv4 tail
114	if (@t && $t[-1]=~ /\./) {
115	return undef if $n > 6;
116
117	my $ipn = parse_ipv4 pop @t
118	or return undef;
119
120	push @t, map +(sprintf "%x", $_), unpack "nn", $ipn;
121	}
122
123	# no :: then we need to have exactly 8 components
124	return undef unless @h + @t == 8 \|\| $_[0] =~ /::/;
125
126	# now check all parts for validity
127	return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t;
128
129	# now pad...
130	push @h, 0 while @h + @t < 8;
131
132	# and done
133	pack "n*", map hex, @h, @t
134	}
135
136	=item $ipn = parse_ip $text
137
138	Combines C<parse_ipv4> and C<parse_ipv6> in one function.
139
140	=cut
141
142	sub parse_ip($) {
143	&parse_ipv4 \|\| &parse_ipv6
144	}
145
146	=item $text = format_ip $ipn
147
148	Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)
149	and converts it into textual form.
150
151	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,
152	except it automatically detects the address type.
153
154	=cut
155
156	sub format_ip;
157	sub format_ip($) {
158	if (4 == length $_[0]) {
159	return join ".", unpack "C4", $_[0]
160	} elsif (16 == length $_[0]) {
161	if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
162	# v4mapped
163	return "::ffff:" . format_ip substr $_[0], 12;
164	} else {
165	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
166
167	$ip =~ s/^0:(?:0:)*/::/
168	or $ip =~ s/(:0)+$/::/
169	or $ip =~ s/(:0)+/:/;
170	return $ip
171	}
172	} else {
173	return undef
174	}
175	}
176
177	=item inet_aton $name_or_address, $cb->(@addresses)
178
179	Works similarly to its Socket counterpart, except that it uses a
180	callback. Also, if a host has only an IPv6 address, this might be passed
181	to the callback instead (use the length to detect this - 4 for IPv4, 16
182	for IPv6).
183
184	Unlike the L<Socket> function of the same name, you can get multiple IPv4
185	and IPv6 addresses as result.
186
187	=cut
188
189	sub inet_aton {
190	my ($name, $cb) = @_;
191
192	if (my $ipn = &parse_ipv4) {
193	$cb->($ipn);
194	} elsif (my $ipn = &parse_ipv6) {
195	$cb->($ipn);
196	} elsif ($name eq "localhost") { # rfc2606 et al.
197	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
198	} else {
199	require AnyEvent::DNS;
200
201	# simple, bad suboptimal algorithm
202	AnyEvent::DNS::a ($name, sub {
203	if (@_) {
204	$cb->(map +(parse_ipv4 $_), @_);
205	} else {
206	$cb->();
207	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
208	}
209	});
210	}
211	}
212
213	=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
214
215	Pack the given port/host combination into a binary sockaddr structure. Handles
216	both IPv4 and IPv6 host addresses.
217
218	=cut
219
220	sub pack_sockaddr($$) {
221	if (4 == length $_[1]) {
222	Socket::pack_sockaddr_in $_[0], $_[1]
223	} elsif (16 == length $_[1]) {
224	pack "SnL a16 L",
225	Socket::AF_INET6,
226	$_[0], # port
227	0, # flowinfo
228	$_[1], # addr
229	0 # scope id
230	} else {
231	Carp::croak "pack_sockaddr: invalid host";
232	}
233	}
234
235	=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa
236
237	Unpack the given binary sockaddr structure (as used by bind, getpeername
238	etc.) into a C<$port, $host> combination.
239
240	Handles both IPv4 and IPv6 sockaddr structures.
241
242	=cut
243
244	sub unpack_sockaddr($) {
245	my $af = unpack "S", $_[0];
246
247	if ($af == &Socket::AF_INET) {
248	Socket::unpack_sockaddr_in $_[0]
249	} elsif ($af == AF_INET6) {
250	(unpack "SnL a16 L")[1, 3]
251	} else {
252	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
253	}
254	}
255
256	sub _tcp_port($) {
257	$_[0] =~ /^(\d)$/ and return $11;
258
259	(getservbyname $_[0], "tcp")[2]
260	or Carp::croak "$_[0]: service unknown"
261	}
262
263	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
264
265	This is a convenience function that creates a TCP socket and makes a 100%
266	non-blocking connect to the given C<$host> (which can be a hostname or a
267	textual IP address) and C<$service> (which can be a numeric port number or
268	a service name, or a C<servicename=portnumber> string).
269
270	If both C<$host> and C<$port> are names, then this function will use SRV
271	records to locate the real target(s).
272
273	In either case, it will create a list of target hosts (e.g. for multihomed
274	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
275	each in turn.
276
277	If the connect is successful, then the C<$connect_cb> will be invoked with
278	the socket file handle (in non-blocking mode) as first and the peer host
279	(as a textual IP address) and peer port as second and third arguments,
280	respectively. The fourth argument is a code reference that you can call
281	if, for some reason, you don't like this connection, which will cause
282	C<tcp_connect> to try the next one (or call your callback without any
283	arguments if there are no more connections). In most cases, you can simply
284	ignore this argument.
285
286	$cb->($filehandle, $host, $port, $retry)
287
288	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
289	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
290	indicating a DNS resolution failure).
291
292	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
293	can be used as a normal perl file handle as well.
294
295	Unless called in void context, C<tcp_connect> returns a guard object that
296	will automatically abort connecting when it gets destroyed (it does not do
297	anything to the socket after the connect was successful).
298
299	Sometimes you need to "prepare" the socket before connecting, for example,
300	to C<bind> it to some port, or you want a specific connect timeout that
301	is lower than your kernel's default timeout. In this case you can specify
302	a second callback, C<$prepare_cb>. It will be called with the file handle
303	in not-yet-connected state as only argument and must return the connection
304	timeout value (or C<0>, C<undef> or the empty list to indicate the default
305	timeout is to be used).
306
307	Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
308	socket (although only IPv4 is currently supported by this module).
309
310	Simple Example: connect to localhost on port 22.
311
312	tcp_connect localhost => 22, sub {
313	my $fh = shift
314	or die "unable to connect: $!";
315	# do something
316	};
317
318	Complex Example: connect to www.google.com on port 80 and make a simple
319	GET request without much error handling. Also limit the connection timeout
320	to 15 seconds.
321
322	tcp_connect "www.google.com", "http",
323	sub {
324	my ($fh) = @_
325	or die "unable to connect: $!";
326
327	my $handle; # avoid direct assignment so on_eof has it in scope.
328	$handle = new AnyEvent::Handle
329	fh => $fh,
330	on_eof => sub {
331	undef $handle; # keep it alive till eof
332	warn "done.\n";
333	};
334
335	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
336
337	$handle->push_read_line ("\015\012\015\012", sub {
338	my ($handle, $line) = @_;
339
340	# print response header
341	print "HEADER\n$line\n\nBODY\n";
342
343	$handle->on_read (sub {
344	# print response body
345	print $_[0]->rbuf;
346	$_[0]->rbuf = "";
347	});
348	});
349	}, sub {
350	my ($fh) = @_;
351	# could call $fh->bind etc. here
352
353	15
354	};
355
356	=cut
357
358	sub tcp_connect($$$;$) {
359	my ($host, $port, $connect, $prepare) = @_;
360
361	# see http://cr.yp.to/docs/connect.html for some background
362
363	my %state = ( fh => undef );
364
365	# name resolution
366	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
367	my @target = @_;
368
369	$state{next} = sub {
370	return unless exists $state{fh};
371
372	my $target = shift @target
373	or do {
374	%state = ();
375	return $connect->();
376	};
377
378	my ($domain, $type, $proto, $sockaddr) = @$target;
379
380	# socket creation
381	socket $state{fh}, $domain, $type, $proto
382	or return $state{next}();
383
384	fh_nonblocking $state{fh}, 1;
385
386	# prepare and optional timeout
387	if ($prepare) {
388	my $timeout = $prepare->($state{fh});
389
390	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
391	$! = &Errno::ETIMEDOUT;
392	$state{next}();
393	}) if $timeout;
394	}
395
396	# called when the connect was successful, which,
397	# in theory, could be the case immediately (but never is in practise)
398	my $connected = sub {
399	delete $state{ww};
400	delete $state{to};
401
402	# we are connected, or maybe there was an error
403	if (my $sin = getpeername $state{fh}) {
404	my ($port, $host) = unpack_sockaddr $sin;
405
406	my $guard = guard {
407	%state = ();
408	};
409
410	$connect->($state{fh}, format_ip $host, $port, sub {
411	$guard->cancel;
412	$state{next}();
413	});
414	} else {
415	# dummy read to fetch real error code
416	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
417	$state{next}();
418	}
419	};
420
421	# now connect
422	if (connect $state{fh}, $sockaddr) {
423	$connected->();
424	} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
425	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
426	} else {
427	%state = ();
428	$connect->();
429	}
430	};
431
432	$! = &Errno::ENXIO;
433	$state{next}();
434	};
435
436	defined wantarray && guard { %state = () }
437	}
438
439	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
440
441	Create and bind a TCP socket to the given host (any IPv4 host if undef,
442	otherwise it must be an IPv4 or IPv6 address) and port (service name or
443	numeric port number, or an ephemeral port if given as zero or undef), set
444	the SO_REUSEADDR flag and call C<listen>.
445
446	For each new connection that could be C<accept>ed, call the C<$accept_cb>
447	with the file handle (in non-blocking mode) as first and the peer host and
448	port as second and third arguments (see C<tcp_connect> for details).
449
450	Croaks on any errors.
451
452	If called in non-void context, then this function returns a guard object
453	whose lifetime it tied to the TCP server: If the object gets destroyed,
454	the server will be stopped (but existing accepted connections will
455	continue).
456
457	If you need more control over the listening socket, you can provide a
458	C<$prepare_cb>, which is called just before the C<listen ()> call, with
459	the listen file handle as first argument.
460
461	It should return the length of the listen queue (or C<0> for the default).
462
463	Example: bind on TCP port 8888 on the local machine and tell each client
464	to go away.
465
466	tcp_server undef, 8888, sub {
467	my ($fh, $host, $port) = @_;
468
469	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
470	};
471
472	=cut
473
474	sub tcp_server($$$;$) {
475	my ($host, $port, $accept, $prepare) = @_;
476
477	my %state;
478
479	socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
480	or Carp::croak "socket: $!";
481
482	setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1
483	or Carp::croak "so_reuseaddr: $!";
484
485	bind $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, socket_inet_aton ($host \|\| "0.0.0.0")
486	or Carp::croak "bind: $!";
487
488	fh_nonblocking $state{fh}, 1;
489
490	my $len = ($prepare && $prepare->($state{fh})) \|\| 128;
491
492	listen $state{fh}, $len
493	or Carp::croak "listen: $!";
494
495	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
496	# this closure keeps $state alive
497	while (my $peer = accept my $fh, $state{fh}) {
498	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
499	my ($port, $host) = Socket::unpack_sockaddr_in $peer;
500	$accept->($fh, (Socket::inet_ntoa $host), $port);
501	}
502	});
503
504	defined wantarray
505	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
506	: ()
507	}
508
509	1;
510
511	=back
512
513	=head1 AUTHOR
514
515	Marc Lehmann <schmorp@schmorp.de>
516	http://home.schmorp.de/
517
518	=cut
519