lib/AnyEvent/Socket.pm

=head1 NAME

AnyEvent::Socket - useful IPv4 and IPv6 stuff.

=head1 SYNOPSIS

 use AnyEvent::Socket;

=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 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/hst 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 "SSL 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 "SSL 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 addrsesses) and try to connetc to
each in turn.

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