[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Socket.pm

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.36 by root, Wed May 28 21:29:03 2008 UTC vs.
Revision 1.50 by root, Fri Jun 6 15:35:30 2008 UTC

 AnyEvent::Socket - useful IPv4 and IPv6 stuff.
 =head1 SYNOPSIS
- use AnyEvent::Socket;
+   use AnyEvent::Socket;
- tcp_connect "gameserver.deliantra.net", 13327, sub {
+   tcp_connect "gameserver.deliantra.net", 13327, sub {
-    my ($fh) = @_
+      my ($fh) = @_
-       or die "gameserver.deliantra.net connect failed: $!";
+         or die "gameserver.deliantra.net connect failed: $!";
-    # enjoy your filehandle
+      # enjoy your filehandle
- };
+   };
- # a simple tcp server
+   # a simple tcp server
- tcp_server undef, 8888, sub {
+   tcp_server undef, 8888, sub {
-    my ($fh, $host, $port) = @_;
+      my ($fh, $host, $port) = @_;
-    syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
+      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
    inet_aton
    tcp_server
    tcp_connect
 );
-our $VERSION = '1.0';
+our $VERSION = 4.151;
 =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
 sub format_address($) {
    my $af = address_family $_[0];
    if ($af == AF_INET) {
       return join ".", unpack "C4", $_[0]
    } elsif ($af == AF_INET6) {
+      if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
+         return "::";
+      } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
+         return "::1";
-      if (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
+      } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
          # v4compatible
          return "::" . format_address substr $_[0], 12;
       } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
          # v4mapped
          return "::ffff:" . format_address substr $_[0], 12;
          # v4translated
          return "::ffff:0:" . format_address substr $_[0], 12;
       } else {
          my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
+         # this is rather sucky, I admit
          $ip =~ s/^0:(?:0:)*(0$)?/::/
-            or $ip =~ s/(:0)+$/::/
+            or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
-            or $ip =~ s/(:0)+/:/;
+            or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
+            or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
+            or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
+            or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
+            or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
+            or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
          return $ip
       }
    } elsif ($af == AF_UNIX) {
       return "unix/"
    } else {
 # 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"
+my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")
                   ? "xC" : "S";
 =item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
 Pack the given port/host combination into a binary sockaddr
       $cv->begin;
       for my $idx (0 .. $#target) {
          my ($node, $port) = @{ $target[$idx] };
          if (my $noden = parse_address $node) {
+            my $af = address_family $noden;
-            if (4 == length $noden && $family != 6) {
+            if ($af == AF_INET && $family != 6) {
                push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
                            pack_sockaddr $port, $noden]]
             }
-            if (16 == length $noden && $family != 4) {
+            if ($af == AF_INET6 && $family != 4) {
                push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
                            pack_sockaddr $port, $noden]]
             }
          } else {
             # ipv4
             if ($family != 6) {
                $cv->begin;
-               a $node, sub {
+               AnyEvent::DNS::a $node, sub {
                   push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
                               pack_sockaddr $port, parse_ipv4 $_]]
                      for @_;
                   $cv->end;
                };
             }
             # ipv6
             if ($family != 4) {
                $cv->begin;
-               aaaa $node, sub {
+               AnyEvent::DNS::aaaa $node, sub {
                   push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
                               pack_sockaddr $port, parse_ipv6 $_]]
                      for @_;
                   $cv->end;
                };
    # try srv records, if applicable
    if ($node eq "localhost") {
       @target = (["127.0.0.1", $port], ["::1", $port]);
       &$resolve;
    } elsif (defined $service && !parse_address $node) {
-      srv $service, $proto, $node, sub {
+      AnyEvent::DNS::srv $service, $proto, $node, sub {
          my (@srv) = @_;
          # no srv records, continue traditionally
          @srv
             or return &$resolve;
-         # only srv record has "." => abort
+         # the only srv record has "." ("" here) => abort
-         $srv[0][2] ne "." || $#srv
+         $srv[0][2] ne "" || $#srv
             or return $cb->();
          # use srv records then
          @target = map ["$_->[3].", $_->[2]],
                       grep $_->[3] ne ".",
 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 {
+   tcp_connect localhost => 22, sub {
-     my $fh = shift
+      my $fh = shift
-        or die "unable to connect: $!";
+         or die "unable to connect: $!";
-     # do something
+      # 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.
 Create and bind a stream socket to the given host, and port, set the
 SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
 implies, this function can also bind on UNIX domain sockets.
 For internet sockets, 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
+C<undef>, in which case it binds either to C<0> or to C<::>, depending
-whether IPv4 or IPv6 is the preferred protocol).
+on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
+future versions, as applicable).
 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<$service>, which must be either a service name or
 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).
+Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on
+C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack
+hosts. Unfortunately, only GNU/Linux seems to implement this properly, so
+if you want both IPv4 and IPv6 listening sockets you should create the
+IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore
+any C<EADDRINUSE> errors.
 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) = @_;
       or Carp::croak "tcp_server/socket: $!";
    if ($af == AF_INET || $af == AF_INET6) {
       setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
          or Carp::croak "tcp_server/so_reuseaddr: $!"
-            unless !AnyEvent::WIN32; # work around windows bug
+            unless AnyEvent::WIN32; # work around windows bug
       unless ($service =~ /^\d*$/) {
          $service = (getservbyname $service, "tcp")[2]
                     or Carp::croak "$service: service unknown"
       }
    $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 ($service, $host) = unpack_sockaddr $peer;
          $accept->($fh, format_address $host, $service);
       }
    });
 1;
 =back
+=head1 SECURITY CONSIDERATIONS
+This module is quite powerful, with with power comes the ability to abuse
+as well: If you accept "hostnames" and ports from untrusted sources,
+then note that this can be abused to delete files (host=C<unix/>). This
+is not really a problem with this module, however, as blindly accepting
+any address and protocol and trying to bind a server or connect to it is
+harmful in general.
 =head1 AUTHOR
  Marc Lehmann <schmorp@schmorp.de>
  http://home.schmorp.de/

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.36 by root, Wed May 28 21:29:03 2008 UTC vs. Revision 1.50 by root, Fri Jun 6 15:35:30 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.36 by root, Wed May 28 21:29:03 2008 UTC vs.
Revision 1.50 by root, Fri Jun 6 15:35:30 2008 UTC