dist/IO/t/cachepropagate-unix.t

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use File::Temp qw(tempdir);
   7 use File::Spec::Functions;
   8 use IO::Socket;
   9 use IO::Socket::UNIX;
  10 use Socket;
  11 use Config;
  12 use Test::More;
  13
  14 plan skip_all => "UNIX domain sockets not implemented on $^O"
  15   if ($^O =~ m/^(?:qnx|nto|vos|MSWin32|VMS)$/);
  16
  17 plan tests => 15;
  18
  19 my $socketpath = catfile(tempdir( CLEANUP => 1 ), 'testsock');
  20
  21 # start testing stream sockets:
  22 my $listener = IO::Socket::UNIX->new(Type => SOCK_STREAM,
  23                                      Listen => 1,
  24                                      Local => $socketpath);
  25 ok(defined($listener), 'stream socket created');
  26
  27 my $p = $listener->protocol();
  28 ok(defined($p), 'protocol defined');
  29 my $d = $listener->sockdomain();
  30 ok(defined($d), 'domain defined');
  31 my $s = $listener->socktype();
  32 ok(defined($s), 'type defined');
  33
  34 SKIP: {
  35     skip "fork not available", 4
  36         unless $Config{d_fork} || $Config{d_pseudofork};
  37
  38     my $cpid = fork();
  39     if (0 == $cpid) {
  40         # the child:
  41         sleep(1);
  42         my $connector = IO::Socket::UNIX->new(Peer => $socketpath);
  43         exit(0);
  44     } else {
  45         ok(defined($cpid), 'spawned a child');
  46     }
  47
  48     my $new = $listener->accept();
  49
  50     is($new->sockdomain(), $d, 'domain match');
  51   SKIP: {
  52       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
  53       skip "SO_PROTOCOL defined but not implemented", 1
  54          if !defined $new->sockopt(Socket::SO_PROTOCOL);
  55       is($new->protocol(), $p, 'protocol match');
  56     }
  57   SKIP: {
  58       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
  59       skip "SO_TYPE defined but not implemented", 1
  60          if !defined $new->sockopt(Socket::SO_TYPE);
  61       is($new->socktype(), $s, 'type match');
  62     }
  63
  64     unlink($socketpath);
  65     wait();
  66 }
  67
  68 undef $TODO;
  69 SKIP: {
  70     skip "datagram unix sockets not supported on $^O", 7
  71       if $^O eq "haiku";
  72     # now test datagram sockets:
  73     $listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM,
  74                                       Local => $socketpath);
  75     ok(defined($listener), 'datagram socket created');
  76
  77     $p = $listener->protocol();
  78     ok(defined($p), 'protocol defined');
  79     $d = $listener->sockdomain();
  80     ok(defined($d), 'domain defined');
  81     $s = $listener->socktype();
  82     ok(defined($s), 'type defined');
  83
  84     my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
  85
  86     is($new->sockdomain(), $d, 'domain match');
  87     SKIP: {
  88       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
  89       skip "SO_PROTOCOL defined but not implemented", 1
  90          if !defined $new->sockopt(Socket::SO_PROTOCOL);
  91       is($new->protocol(), $p, 'protocol match');
  92     }
  93     SKIP: {
  94       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
  95       skip "SO_TYPE defined but not implemented", 1
  96          if !defined $new->sockopt(Socket::SO_TYPE);
  97       is($new->socktype(), $s, 'type match');
  98     }
  99 }
 100 unlink($socketpath);