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