This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Epigraph for v5.15.9
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 3610780..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();
 
     {
@@ -2076,10 +2072,10 @@ 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,
-                     linestr_sv, rsfp);
+       validate_suid(rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -2104,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);
@@ -2231,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)