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       is($new->protocol(), $p, 'protocol match');
  54     }
  55   SKIP: {
  56       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
  57       is($new->socktype(), $s, 'type match');
  58     }
  59
  60     unlink($socketpath);
  61     wait();
  62 }
  63
  64 undef $TODO;
  65 SKIP: {
  66     skip "datagram unix sockets not supported on $^O", 7
  67       if $^O eq "haiku";
  68     # now test datagram sockets:
  69     $listener = IO::Socket::UNIX->new(Type => SOCK_DGRAM,
  70                                       Local => $socketpath);
  71     ok(defined($listener), 'datagram socket created');
  72
  73     $p = $listener->protocol();
  74     ok(defined($p), 'protocol defined');
  75     $d = $listener->sockdomain();
  76     ok(defined($d), 'domain defined');
  77     $s = $listener->socktype();
  78     ok(defined($s), 'type defined');
  79
  80     my $new = IO::Socket::UNIX->new_from_fd($listener->fileno(), 'r+');
  81
  82     is($new->sockdomain(), $d, 'domain match');
  83     SKIP: {
  84       skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
  85       is($new->protocol(), $p, 'protocol match');
  86     }
  87     SKIP: {
  88       skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
  89       is($new->socktype(), $s, 'type match');
  90     }
  91 }
  92 unlink($socketpath);