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 qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);

use AnyEvent ();
use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
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). Note that scope-id's are not supported
(and will not parse).

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:)*(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",
         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 == AF_INET) {
      Socket::unpack_sockaddr_in $_[0]
   } elsif ($af == AF_INET6) {
      unpack "x2 n x4 a16", $_[0]
   } 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, and port, set the
SO_REUSEADDR flag and call C<listen>.

C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
preferred protocol).

To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
wildcard address, use C<::>.

The port is specified by C<$port>, which must be either a service name or
a numeric port number (or C<0> or C<undef>, in which case an ephemeral
port will be used).

For each new connection that could be C<accept>ed, call the C<<
$accept_cb->($fh, $host, $port) >> 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 it can detect before the listen.

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->($fh, $host, $port) >>, which is called just before the
C<listen ()> call, with the listen file handle as first argument, and IP
address and port number of the local socket endpoint as second and third
arguments.

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

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

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

      syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
   }, sub {
      my ($fh, $thishost, $thisport) = @_;
      warn "bound to $thishost, port $thisport\n";
   };

=cut

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

   $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
           ? "::" : "0"
      unless defined $host;

   my $ipn = parse_ip $host
      or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";

   my $domain = 4 == length $ipn ? AF_INET : AF_INET6;

   my %state;

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

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

   bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
      or Carp::croak "bind: $!";

   fh_nonblocking $state{fh}, 1;

   my $len;

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