view release on metacpan or  search on metacpan

t/02-accept.t  view on Meta::CPAN

# This is a complicated file to test the status flags of a accepted socket using the
# different type of accept functions  in IO::FD
# The listening sockets is placed in nonblocking mode which should result in non blocking accepted sockets 
# bsd type operating systems and but blocking on linux
#
#The normal accept will result in this behaviour
#The accept4 test  test the flags applied
#The accept_multiple forces non blocking on  all
#
use feature ":all";
use strict;
use warnings;
use Test::More;
use IO::FD;

use Fcntl qw<FD_CLOEXEC O_NONBLOCK F_SETFL F_GETFD F_GETFL>;
use POSIX qw<EAGAIN EINPROGRESS>;
use Errno ":POSIX";

use Socket ":all";

my $error;
my @res;
my $port;

my $tests_performed;

local $^F=2;  #disable automatic close on exec for higher fds

#create a passive socket
my ($accept_fd, $client1, $accept4_fd, $client2, $accept_multiple_fd, $client3)=map {
  die  "Could not create socket " unless defined IO::FD::socket my $socket, AF_INET, SOCK_STREAM, 0;
  ($error, @res)= getaddrinfo("0.0.0.0",0, {
    flags=>AI_NUMERICHOST|AI_PASSIVE,
    family=>AF_INET,
    type=>SOCK_STREAM}
  );

  die $error if $error;

  die $! unless defined IO::FD::fcntl $socket, F_SETFL, O_NONBLOCK;
  die "Could not bind " unless defined IO::FD::bind $socket, $res[0]{addr};

  my $addr=IO::FD::getsockname($socket);

  ($error, undef, $port)=getnameinfo($addr, NI_NUMERICHOST);


  die "Could not listen" unless defined IO::FD::listen $socket, 1;


  #Connect with client
  #
  die "Could not create client socket" unless defined IO::FD::socket my $client, AF_INET, SOCK_STREAM, 0;

  die $! unless defined IO::FD::fcntl $client, F_SETFL, O_NONBLOCK;

  ($error, @res)=getaddrinfo("127.0.0.1", $port, {flags=>AI_NUMERICHOST, family=>AF_INET, type=>SOCK_STREAM});

  die $error if $error;

  my $error=IO::FD::connect $client, $res[0]{addr};
  die "Coud not connect $!" if not defined ($error) and $! != EINPROGRESS;
  ($socket,$client);

} 1..3;

#Event loop to progresss in a non blocking fashion

my $rv="";