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
 };

 # a simple tcp server
 tcp_server undef, 8888, sub {
    my ($fh, $host, $port) = @_;

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

=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';

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