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 qw(WIN32);
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).

Note to the poor Microsoft Windows users: Windows (of course) doesn't
correctly signal connection errors, so unless your event library works
around this, failed connections will simply hang. The only event libraries
that handle this condition correctly are L<EV> and L<Glib>. Additionally,
AnyEvent works around this bug with L<Event> and in its pure-perl
backend. All other libraries cannot correctly handle this condition. To
lessen the impact of this windows bug, a default timeout of 30 seconds
will be imposed on windows. Cygwin is not affected.

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;
         
         my $timeout = $prepare && $prepare->($state{fh});

         $timeout ||= 30 if WIN32;

         $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.28
Committed:	Mon May 26 05:09:53 2008 UTC (16 years, 1 month ago) by root
Branch:	MAIN
Changes since 1.27:	+10 -8 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.28	use AnyEvent qw(WIN32);
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	root	1.28	Note to the poor Microsoft Windows users: Windows (of course) doesn't
308			correctly signal connection errors, so unless your event library works
309			around this, failed connections will simply hang. The only event libraries
310			that handle this condition correctly are L<EV> and L<Glib>. Additionally,
311			AnyEvent works around this bug with L<Event> and in its pure-perl
312			backend. All other libraries cannot correctly handle this condition. To
313			lessen the impact of this windows bug, a default timeout of 30 seconds
314			will be imposed on windows. Cygwin is not affected.
315	root	1.27
316	root	1.7	Simple Example: connect to localhost on port 22.
317
318	root	1.8	tcp_connect localhost => 22, sub {
319	root	1.7	my $fh = shift
320			or die "unable to connect: $!";
321			# do something
322			};
323
324			Complex Example: connect to www.google.com on port 80 and make a simple
325			GET request without much error handling. Also limit the connection timeout
326			to 15 seconds.
327
328			tcp_connect "www.google.com", "http",
329			sub {
330			my ($fh) = @_
331			or die "unable to connect: $!";
332
333			my $handle; # avoid direct assignment so on_eof has it in scope.
334			$handle = new AnyEvent::Handle
335			fh => $fh,
336			on_eof => sub {
337			undef $handle; # keep it alive till eof
338			warn "done.\n";
339			};
340
341			$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
342
343			$handle->push_read_line ("\015\012\015\012", sub {
344			my ($handle, $line) = @_;
345
346			# print response header
347			print "HEADER\n$line\n\nBODY\n";
348
349			$handle->on_read (sub {
350			# print response body
351			print $_[0]->rbuf;
352			$_[0]->rbuf = "";
353			});
354			});
355			}, sub {
356			my ($fh) = @_;
357			# could call $fh->bind etc. here
358	elmex	1.2
359	root	1.7	15
360			};
361	elmex	1.2
362	root	1.7	=cut
363	elmex	1.2
364	root	1.7	sub tcp_connect($$$;$) {
365			my ($host, $port, $connect, $prepare) = @_;
366	elmex	1.2
367	root	1.7	# see http://cr.yp.to/docs/connect.html for some background
368	elmex	1.2
369	root	1.7	my %state = ( fh => undef );
370	elmex	1.2
371	root	1.7	# name resolution
372	root	1.15	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
373			my @target = @_;
374	root	1.7
375	root	1.15	$state{next} = sub {
376			return unless exists $state{fh};
377	root	1.7
378	root	1.15	my $target = shift @target
379			or do {
380			%state = ();
381			return $connect->();
382			};
383	root	1.7
384	root	1.15	my ($domain, $type, $proto, $sockaddr) = @$target;
385	root	1.7
386	root	1.15	# socket creation
387			socket $state{fh}, $domain, $type, $proto
388			or return $state{next}();
389
390			fh_nonblocking $state{fh}, 1;
391
392	root	1.27	my $timeout = $prepare && $prepare->($state{fh});
393
394	root	1.28	$timeout \|\|= 30 if WIN32;
395	root	1.15
396	root	1.27	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
397			$! = &Errno::ETIMEDOUT;
398			$state{next}();
399			}) if $timeout;
400	root	1.7
401	root	1.15	# called when the connect was successful, which,
402			# in theory, could be the case immediately (but never is in practise)
403			my $connected = sub {
404			delete $state{ww};
405			delete $state{to};
406
407			# we are connected, or maybe there was an error
408			if (my $sin = getpeername $state{fh}) {
409			my ($port, $host) = unpack_sockaddr $sin;
410
411			my $guard = guard {
412			%state = ();
413			};
414
415			$connect->($state{fh}, format_ip $host, $port, sub {
416			$guard->cancel;
417			$state{next}();
418			});
419			} else {
420			# dummy read to fetch real error code
421			sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
422			$state{next}();
423			}
424			};
425	elmex	1.1
426	root	1.15	# now connect
427			if (connect $state{fh}, $sockaddr) {
428			$connected->();
429			} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
430			$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
431	root	1.7	} else {
432	root	1.15	%state = ();
433	root	1.7	$connect->();
434			}
435			};
436	elmex	1.1
437	root	1.15	$! = &Errno::ENXIO;
438			$state{next}();
439	root	1.7	};
440	elmex	1.1
441	root	1.15	defined wantarray && guard { %state = () }
442	elmex	1.1	}
443
444	root	1.7	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
445
446	root	1.21	Create and bind a TCP socket to the given host, and port, set the
447			SO_REUSEADDR flag and call C<listen>.
448	elmex	1.1
449	root	1.21	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
450			binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
451			preferred protocol).
452
453			To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
454			wildcard address, use C<::>.
455
456			The port is specified by C<$port>, which must be either a service name or
457			a numeric port number (or C<0> or C<undef>, in which case an ephemeral
458			port will be used).
459
460			For each new connection that could be C<accept>ed, call the C<<
461			$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
462			mode) as first and the peer host and port as second and third arguments
463			(see C<tcp_connect> for details).
464
465			Croaks on any errors it can detect before the listen.
466	elmex	1.1
467	root	1.7	If called in non-void context, then this function returns a guard object
468	root	1.17	whose lifetime it tied to the TCP server: If the object gets destroyed,
469	root	1.7	the server will be stopped (but existing accepted connections will
470			continue).
471	elmex	1.1
472	root	1.7	If you need more control over the listening socket, you can provide a
473	root	1.21	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
474			C<listen ()> call, with the listen file handle as first argument, and IP
475			address and port number of the local socket endpoint as second and third
476			arguments.
477	elmex	1.2
478	root	1.7	It should return the length of the listen queue (or C<0> for the default).
479	elmex	1.2
480	root	1.24	Example: bind on some TCP port on the local machine and tell each client
481	root	1.7	to go away.
482	elmex	1.2
483	root	1.24	tcp_server undef, undef, sub {
484	root	1.7	my ($fh, $host, $port) = @_;
485	elmex	1.1
486	root	1.7	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
487	root	1.24	}, sub {
488			my ($fh, $thishost, $thisport) = @_;
489			warn "bound to $thishost, port $thisport\n";
490	root	1.7	};
491	elmex	1.1
492	root	1.7	=cut
493	elmex	1.1
494	root	1.7	sub tcp_server($$$;$) {
495			my ($host, $port, $accept, $prepare) = @_;
496	elmex	1.1
497	root	1.25	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
498	root	1.22	? "::" : "0"
499	root	1.21	unless defined $host;
500
501			my $ipn = parse_ip $host
502			or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";
503
504	root	1.23	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
505	root	1.21
506	root	1.7	my %state;
507	elmex	1.1
508	root	1.23	socket $state{fh}, $domain, SOCK_STREAM, 0
509	root	1.7	or Carp::croak "socket: $!";
510	elmex	1.1
511	root	1.23	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
512	root	1.7	or Carp::croak "so_reuseaddr: $!";
513	elmex	1.1
514	root	1.21	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
515	root	1.7	or Carp::croak "bind: $!";
516	elmex	1.1
517	root	1.7	fh_nonblocking $state{fh}, 1;
518	elmex	1.1
519	root	1.21	my $len;
520
521			if ($prepare) {
522			my ($port, $host) = unpack_sockaddr getsockname $state{fh};
523			$len = $prepare && $prepare->($state{fh}, format_ip $host, $port);
524			}
525
526			$len \|\|= 128;
527	elmex	1.1
528	root	1.7	listen $state{fh}, $len
529			or Carp::croak "listen: $!";
530	elmex	1.1
531	root	1.7	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
532			# this closure keeps $state alive
533			while (my $peer = accept my $fh, $state{fh}) {
534			fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
535	root	1.21	my ($port, $host) = unpack_sockaddr $peer;
536			$accept->($fh, format_ip $host, $port);
537	root	1.7	}
538			});
539	elmex	1.1
540	root	1.7	defined wantarray
541			? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
542			: ()
543	elmex	1.1	}
544
545	root	1.7	1;
546
547	elmex	1.1	=back
548
549			=head1 AUTHOR
550
551	root	1.7	Marc Lehmann <schmorp@schmorp.de>
552			http://home.schmorp.de/
553	elmex	1.1
554			=cut
555