Commit | Line | Data |
742218b3 |
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 | 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 | |
46 | use strict; |
47 | |
48 | $|=1; |
49 | |
50 | my $Is_VMS = $^O eq 'VMS'; |
51 | my $Is_MacOS = $^O eq 'MacOS'; |
52 | my $Is_Win32 = $^O eq 'MSWin32'; |
53 | my $Is_Cygwin = $^O eq 'cygwin'; |
54 | |
55 | # When in doubt, skip. |
56 | skip_all("MacOS") if $Is_MacOS; |
57 | skip_all("VMS") if $Is_VMS; |
58 | skip_all("cygwin") if $Is_Cygwin; |
59 | skip_all("Win32") if $Is_Win32; |
60 | |
61 | sub 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 | |
69 | my $Perl = which_perl(); |
70 | my $quote = $Is_VMS || $Is_Win32 ? '"' : "'"; |
71 | |
72 | my $tmperr = 'cloexece.tmp'; |
73 | my $tmpfile1 = 'cloexec1.tmp'; |
74 | my $tmpfile2 = 'cloexec2.tmp'; |
75 | my $tmpfile1_contents = "tmpfile1 line 1\ntmpfile1 line 2\n"; |
76 | my $tmpfile2_contents = "tmpfile2 line 1\ntmpfile2 line 2\n"; |
77 | make_tmp_file($tmpfile1, $tmpfile1_contents); |
78 | make_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 |
82 | my $Child_prog = <<'CHILD_PROG'; |
83 | my $fd = shift; |
84 | print qq{childfd=$fd\n}; |
85 | open INHERIT, qq{<&=$fd} or die qq{open $fd: $!}; |
86 | my $line = <INHERIT>; |
87 | close INHERIT or die qq{close $fd: $!}; |
88 | print $line |
89 | CHILD_PROG |
90 | $Child_prog =~ tr/\n//d; |
91 | |
dcb5c535 |
92 | plan(tests => 22); |
742218b3 |
93 | |
94 | sub 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 |
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 |
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 |
112 | } |
113 | |
114 | sub 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 |
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 |
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 |
127 | } |
128 | |
129 | $^F == 2 or print STDERR "# warning: \$^F is $^F (not 2)\n"; |
130 | |
dcb5c535 |
131 | # Should not be able to inherit > $^F in the default case. |
132 | open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; |
133 | my $parentfd2 = fileno FHPARENT2; |
134 | defined $parentfd2 or die "fileno: $!"; |
135 | cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" ); |
136 | test_not_inherited($parentfd2); |
137 | close 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; |
142 | open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; |
143 | my $parentfd1 = fileno FHPARENT1; |
144 | defined $parentfd1 or die "fileno: $!"; |
145 | cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" ); |
146 | test_inherited($parentfd1); |
147 | close FHPARENT1 or die "close '$tmpfile1': $!"; |
742218b3 |
148 | |
742218b3 |
149 | # ... and test that you cannot inherit fd = $^F+1. |
150 | open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; |
dcb5c535 |
151 | open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; |
152 | $parentfd2 = fileno FHPARENT2; |
153 | defined $parentfd2 or die "fileno: $!"; |
154 | cmp_ok( $parentfd2, '>', $^F, "parent open fd=$parentfd2 (\$^F=$^F)" ); |
155 | test_not_inherited($parentfd2); |
156 | close FHPARENT2 or die "close '$tmpfile2': $!"; |
742218b3 |
157 | close FHPARENT1 or die "close '$tmpfile1': $!"; |
dcb5c535 |
158 | |
742218b3 |
159 | # ... and now you can inherit after incrementing. |
160 | ++$^F; |
161 | open FHPARENT2, "<$tmpfile2" or die "open '$tmpfile2': $!"; |
dcb5c535 |
162 | open FHPARENT1, "<$tmpfile1" or die "open '$tmpfile1': $!"; |
163 | $parentfd1 = fileno FHPARENT1; |
164 | defined $parentfd1 or die "fileno: $!"; |
165 | cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" ); |
166 | test_inherited($parentfd1); |
167 | close FHPARENT1 or die "close '$tmpfile1': $!"; |
742218b3 |
168 | close FHPARENT2 or die "close '$tmpfile2': $!"; |
169 | |
742218b3 |
170 | END { |
171 | defined $tmperr and unlink($tmperr); |
172 | defined $tmpfile1 and unlink($tmpfile1); |
173 | defined $tmpfile2 and unlink($tmpfile2); |
174 | } |