1#!./perl 2 3use Config; 4 5BEGIN { 6 my $reason; 7 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) { 8 $reason = 'Socket extension unavailable'; 9 } 10 elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) { 11 $reason = 'IO extension unavailable'; 12 } 13 elsif ($^O eq 'os2') { 14 require IO::Socket; 15 16 eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1} 17 or $@ !~ /not implemented/ or 18 $reason = 'compiled without TCP/IP stack v4'; 19 } 20 elsif ($^O =~ m/^(?:qnx|nto|vos|MSWin32)$/ ) { 21 $reason = "UNIX domain sockets not implemented on $^O"; 22 } 23 elsif (! $Config{'d_fork'}) { 24 $reason = 'no fork'; 25 } 26 if ($reason) { 27 print "1..0 # Skip: $reason\n"; 28 exit 0; 29 } 30} 31 32$PATH = "sock-$$"; 33 34if ($^O eq 'os2') { # Can't create sockets with relative path... 35 require Cwd; 36 my $d = Cwd::cwd(); 37 $d =~ s/^[a-z]://i; 38 $PATH = "$d/$PATH"; 39} 40 41# Test if we can create the file within the tmp directory 42if (-e $PATH or not open(TEST, '>', $PATH) and $^O ne 'os2') { 43 print "1..0 # Skip: cannot open '$PATH' for write\n"; 44 exit 0; 45} 46close(TEST); 47unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!"; 48 49# Start testing 50$| = 1; 51print "1..5\n"; 52 53use IO::Socket; 54 55$listen = IO::Socket::UNIX->new(Local => $PATH, Listen => 0); 56 57# Sometimes UNIX filesystems are mounted for security reasons 58# with "nodev" option which spells out "no" for creating UNIX 59# local sockets. Therefore we will retry with a File::Temp 60# generated filename from a temp directory. 61unless (defined $listen) { 62 eval { require File::Temp }; 63 unless ($@) { 64 import File::Temp 'mktemp'; 65 for my $TMPDIR ($ENV{TMPDIR}, "/tmp") { 66 if (defined $TMPDIR && -d $TMPDIR && -w $TMPDIR) { 67 $PATH = mktemp("$TMPDIR/sXXXXXXXX"); 68 last if $listen = IO::Socket::UNIX->new(Local => $PATH, 69 Listen => 0); 70 } 71 } 72 } 73 defined $listen or die "$PATH: $!"; 74} 75print "ok 1\n"; 76 77if($pid = fork()) { 78 79 $sock = $listen->accept(); 80 81 if (defined $sock) { 82 print "ok 2\n"; 83 84 print $sock->getline(); 85 86 print $sock "ok 4\n"; 87 88 $sock->close; 89 90 waitpid($pid,0); 91 unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!"; 92 93 print "ok 5\n"; 94 } else { 95 print "# accept() failed: $!\n"; 96 for (2..5) { 97 print "not ok $_ # accept failed\n"; 98 } 99 } 100} elsif(defined $pid) { 101 102 $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!"; 103 104 print $sock "ok 3\n"; 105 106 print $sock->getline(); 107 108 $sock->close; 109 110 exit; 111} else { 112 die; 113} 114