Epigraph for v5.15.9

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 5518675..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();
 
     {
@@ -2073,10 +2069,13 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     {
        bool suidscript = FALSE;
 
-       open_script(scriptname, dosearch, &suidscript, &rsfp);
+       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)
@@ -3614,11 +3618,11 @@ S_init_main_stash(pTHX)
     sv_setpvs(get_sv("/", GV_ADD), "\n");
 }
 
-STATIC int
-S_open_script(pTHX_ const char *scriptname, bool dosearch,
-             bool *suidscript, PerlIO **rsfpp)
+STATIC PerlIO *
+S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
 {
     int fdscript = -1;
+    PerlIO *rsfp = NULL;
     dVAR;
 
     PERL_ARGS_ASSERT_OPEN_SCRIPT;
@@ -3668,16 +3672,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
     if (*PL_origfilename == '-' && PL_origfilename[1] == '\0')
        scriptname = (char *)"";
     if (fdscript >= 0) {
-       *rsfpp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (*rsfpp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
-#       endif
+       rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
     }
     else if (!*scriptname) {
        forbid_setid(0, *suidscript);
-       *rsfpp = PerlIO_stdin();
+       return NULL;
     }
     else {
 #ifdef FAKE_BIT_BUCKET
@@ -3712,7 +3711,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
 #endif
        }
 #endif
-       *rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
+       rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
 #ifdef FAKE_BIT_BUCKET
        if (memEQ(scriptname, FAKE_BIT_BUCKET_PREFIX,
                  sizeof(FAKE_BIT_BUCKET_PREFIX) - 1)
@@ -3721,13 +3720,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
        }
        scriptname = BIT_BUCKET;
 #endif
-#       if defined(HAS_FCNTL) && defined(F_SETFD)
-           if (*rsfpp)
-                /* ensure close-on-exec */
-               fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
-#       endif
     }
-    if (!*rsfpp) {
+    if (!rsfp) {
        /* PSz 16 Sep 03  Keep neat error message */
        if (PL_e_script)
            Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
@@ -3735,7 +3729,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
            Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
                    CopFILE(PL_curcop), Strerror(errno));
     }
-    return fdscript;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    /* ensure close-on-exec */
+    fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+#endif
+    return rsfp;
 }
 
 /* Mention