t/run/cloexec.t

   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
  35 BEGIN {
  36     chdir 't' if -d 't';
  37     @INC = '../lib';
  38     require './test.pl';
  39     skip_all_without_config('d_fcntl');
  40 }
  41
  42 use strict;
  43
  44 $|=1;
  45
  46 # When in doubt, skip.
  47 skip_all($^O)
  48     if $^O eq 'VMS' or $^O eq 'MSWin32' or $^O eq 'amigaos';
  49
  50 sub make_tmp_file {
  51     my ($fname, $fcontents) = @_;
  52     local *FHTMP;
  53     open   FHTMP, ">$fname"  or die "open  '$fname': $!";
  54     print  FHTMP $fcontents  or die "print '$fname': $!";
  55     close  FHTMP             or die "close '$fname': $!";
  56 }
  57
  58 my $Perl = which_perl();
  59 my $quote = "'";
  60
  61 my $tmperr             = tempfile();
  62 my $tmpfile1           = tempfile();
  63 my $tmpfile2           = tempfile();
  64 my $tmpfile1_contents  = "tmpfile1 line 1\ntmpfile1 line 2\n";
  65 my $tmpfile2_contents  = "tmpfile2 line 1\ntmpfile2 line 2\n";
  66 make_tmp_file($tmpfile1, $tmpfile1_contents);
  67 make_tmp_file($tmpfile2, $tmpfile2_contents);
  68
  69 # $Child_prog is the program run by the child that inherits the fd.
  70 # Note: avoid using ' or " in $Child_prog since it is run with -e
  71 my $Child_prog = <<'CHILD_PROG';
  72 my $fd = shift;
  73 print qq{childfd=$fd\n};
  74 open INHERIT, qq{<&=$fd} or die qq{open $fd: $!};
  75 my $line = <INHERIT>;
  76 close INHERIT or die qq{close $fd: $!};
  77 print $line
  78 CHILD_PROG
  79 $Child_prog =~ tr/\n//d;
  80
  81 plan(tests => 22);
  82
  83 sub test_not_inherited {
  84     my $expected_fd = shift;
  85     ok( -f $tmpfile2, "tmpfile '$tmpfile2' exists" );
  86     my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd};
  87     # Expect 'Bad file descriptor' or similar to be written to STDERR.
  88     local *SAVERR; open SAVERR, ">&STDERR";  # save original STDERR
  89     open STDERR, ">$tmperr" or die "open '$tmperr': $!";
  90     my $out = `$cmd`;
  91     my $rc  = $? >> 8;
  92     open STDERR, ">&SAVERR" or die "error: restore STDERR: $!";
  93     close SAVERR or die "error: close SAVERR: $!";
  94     # XXX: it seems one cannot rely on a non-zero return code,
  95     # at least not on Tru64.
  96     # cmp_ok( $rc, '!=', 0,
  97     #     "child return code=$rc (non-zero means cannot inherit fd=$expected_fd)" );
  98     cmp_ok( $out =~ tr/\n//, '==', 1,
  99         "child stdout: has 1 newline (rc=$rc, should be non-zero)" );
 100     is( $out, "childfd=$expected_fd\n", 'child stdout: fd' );
 101 }
 102
 103 sub test_inherited {
 104     my $expected_fd = shift;
 105     ok( -f $tmpfile1, "tmpfile '$tmpfile1' exists" );
 106     my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd};
 107     my $out = `$cmd`;
 108     my $rc  = $? >> 8;
 109     cmp_ok( $rc, '==', 0,
 110         "child return code=$rc (zero means inherited fd=$expected_fd ok)" );
 111     my @lines = split(/^/, $out);
 112     cmp_ok( $out =~ tr/\n//, '==', 2, 'child stdout: has 2 newlines' );
 113     cmp_ok( scalar(@lines),  '==', 2, 'child stdout: split into 2 lines' );
 114     is( $lines[0], "childfd=$expected_fd\n", 'child stdout: fd' );
 115     is( $lines[1], "tmpfile1 line 1\n",      'child stdout: line 1' );
 116 }
 117
 118 $^F == 2 or print STDERR "# warning: \$^F is $^F (not 2)\n";
 119
 120 # Should not be able to inherit > $^F in the default case.
 121 open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
 122 my $parentfd2 = fileno FHPARENT2;
 123 defined $parentfd2 or die "fileno: $!";
 124 cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" );
 125 test_not_inherited($parentfd2);
 126 close FHPARENT2 or die "close '$tmpfile2': $!";
 127
 128 # Should be able to inherit $^F after setting to $parentfd2
 129 # Need to set $^F before open because close-on-exec set at time of open.
 130 $^F = $parentfd2;
 131 open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
 132 my $parentfd1 = fileno FHPARENT1;
 133 defined $parentfd1 or die "fileno: $!";
 134 cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" );
 135 test_inherited($parentfd1);
 136 close FHPARENT1 or die "close '$tmpfile1': $!";
 137
 138 # ... and test that you cannot inherit fd = $^F+n.
 139 open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
 140 open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
 141 $parentfd2 = fileno FHPARENT2;
 142 defined $parentfd2 or die "fileno: $!";
 143 cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" );
 144 test_not_inherited($parentfd2);
 145 close FHPARENT2 or die "close '$tmpfile2': $!";
 146 close FHPARENT1 or die "close '$tmpfile1': $!";
 147
 148 # ... and now you can inherit after incrementing.
 149 $^F = $parentfd2;
 150 open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
 151 open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
 152 $parentfd1 = fileno FHPARENT1;
 153 defined $parentfd1 or die "fileno: $!";
 154 cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" );
 155 test_inherited($parentfd1);
 156 close FHPARENT1 or die "close '$tmpfile1': $!";
 157 close FHPARENT2 or die "close '$tmpfile2': $!";