1#!./perl 2# 3# Test inheriting file descriptors across exec (close-on-exec). 4# 5# perlvar describes $^F aka $SYSTEM_FD_MAX as follows: 6# 7# The maximum system file descriptor, ordinarily 2. System file 8# descriptors are passed to exec()ed processes, while higher file 9# descriptors are not. Also, during an open(), system file descriptors 10# are preserved even if the open() fails. (Ordinary file descriptors 11# are closed before the open() is attempted.) The close-on-exec 12# status of a file descriptor will be decided according to the value of 13# C<$^F> when the corresponding file, pipe, or socket was opened, not 14# the time of the exec(). 15# 16# This documented close-on-exec behaviour is typically implemented in 17# various places (e.g. pp_sys.c) with code something like: 18# 19# #if defined(HAS_FCNTL) && defined(F_SETFD) 20# fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ 21# #endif 22# 23# This behaviour, therefore, is only currently implemented for platforms 24# where: 25# 26# a) HAS_FCNTL and F_SETFD are both defined 27# b) Integer fds are native OS handles 28# 29# ... which is typically just the Unix-like platforms. 30# 31# Notice that though integer fds are supported by the C runtime library 32# on Windows, they are not native OS handles, and so are not inherited 33# across an exec (though native Windows file handles are). 34 35BEGIN { 36 chdir 't' if -d 't'; 37 @INC = '../lib'; 38 use Config; 39 if (!$Config{'d_fcntl'}) { 40 print("1..0 # Skip: fcntl() is not available\n"); 41 exit(0); 42 } 43 require './test.pl'; 44} 45 46use strict; 47 48$|=1; 49 50my $Is_VMS = $^O eq 'VMS'; 51my $Is_MacOS = $^O eq 'MacOS'; 52my $Is_Win32 = $^O eq 'MSWin32'; 53 54# When in doubt, skip. 55skip_all("MacOS") if $Is_MacOS; 56skip_all("VMS") if $Is_VMS; 57skip_all("Win32") if $Is_Win32; 58 59sub make_tmp_file { 60 my ($fname, $fcontents) = @_; 61 local *FHTMP; 62 open FHTMP, ">$fname" or die "open '$fname': $!"; 63 print FHTMP $fcontents or die "print '$fname': $!"; 64 close FHTMP or die "close '$fname': $!"; 65} 66 67my $Perl = which_perl(); 68my $quote = $Is_VMS || $Is_Win32 ? '"' : "'"; 69 70my $tmperr = tempfile(); 71my $tmpfile1 = tempfile(); 72my $tmpfile2 = tempfile(); 73my $tmpfile1_contents = "tmpfile1 line 1\ntmpfile1 line 2\n"; 74my $tmpfile2_contents = "tmpfile2 line 1\ntmpfile2 line 2\n"; 75make_tmp_file($tmpfile1, $tmpfile1_contents); 76make_tmp_file($tmpfile2, $tmpfile2_contents); 77 78# $Child_prog is the program run by the child that inherits the fd. 79# Note: avoid using ' or " in $Child_prog since it is run with -e 80my $Child_prog = <<'CHILD_PROG'; 81my $fd = shift; 82print qq{childfd=$fd\n}; 83open INHERIT, qq{<&=$fd} or die qq{open $fd: $!}; 84my $line = <INHERIT>; 85close INHERIT or die qq{close $fd: $!}; 86print $line 87CHILD_PROG 88$Child_prog =~ tr/\n//d; 89 90plan(tests => 22); 91 92sub test_not_inherited { 93 my $expected_fd = shift; 94 ok( -f $tmpfile2, "tmpfile '$tmpfile2' exists" ); 95 my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd}; 96 # Expect 'Bad file descriptor' or similar to be written to STDERR. 97 local *SAVERR; open SAVERR, ">&STDERR"; # save original STDERR 98 open STDERR, ">$tmperr" or die "open '$tmperr': $!"; 99 my $out = `$cmd`; 100 my $rc = $? >> 8; 101 open STDERR, ">&SAVERR" or die "error: restore STDERR: $!"; 102 close SAVERR or die "error: close SAVERR: $!"; 103 # XXX: it seems one cannot rely on a non-zero return code, 104 # at least not on Tru64. 105 # cmp_ok( $rc, '!=', 0, 106 # "child return code=$rc (non-zero means cannot inherit fd=$expected_fd)" ); 107 cmp_ok( $out =~ tr/\n//, '==', 1, 108 "child stdout: has 1 newline (rc=$rc, should be non-zero)" ); 109 is( $out, "childfd=$expected_fd\n", 'child stdout: fd' ); 110} 111 112sub test_inherited { 113 my $expected_fd = shift; 114 ok( -f $tmpfile1, "tmpfile '$tmpfile1' exists" ); 115 my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd}; 116 my $out = `$cmd`; 117 my $rc = $? >> 8; 118 cmp_ok( $rc, '==', 0, 119 "child return code=$rc (zero means inherited fd=$expected_fd ok)" ); 120 my @lines = split(/^/, $out); 121 cmp_ok( $out =~ tr/\n//, '==', 2, 'child stdout: has 2 newlines' ); 122 cmp_ok( scalar(@lines), '==', 2, 'child stdout: split into 2 lines' ); 123 is( $lines[0], "childfd=$expected_fd\n", 'child stdout: fd' ); 124 is( $lines[1], "tmpfile1 line 1\n", 'child stdout: line 1' ); 125} 126 127$^F == 2 or print STDERR "# warning: \$^F is $^F (not 2)\n"; 128 129# Should not be able to inherit > $^F in the default case. 130open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; 131my $parentfd2 = fileno FHPARENT2; 132defined $parentfd2 or die "fileno: $!"; 133cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" ); 134test_not_inherited($parentfd2); 135close FHPARENT2 or die "close '$tmpfile2': $!"; 136 137# Should be able to inherit $^F after setting to $parentfd2 138# Need to set $^F before open because close-on-exec set at time of open. 139$^F = $parentfd2; 140open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; 141my $parentfd1 = fileno FHPARENT1; 142defined $parentfd1 or die "fileno: $!"; 143cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" ); 144test_inherited($parentfd1); 145close FHPARENT1 or die "close '$tmpfile1': $!"; 146 147# ... and test that you cannot inherit fd = $^F+n. 148open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; 149open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; 150$parentfd2 = fileno FHPARENT2; 151defined $parentfd2 or die "fileno: $!"; 152cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" ); 153test_not_inherited($parentfd2); 154close FHPARENT2 or die "close '$tmpfile2': $!"; 155close FHPARENT1 or die "close '$tmpfile1': $!"; 156 157# ... and now you can inherit after incrementing. 158$^F = $parentfd2; 159open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; 160open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; 161$parentfd1 = fileno FHPARENT1; 162defined $parentfd1 or die "fileno: $!"; 163cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" ); 164test_inherited($parentfd1); 165close FHPARENT1 or die "close '$tmpfile1': $!"; 166close FHPARENT2 or die "close '$tmpfile2': $!"; 167