view release on metacpan or  search on metacpan

lib/AnyEvent/Socket.pm  view on Meta::CPAN

                     # the same, which is actually more broken.
                     # Work around both by using unportable SO_ERROR for cygwin.
                     $! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) || Errno::EAGAIN
                        if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
                  }

                  return if $! == Errno::EAGAIN; # skip spurious wake-ups

                  delete $state{ww}; delete $state{to};

                  $state{next}();
               }
            };
         } else {
            $state{next}();
         }
      };

      $! = Errno::ENXIO;
      $state{next}();
   };

   defined wantarray && guard { %state = () }
}

=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]

Create and bind a stream socket to the given host address 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 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 a numeric port number (or C<0> or C<undef>, in which case an ephemeral
port will be used).

For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
the absolute pathname of the socket. This function will try to C<unlink>
the socket before it tries to bind to it, and will try to unlink it after
it stops using it. See SECURITY CONSIDERATIONS, below.

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.

In non-void context, this function returns a guard object whose lifetime
it tied to the TCP server: If the object gets destroyed, the server will
be stopped and the listening socket will be cleaned up/unlinked (already
accepted connections will not be affected).

When called in void-context, AnyEvent will keep the listening socket alive
internally. In this case, there is no guarantee that the listening socket
will be cleaned up or unlinked.

In all cases, when the function returns to the caller, the socket is bound
and in listening state.

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).

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) = @_;

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

Example: bind a server on a unix domain socket.

   tcp_server "unix/", "/tmp/mydir/mysocket", sub {
      my ($fh) = @_;
   };

=item $guard = AnyEvent::Socket::tcp_bind $host, $service, $done_cb[, $prepare_cb]

Same as C<tcp_server>, except it doesn't call C<accept> in a loop for you
but simply passes the listen socket to the C<$done_cb>. This is useful
when you want to have a convenient set up for your listen socket, but want
to do the C<accept>'ing yourself, for example, in another process.

In case of an error, C<tcp_bind> either croaks, or passes C<undef> to the
C<$done_cb>.

In non-void context, a guard will be returned. It will clean up/unlink the
listening socket when destroyed. In void context, no automatic clean up
might be performed.

=cut

sub _tcp_bind($$$;$) {
   my ($host, $service, $done, $prepare) = @_;

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

lib/AnyEvent/Socket.pm  view on Meta::CPAN

      setsockopt $fh, SOL_SOCKET, SO_REUSEADDR, 1
         or Carp::croak "tcp_bind: so_reuseaddr: $!"
            unless AnyEvent::WIN32; # work around windows bug

      unless ($service =~ /^\d*$/) {
         $service = (getservbyname $service, "tcp")[2]
                    or Carp::croak "tcp_bind: unknown service '$service'"
      }
   } elsif ($af == AF_UNIX) {
      unlink $service;
   }

   bind $fh, pack_sockaddr $service, $ipn
      or Carp::croak "tcp_bind: $!";

   if ($af == AF_UNIX and defined wantarray) {
      # this is racy, but is not designed to be foolproof, just best-effort
      my $ino = (lstat $service)[1];
      $state{unlink} = guard {
         unlink $service
            if (lstat $service)[1] == $ino;
      };
   }

   AnyEvent::fh_unblock $fh;

   my $len;

   if ($prepare) {
      my ($service, $host) = unpack_sockaddr getsockname $fh;
      $len = $prepare && $prepare->($fh, format_address $host, $service);
   }
   
   $len ||= 128;

   listen $fh, $len
      or Carp::croak "tcp_bind: $!";

   $done->(\%state);

   defined wantarray
      ? guard { %state = () } # clear fh, unlink
      : ()
}

sub tcp_bind($$$;$) {
   my ($host, $service, $done, $prepare) = @_;

   _tcp_bind $host, $service, sub {
      $done->(delete shift->{fh});
   }, $prepare
}

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

   _tcp_bind $host, $service, sub {
      my $rstate = shift;

      $rstate->{aw} = AE::io $rstate->{fh}, 0, sub {
         # this closure keeps $state alive
         while ($rstate->{fh} && (my $peer = accept my $fh, $rstate->{fh})) {
            AnyEvent::fh_unblock $fh; # POSIX requires inheritance, the outside world does not

            my ($service, $host) = unpack_sockaddr $peer;
            $accept->($fh, format_address $host, $service);
         }
      };
   }, $prepare
}

=item tcp_nodelay $fh, $enable

Enables (or disables) the C<TCP_NODELAY> socket option (also known as
Nagle's algorithm). Returns false on error, true otherwise.

=cut

sub tcp_nodelay($$) {
   my $onoff = int ! ! $_[1];

   setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
}

=item tcp_congestion $fh, $algorithm

Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
socket option). The default is OS-specific, but is usually
C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
C<veno>, C<westwood> and C<yeah>.

=cut

sub tcp_congestion($$) {
   defined TCP_CONGESTION
      ? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
      : undef
}

=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://anyevent.schmorp.de

=cut

1