The parser should always close the file handle that it opened.

Previously it would leave the file handle open if it was (equal to) stdin,
on the assumption that this must have been because no script name was
supplied on the interpreter command line, so the interpreter was defaulting
to reading the script from standard input.

However, if the program has closed STDIN, then the next file handle opened
(for any reason) will have file descriptor 0. So in this situation, the
handle that require opened to read the module would be mistaken for the above
situation and left open. Effectively, this leaked a file handle.

This is now fixed, by explicitly tracking from parser creation time whether
it should keep the file handle open, and only setting this flag when
defaulting to reading the main program from standard input. This resolves
RT #37033.

diff --git a/MANIFEST b/MANIFEST
index 05a47fa..92efe61 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5304,6 +5304,7 @@ t/op/read.t                       See if read() works
 t/op/recurse.t                 See if deep recursion works
 t/op/ref.t                     See if refs and objects work
 t/op/repeat.t                  See if x operator works
+t/op/require_37033.t           See if require always closes rsfp
 t/op/require_errors.t          See if errors from require are reported correctly
 t/op/reset.t                   See if reset operator works
 t/op/reverse.t                 See if reverse operator works

diff --git a/parser.h b/parser.h
index 3a32e1f..1e9c71d 100644 (file)
--- a/parser.h
+++ b/parser.h
@@ -120,9 +120,10 @@ typedef struct yy_parser {
 # define LEX_IGNORE_UTF8_HINTS 0x00000002
 # define LEX_EVALBYTES         0x00000004
 # define LEX_START_COPIED      0x00000008
+# define LEX_DONT_CLOSE_RSFP   0x00000010
 # define LEX_START_FLAGS \
        (LEX_START_SAME_FILTER|LEX_START_COPIED \
-       |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
+       |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP)
 #endif
 
 /* flags for parser API */

diff --git a/perl.c b/perl.c
index 3610780..104cac7 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1803,6 +1803,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
     SV *linestr_sv = newSV_type(SVt_PVIV);
     bool add_read_e_script = FALSE;
+    U32 lex_start_flags = 0;
 
     PERL_SET_PHASE(PERL_PHASE_START);
 
@@ -2076,6 +2077,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        rsfp = open_script(scriptname, dosearch, &suidscript);
        if (!rsfp) {
            rsfp = PerlIO_stdin();
+           lex_start_flags = LEX_DONT_CLOSE_RSFP;
        }
 
        validate_suid(validarg, scriptname, fdscript, suidscript,
@@ -2231,7 +2233,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
 #endif
 
-    lex_start(linestr_sv, rsfp, 0);
+    lex_start(linestr_sv, rsfp, lex_start_flags);
     PL_subname = newSVpvs("main");
 
     if (add_read_e_script)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 40a1f42..dbdd492 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -243,7 +243,10 @@ that they represent may be covered elsewhere.
 
 =item *
 
-XXX
+F<t/op/require_37033.t> has been added, to test that C<require> always closes
+the file handle that it opens. Previously, it had been leaking the file handle
+if it happened to have file descriptor 0, which would happen if C<require> was
+called (explicitly or implicitly) when C<STDIN> had been closed.
 
 =back
 

diff --git a/t/op/require_37033.t b/t/op/require_37033.t
new file mode 100644 (file)
index 0000000..dac8568
--- /dev/null
+++ b/t/op/require_37033.t
@@ -0,0 +1,42 @@
+#!perl -w
+use strict;
+
+# Check that require doesn't leave the handle it uses open, if it happens that
+# the handle it opens gets file descriptor 0. RT #37033.
+
+require './test.pl';
+@INC = 'lib';
+
+sub test_require {
+    my ($state, $want) = @_;
+    delete $INC{'test_use_14937.pm'};
+    open my $fh, '<', 'README' or die "Can't open README: $!";
+    my $fileno = fileno $fh;
+    if (defined $want) {
+       is($fileno, $want,
+          "file handle has correct numeric file descriptor $state");
+    } else {
+       like($fileno, qr/\A\d+\z/,
+            "file handle has a numeric file descriptor $state");
+    }
+    close $fh or die;
+
+    is($INC{'test_use_14937.pm'}, undef, "test_use_14937 isn't loaded $state");
+    require test_use_14937;
+    isnt($INC{'test_use_14937.pm'}, undef, "test_use_14937 is loaded $state");
+
+    open $fh, '<', 'README' or die "Can't open README: $!";
+    is(fileno $fh, $fileno,
+       "file handle has the same numeric file descriptor $state");
+    close $fh or die;
+}
+
+is(fileno STDIN, 0, 'STDIN is open on file descriptor 0');
+test_require('(STDIN open)');
+
+close STDIN or die "Can't close STDIN: $!";
+
+is(fileno STDIN, undef, 'STDIN is closed');
+test_require('(STDIN closed)', 0);
+
+done_testing();

diff --git a/toke.c b/toke.c
index c7194df..829ff86 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -684,7 +684,13 @@ used by perl internally, so extensions should always pass zero.
 */
 
 /* LEX_START_SAME_FILTER indicates that this is not a new file, so it
-   can share filters with the current parser. */
+   can share filters with the current parser.
+   LEX_START_DONT_CLOSE indicates that the file handle wasn't opened by the
+   caller, hence isn't owned by the parser, so shouldn't be closed on parser
+   destruction. This is used to handle the case of defaulting to reading the
+   script from the standard input because no filename was given on the command
+   line (without getting confused by situation where STDIN has been closed, so
+   the script handle is opened on fd 0)  */
 
 void
 Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
@@ -751,7 +757,8 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
        parser->linestart = SvPVX(parser->linestr);
     parser->bufend = parser->bufptr + SvCUR(parser->linestr);
     parser->last_lop = parser->last_uni = NULL;
-    parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES);
+    parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
+                                |LEX_DONT_CLOSE_RSFP);
 
     parser->in_pod = parser->filtered = 0;
 }
@@ -767,7 +774,7 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
     PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
-    if (parser->rsfp == PerlIO_stdin())
+    if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
        PerlIO_clearerr(parser->rsfp);
     else if (parser->rsfp && (!parser->old_parser ||
                (parser->old_parser && parser->rsfp != parser->old_parser->rsfp)))
@@ -1283,7 +1290,7 @@ Perl_lex_next_chunk(pTHX_ U32 flags)
        /* End of real input.  Close filehandle (unless it was STDIN),
         * then add implicit termination.
         */
-       if ((PerlIO*)PL_parser->rsfp == PerlIO_stdin())
+       if (PL_parser->lex_flags & LEX_DONT_CLOSE_RSFP)
            PerlIO_clearerr(PL_parser->rsfp);
        else if (PL_parser->rsfp)
            (void)PerlIO_close(PL_parser->rsfp);