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

# check for broken platforms with extra field in sockaddr structure
# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
# unix vs. bsd issue, a iso C vs. bsd issue or simply a
# correctness vs. bsd issue.
my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55"
                  ? "xC" : "S";

=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 "$pack_family nL 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 = Socket::sockaddr_family $_[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 AnyEvent::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{next}();
         }
      };

      $! = &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.32
Committed:	Mon May 26 17:45:05 2008 UTC (16 years, 1 month ago) by root
Branch:	MAIN
CVS Tags:	rel-4_05
Changes since 1.31:	+8 -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.30	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.32	# check for broken platforms with extra field in sockaddr structure
211			# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
212			# unix vs. bsd issue, a iso C vs. bsd issue or simply a
213			# correctness vs. bsd issue.
214			my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55"
215			? "xC" : "S";
216
217	root	1.15	=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
218
219	root	1.17	Pack the given port/host combination into a binary sockaddr structure. Handles
220	root	1.15	both IPv4 and IPv6 host addresses.
221
222			=cut
223
224			sub pack_sockaddr($$) {
225			if (4 == length $_[1]) {
226			Socket::pack_sockaddr_in $_[0], $_[1]
227			} elsif (16 == length $_[1]) {
228	root	1.32	pack "$pack_family nL a16 L",
229	root	1.21	AF_INET6,
230	root	1.15	$_[0], # port
231			0, # flowinfo
232			$_[1], # addr
233			0 # scope id
234			} else {
235			Carp::croak "pack_sockaddr: invalid host";
236			}
237			}
238
239			=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa
240
241			Unpack the given binary sockaddr structure (as used by bind, getpeername
242			etc.) into a C<$port, $host> combination.
243
244			Handles both IPv4 and IPv6 sockaddr structures.
245
246			=cut
247
248			sub unpack_sockaddr($) {
249	root	1.31	my $af = Socket::sockaddr_family $_[0];
250	root	1.15
251	root	1.23	if ($af == AF_INET) {
252	root	1.15	Socket::unpack_sockaddr_in $_[0]
253	root	1.21	} elsif ($af == AF_INET6) {
254			unpack "x2 n x4 a16", $_[0]
255	root	1.15	} else {
256			Carp::croak "unpack_sockaddr: unsupported protocol family $af";
257			}
258			}
259
260	root	1.7	sub _tcp_port($) {
261			$_[0] =~ /^(\d)$/ and return $11;
262	elmex	1.2
263	root	1.7	(getservbyname $_[0], "tcp")[2]
264			or Carp::croak "$_[0]: service unknown"
265			}
266	elmex	1.2
267	root	1.15	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
268	elmex	1.1
269	root	1.15	This is a convenience function that creates a TCP socket and makes a 100%
270	root	1.7	non-blocking connect to the given C<$host> (which can be a hostname or a
271	root	1.15	textual IP address) and C<$service> (which can be a numeric port number or
272			a service name, or a C<servicename=portnumber> string).
273	root	1.7
274	root	1.8	If both C<$host> and C<$port> are names, then this function will use SRV
275	root	1.15	records to locate the real target(s).
276	root	1.8
277	root	1.15	In either case, it will create a list of target hosts (e.g. for multihomed
278	root	1.17	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
279	root	1.15	each in turn.
280	root	1.7
281			If the connect is successful, then the C<$connect_cb> will be invoked with
282	root	1.17	the socket file handle (in non-blocking mode) as first and the peer host
283	root	1.7	(as a textual IP address) and peer port as second and third arguments,
284	root	1.15	respectively. The fourth argument is a code reference that you can call
285			if, for some reason, you don't like this connection, which will cause
286			C<tcp_connect> to try the next one (or call your callback without any
287			arguments if there are no more connections). In most cases, you can simply
288			ignore this argument.
289
290			$cb->($filehandle, $host, $port, $retry)
291	root	1.7
292			If the connect is unsuccessful, then the C<$connect_cb> will be invoked
293			without any arguments and C<$!> will be set appropriately (with C<ENXIO>
294	root	1.17	indicating a DNS resolution failure).
295	root	1.7
296	root	1.17	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
297			can be used as a normal perl file handle as well.
298	root	1.7
299	root	1.15	Unless called in void context, C<tcp_connect> returns a guard object that
300			will automatically abort connecting when it gets destroyed (it does not do
301			anything to the socket after the connect was successful).
302
303	root	1.7	Sometimes you need to "prepare" the socket before connecting, for example,
304			to C<bind> it to some port, or you want a specific connect timeout that
305			is lower than your kernel's default timeout. In this case you can specify
306			a second callback, C<$prepare_cb>. It will be called with the file handle
307			in not-yet-connected state as only argument and must return the connection
308			timeout value (or C<0>, C<undef> or the empty list to indicate the default
309			timeout is to be used).
310
311	root	1.17	Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
312	root	1.7	socket (although only IPv4 is currently supported by this module).
313
314	root	1.28	Note to the poor Microsoft Windows users: Windows (of course) doesn't
315			correctly signal connection errors, so unless your event library works
316			around this, failed connections will simply hang. The only event libraries
317			that handle this condition correctly are L<EV> and L<Glib>. Additionally,
318			AnyEvent works around this bug with L<Event> and in its pure-perl
319			backend. All other libraries cannot correctly handle this condition. To
320			lessen the impact of this windows bug, a default timeout of 30 seconds
321			will be imposed on windows. Cygwin is not affected.
322	root	1.27
323	root	1.7	Simple Example: connect to localhost on port 22.
324
325	root	1.8	tcp_connect localhost => 22, sub {
326	root	1.7	my $fh = shift
327			or die "unable to connect: $!";
328			# do something
329			};
330
331			Complex Example: connect to www.google.com on port 80 and make a simple
332			GET request without much error handling. Also limit the connection timeout
333			to 15 seconds.
334
335			tcp_connect "www.google.com", "http",
336			sub {
337			my ($fh) = @_
338			or die "unable to connect: $!";
339
340			my $handle; # avoid direct assignment so on_eof has it in scope.
341			$handle = new AnyEvent::Handle
342			fh => $fh,
343			on_eof => sub {
344			undef $handle; # keep it alive till eof
345			warn "done.\n";
346			};
347
348			$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
349
350			$handle->push_read_line ("\015\012\015\012", sub {
351			my ($handle, $line) = @_;
352
353			# print response header
354			print "HEADER\n$line\n\nBODY\n";
355
356			$handle->on_read (sub {
357			# print response body
358			print $_[0]->rbuf;
359			$_[0]->rbuf = "";
360			});
361			});
362			}, sub {
363			my ($fh) = @_;
364			# could call $fh->bind etc. here
365	elmex	1.2
366	root	1.7	15
367			};
368	elmex	1.2
369	root	1.7	=cut
370	elmex	1.2
371	root	1.7	sub tcp_connect($$$;$) {
372			my ($host, $port, $connect, $prepare) = @_;
373	elmex	1.2
374	root	1.7	# see http://cr.yp.to/docs/connect.html for some background
375	elmex	1.2
376	root	1.7	my %state = ( fh => undef );
377	elmex	1.2
378	root	1.7	# name resolution
379	root	1.15	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
380			my @target = @_;
381	root	1.7
382	root	1.15	$state{next} = sub {
383			return unless exists $state{fh};
384	root	1.7
385	root	1.15	my $target = shift @target
386			or do {
387			%state = ();
388			return $connect->();
389			};
390	root	1.7
391	root	1.15	my ($domain, $type, $proto, $sockaddr) = @$target;
392	root	1.7
393	root	1.15	# socket creation
394			socket $state{fh}, $domain, $type, $proto
395			or return $state{next}();
396
397			fh_nonblocking $state{fh}, 1;
398
399	root	1.27	my $timeout = $prepare && $prepare->($state{fh});
400
401	root	1.30	$timeout \|\|= 30 if AnyEvent::WIN32;
402	root	1.15
403	root	1.27	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
404			$! = &Errno::ETIMEDOUT;
405			$state{next}();
406			}) if $timeout;
407	root	1.7
408	root	1.15	# called when the connect was successful, which,
409			# in theory, could be the case immediately (but never is in practise)
410			my $connected = sub {
411			delete $state{ww};
412			delete $state{to};
413
414			# we are connected, or maybe there was an error
415			if (my $sin = getpeername $state{fh}) {
416			my ($port, $host) = unpack_sockaddr $sin;
417
418			my $guard = guard {
419			%state = ();
420			};
421
422			$connect->($state{fh}, format_ip $host, $port, sub {
423			$guard->cancel;
424			$state{next}();
425			});
426			} else {
427			# dummy read to fetch real error code
428			sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
429			$state{next}();
430			}
431			};
432	elmex	1.1
433	root	1.15	# now connect
434			if (connect $state{fh}, $sockaddr) {
435			$connected->();
436			} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
437			$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
438	root	1.7	} else {
439	root	1.29	$state{next}();
440	root	1.7	}
441			};
442	elmex	1.1
443	root	1.15	$! = &Errno::ENXIO;
444			$state{next}();
445	root	1.7	};
446	elmex	1.1
447	root	1.15	defined wantarray && guard { %state = () }
448	elmex	1.1	}
449
450	root	1.7	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
451
452	root	1.21	Create and bind a TCP socket to the given host, and port, set the
453			SO_REUSEADDR flag and call C<listen>.
454	elmex	1.1
455	root	1.21	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
456			binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
457			preferred protocol).
458
459			To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
460			wildcard address, use C<::>.
461
462			The port is specified by C<$port>, which must be either a service name or
463			a numeric port number (or C<0> or C<undef>, in which case an ephemeral
464			port will be used).
465
466			For each new connection that could be C<accept>ed, call the C<<
467			$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
468			mode) as first and the peer host and port as second and third arguments
469			(see C<tcp_connect> for details).
470
471			Croaks on any errors it can detect before the listen.
472	elmex	1.1
473	root	1.7	If called in non-void context, then this function returns a guard object
474	root	1.17	whose lifetime it tied to the TCP server: If the object gets destroyed,
475	root	1.7	the server will be stopped (but existing accepted connections will
476			continue).
477	elmex	1.1
478	root	1.7	If you need more control over the listening socket, you can provide a
479	root	1.21	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
480			C<listen ()> call, with the listen file handle as first argument, and IP
481			address and port number of the local socket endpoint as second and third
482			arguments.
483	elmex	1.2
484	root	1.7	It should return the length of the listen queue (or C<0> for the default).
485	elmex	1.2
486	root	1.24	Example: bind on some TCP port on the local machine and tell each client
487	root	1.7	to go away.
488	elmex	1.2
489	root	1.24	tcp_server undef, undef, sub {
490	root	1.7	my ($fh, $host, $port) = @_;
491	elmex	1.1
492	root	1.7	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
493	root	1.24	}, sub {
494			my ($fh, $thishost, $thisport) = @_;
495			warn "bound to $thishost, port $thisport\n";
496	root	1.7	};
497	elmex	1.1
498	root	1.7	=cut
499	elmex	1.1
500	root	1.7	sub tcp_server($$$;$) {
501			my ($host, $port, $accept, $prepare) = @_;
502	elmex	1.1
503	root	1.25	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
504	root	1.22	? "::" : "0"
505	root	1.21	unless defined $host;
506
507			my $ipn = parse_ip $host
508			or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";
509
510	root	1.23	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
511	root	1.21
512	root	1.7	my %state;
513	elmex	1.1
514	root	1.23	socket $state{fh}, $domain, SOCK_STREAM, 0
515	root	1.7	or Carp::croak "socket: $!";
516	elmex	1.1
517	root	1.23	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
518	root	1.7	or Carp::croak "so_reuseaddr: $!";
519	elmex	1.1
520	root	1.21	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
521	root	1.7	or Carp::croak "bind: $!";
522	elmex	1.1
523	root	1.7	fh_nonblocking $state{fh}, 1;
524	elmex	1.1
525	root	1.21	my $len;
526
527			if ($prepare) {
528			my ($port, $host) = unpack_sockaddr getsockname $state{fh};
529			$len = $prepare && $prepare->($state{fh}, format_ip $host, $port);
530			}
531
532			$len \|\|= 128;
533	elmex	1.1
534	root	1.7	listen $state{fh}, $len
535			or Carp::croak "listen: $!";
536	elmex	1.1
537	root	1.7	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
538			# this closure keeps $state alive
539			while (my $peer = accept my $fh, $state{fh}) {
540			fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
541	root	1.21	my ($port, $host) = unpack_sockaddr $peer;
542			$accept->($fh, format_ip $host, $port);
543	root	1.7	}
544			});
545	elmex	1.1
546	root	1.7	defined wantarray
547			? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
548			: ()
549	elmex	1.1	}
550
551	root	1.7	1;
552
553	elmex	1.1	=back
554
555			=head1 AUTHOR
556
557	root	1.7	Marc Lehmann <schmorp@schmorp.de>
558			http://home.schmorp.de/
559	elmex	1.1
560			=cut
561