This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: the new t/run/cloexec.t failing in Solaris and Tru64
[perl5.git] / t / run / cloexec.t
CommitLineData
742218b3
AS
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';
53my $Is_Cygwin = $^O eq 'cygwin';
54
55# When in doubt, skip.
56skip_all("MacOS") if $Is_MacOS;
57skip_all("VMS") if $Is_VMS;
58skip_all("cygwin") if $Is_Cygwin;
59skip_all("Win32") if $Is_Win32;
60
61sub make_tmp_file {
62 my ($fname, $fcontents) = @_;
63 local *FHTMP;
64 open FHTMP, ">$fname" or die "open '$fname': $!";
65 print FHTMP $fcontents or die "print '$fname': $!";
66 close FHTMP or die "close '$fname': $!";
67}
68
69my $Perl = which_perl();
70my $quote = $Is_VMS || $Is_Win32 ? '"' : "'";
71
72my $tmperr = 'cloexece.tmp';
73my $tmpfile1 = 'cloexec1.tmp';
74my $tmpfile2 = 'cloexec2.tmp';
75my $tmpfile1_contents = "tmpfile1 line 1\ntmpfile1 line 2\n";
76my $tmpfile2_contents = "tmpfile2 line 1\ntmpfile2 line 2\n";
77make_tmp_file($tmpfile1, $tmpfile1_contents);
78make_tmp_file($tmpfile2, $tmpfile2_contents);
79
80# $Child_prog is the program run by the child that inherits the fd.
81# Note: avoid using ' or " in $Child_prog since it is run with -e
82my $Child_prog = <<'CHILD_PROG';
83my $fd = shift;
84print qq{childfd=$fd\n};
85open INHERIT, qq{<&=$fd} or die qq{open $fd: $!};
86my $line = <INHERIT>;
87close INHERIT or die qq{close $fd: $!};
88print $line
89CHILD_PROG
90$Child_prog =~ tr/\n//d;
91
dcb5c535 92plan(tests => 22);
742218b3
AS
93
94sub test_not_inherited {
95 my $expected_fd = shift;
96 ok( -f $tmpfile2, "tmpfile '$tmpfile2' exists" );
dcb5c535 97 my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd};
742218b3
AS
98 # Expect 'Bad file descriptor' or similar to be written to STDERR.
99 local *SAVERR; open SAVERR, ">&STDERR"; # save original STDERR
100 open STDERR, ">$tmperr" or die "open '$tmperr': $!";
101 my $out = `$cmd`;
102 my $rc = $? >> 8;
103 open STDERR, ">&SAVERR" or die "error: restore STDERR: $!";
104 close SAVERR or die "error: close SAVERR: $!";
dcb5c535
AS
105 # XXX: it seems one cannot rely on a non-zero return code,
106 # at least not on Tru64.
107 # cmp_ok( $rc, '!=', 0,
108 # "child return code=$rc (non-zero means cannot inherit fd=$expected_fd)" );
109 cmp_ok( $out =~ tr/\n//, '==', 1,
110 "child stdout: has 1 newline (rc=$rc, should be non-zero)" );
742218b3 111 is( $out, "childfd=$expected_fd\n", 'child stdout: fd' );
742218b3
AS
112}
113
114sub test_inherited {
115 my $expected_fd = shift;
116 ok( -f $tmpfile1, "tmpfile '$tmpfile1' exists" );
dcb5c535 117 my $cmd = qq{$Perl -e $quote$Child_prog$quote $expected_fd};
742218b3
AS
118 my $out = `$cmd`;
119 my $rc = $? >> 8;
120 cmp_ok( $rc, '==', 0,
dcb5c535 121 "child return code=$rc (zero means inherited fd=$expected_fd ok)" );
742218b3
AS
122 my @lines = split(/^/, $out);
123 cmp_ok( $out =~ tr/\n//, '==', 2, 'child stdout: has 2 newlines' );
124 cmp_ok( scalar(@lines), '==', 2, 'child stdout: split into 2 lines' );
125 is( $lines[0], "childfd=$expected_fd\n", 'child stdout: fd' );
126 is( $lines[1], "tmpfile1 line 1\n", 'child stdout: line 1' );
742218b3
AS
127}
128
129$^F == 2 or print STDERR "# warning: \$^F is $^F (not 2)\n";
130
dcb5c535
AS
131# Should not be able to inherit > $^F in the default case.
132open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
133my $parentfd2 = fileno FHPARENT2;
134defined $parentfd2 or die "fileno: $!";
135cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" );
136test_not_inherited($parentfd2);
137close FHPARENT2 or die "close '$tmpfile2': $!";
138
139# Should be able to inherit $^F after setting to $parentfd2
140# Need to set $^F before open because close-on-exec set at time of open.
141$^F = $parentfd2;
142open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
143my $parentfd1 = fileno FHPARENT1;
144defined $parentfd1 or die "fileno: $!";
145cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" );
146test_inherited($parentfd1);
147close FHPARENT1 or die "close '$tmpfile1': $!";
742218b3 148
742218b3
AS
149# ... and test that you cannot inherit fd = $^F+1.
150open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
dcb5c535
AS
151open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
152$parentfd2 = fileno FHPARENT2;
153defined $parentfd2 or die "fileno: $!";
154cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" );
155test_not_inherited($parentfd2);
156close FHPARENT2 or die "close '$tmpfile2': $!";
742218b3 157close FHPARENT1 or die "close '$tmpfile1': $!";
dcb5c535 158
742218b3
AS
159# ... and now you can inherit after incrementing.
160++$^F;
161open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!";
dcb5c535
AS
162open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!";
163$parentfd1 = fileno FHPARENT1;
164defined $parentfd1 or die "fileno: $!";
165cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" );
166test_inherited($parentfd1);
167close FHPARENT1 or die "close '$tmpfile1': $!";
742218b3
AS
168close FHPARENT2 or die "close '$tmpfile2': $!";
169
742218b3
AS
170END {
171 defined $tmperr and unlink($tmperr);
172 defined $tmpfile1 and unlink($tmpfile1);
173 defined $tmpfile2 and unlink($tmpfile2);
174}