view release on metacpan or  search on metacpan

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

   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"
      unless defined $host;

   my $ipn = parse_address $host
      or Carp::croak "tcp_bind: cannot parse '$host' as host address";

   my $af = address_family $ipn;

   my %state;

   # win32 perl is too stupid to get this right :/
   Carp::croak "tcp_bind: AF_UNIX address family not supported on win32"
      if AnyEvent::WIN32 && $af == AF_UNIX;

   socket my $fh, $af, SOCK_STREAM, 0
      or Carp::croak "tcp_bind: $!";

   $state{fh} = $fh;

   if ($af == AF_INET || $af == AF_INET6) {
      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