Epigraph for v5.15.9

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 2385f89..1737893 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -77,11 +77,9 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-/* Drop everything. Heck, don't even try to call it */
-#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+#  define validate_suid(rsfp) NOOP
 #else
-/* Drop almost everything */
-#  define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
+#  define validate_suid(rsfp) S_validate_suid(aTHX_ rsfp)
 #endif
 
 #define CALL_BODY_SUB(myop) \
@@ -1801,14 +1799,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
 #endif
-    SV *linestr_sv = newSV_type(SVt_PVIV);
+    SV *linestr_sv = NULL;
     bool add_read_e_script = FALSE;
+    U32 lex_start_flags = 0;
 
     PERL_SET_PHASE(PERL_PHASE_START);
 
-    SvGROW(linestr_sv, 80);
-    sv_setpvs(linestr_sv,"");
-
     init_main_stash();
 
     {
@@ -2074,9 +2070,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
        bool suidscript = FALSE;
 
        rsfp = open_script(scriptname, dosearch, &suidscript);
+       if (!rsfp) {
+           rsfp = PerlIO_stdin();
+           lex_start_flags = LEX_DONT_CLOSE_RSFP;
+       }
 
-       validate_suid(validarg, scriptname, fdscript, suidscript,
-                     linestr_sv, rsfp);
+       validate_suid(rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -2101,6 +2100,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            forbid_setid('x', suidscript);
            /* Hence you can't get here if suidscript is true */
 
+           linestr_sv = newSV_type(SVt_PV);
+           lex_start_flags |= LEX_START_COPIED;
            find_beginning(linestr_sv, rsfp);
            if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
                Perl_croak(aTHX_ "Can't chdir to %s",cddir);
@@ -2228,7 +2229,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     }
 #endif
 
-    lex_start(linestr_sv, rsfp, 0);
+    lex_start(linestr_sv, rsfp, lex_start_flags);
+    if(linestr_sv)
+       SvREFCNT_dec(linestr_sv);
+
     PL_subname = newSVpvs("main");
 
     if (add_read_e_script)
@@ -3669,15 +3673,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        scriptname = (char *)"";
     if (fdscript >= 0) {
        rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (rsfp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(rsfp),F_SETFD,1);
-#       endif
     }
     else if (!*scriptname) {
        forbid_setid(0, *suidscript);
-       rsfp = PerlIO_stdin();
+       return NULL;
     }
     else {
 #ifdef FAKE_BIT_BUCKET
@@ -3721,11 +3720,6 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        }
        scriptname = BIT_BUCKET;
 #endif
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (rsfp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(rsfp),F_SETFD,1);
-#       endif
     }
     if (!rsfp) {
        /* PSz 16 Sep 03  Keep neat error message */
@@ -3735,6 +3729,10 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
            Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                    CopFILE(PL_curcop), Strerror(errno));
     }
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    /* ensure close-on-exec */
+    fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+#endif
     return rsfp;
 }