Eliminating PL_suidscript is more tricky, and requires changing the

prototype of Perl_moreswitches.

p4raw-id: //depot/perl@27070

1 files changed, 33 insertions, 32 deletions

diff --git a/perl.c b/perl.c
index 24f06f0d67..5f9b99b92c 100644
--- a/perl.c
+++ b/perl.c
@@ -1594,8 +1594,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     bool minus_f = FALSE;
 #endif
     int fdscript;
+    int suidscript;
 
-    PL_suidscript = -1;
     sv_setpvn(PL_linestr,"",0);
     sv = newSVpvs("");		/* first used for -I flags */
     SAVEFREESV(sv);
@@ -1645,7 +1645,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	case 'X':
 	case 'w':
 	case 'A':
-	    if ((s = moreswitches(s)))
+	    if ((s = moreswitches(s, suidscript)))
 		goto reswitch;
 	    break;
 
@@ -1673,7 +1673,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
 		break;
 #endif
-	    forbid_setid('e');
+	    forbid_setid('e', suidscript);
 	    if (!PL_e_script) {
 		PL_e_script = newSVpvs("");
 		filter_add(read_e_script, NULL);
@@ -1697,7 +1697,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    goto reswitch;
 
 	case 'I':	/* -I handled both here and in moreswitches() */
-	    forbid_setid('I');
+	    forbid_setid('I', suidscript);
 	    if (!*++s && (s=argv[1]) != NULL) {
 		argc--,argv++;
 	    }
@@ -1714,12 +1714,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		Perl_croak(aTHX_ "No directory specified for -I");
 	    break;
 	case 'P':
-	    forbid_setid('P');
+	    forbid_setid('P', suidscript);
 	    PL_preprocess = TRUE;
 	    s++;
 	    goto reswitch;
 	case 'S':
-	    forbid_setid('S');
+	    forbid_setid('S', suidscript);
 	    dosearch = TRUE;
 	    s++;
 	    goto reswitch;
@@ -1983,7 +1983,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		        PL_tainting = TRUE;
 		    }
 		} else {
-		    moreswitches(d);
+		    moreswitches(d, suidscript);
 		}
 	    }
 	}
@@ -2011,7 +2011,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     else if (scriptname == NULL) {
 #ifdef MSDOS
 	if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
-	    moreswitches("h");
+	    moreswitches("h", suidscript);
 #endif
 	scriptname = "-";
     }
@@ -2023,9 +2023,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     TAINT_NOT;
     init_perllib();
 
-    fdscript = open_script(scriptname,dosearch,sv);
+    fdscript = open_script(scriptname, dosearch, sv, &suidscript);
 
-    validate_suid(validarg, scriptname, fdscript);
+    validate_suid(validarg, scriptname, fdscript, suidscript);
 
 #ifndef PERL_MICRO
 #if defined(SIGCHLD) || defined(SIGCLD)
@@ -2049,7 +2049,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #else
     if (PL_doextract) {
 #endif
-	find_beginning();
+	find_beginning(suidscript);
 	if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
 	    Perl_croak(aTHX_ "Can't chdir to %s",cddir);
 
@@ -2934,7 +2934,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 /* This routine handles any switches that can be given during run */
 
 char *
-Perl_moreswitches(pTHX_ char *s)
+Perl_moreswitches(pTHX_ char *s, const int suidscript)
 {
     dVAR;
     UV rschar;
@@ -3002,7 +3002,7 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 'd':
-	forbid_setid('d');
+	forbid_setid('d', suidscript);
 	s++;
 
         /* -dt indicates to the debugger that threads will be used */
@@ -3036,7 +3036,7 @@ Perl_moreswitches(pTHX_ char *s)
     case 'D':
     {	
 #ifdef DEBUGGING
-	forbid_setid('D');
+	forbid_setid('D', suidscript);
 	s++;
 	PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
@@ -3068,7 +3068,7 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	return s;
     case 'I':	/* -I handled both here and in parse_body() */
-	forbid_setid('I');
+	forbid_setid('I', suidscript);
 	++s;
 	while (*s && isSPACE(*s))
 	    ++s;
@@ -3117,7 +3117,7 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	return s;
     case 'A':
-	forbid_setid('A');
+	forbid_setid('A', suidscript);
 	if (!PL_preambleav)
 	    PL_preambleav = newAV();
 	s++;
@@ -3140,10 +3140,10 @@ Perl_moreswitches(pTHX_ char *s)
 	    return s;
 	}
     case 'M':
-	forbid_setid('M');	/* XXX ? */
+	forbid_setid('M', suidscript);	/* XXX ? */
 	/* FALL THROUGH */
     case 'm':
-	forbid_setid('m');	/* XXX ? */
+	forbid_setid('m', suidscript);	/* XXX ? */
 	if (*++s) {
 	    char *start;
 	    SV *sv;
@@ -3190,7 +3190,7 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 's':
-	forbid_setid('s');
+	forbid_setid('s', suidscript);
 	PL_doswitches = TRUE;
 	s++;
 	return s;
@@ -3501,7 +3501,8 @@ S_init_main_stash(pTHX)
 
 /* PSz 18 Nov 03  fdscript now global but do not change prototype */
 STATIC int
-S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
+S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
+	      int *suidscript)
 {
 #ifndef IAMSUID
     const char *quote;
@@ -3512,7 +3513,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     int fdscript = -1;
     dVAR;
 
-    PL_suidscript = -1;
+    *suidscript = -1;
 
     if (PL_e_script) {
 	PL_origfilename = savepvs("-e");
@@ -3536,7 +3537,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 		 * Is it a mistake to use a similar /dev/fd/ construct for
 		 * suidperl?
 		 */
-		PL_suidscript = 1;
+		*suidscript = 1;
 		/* PSz 20 Feb 04  
 		 * Be supersafe and do some sanity-checks.
 		 * Still, can we be sure we got the right thing?
@@ -3579,7 +3580,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
  * perl with that fd as it has always done.
  */
     }
-    if (PL_suidscript != 1) {
+    if (*suidscript != 1) {
 	Perl_croak(aTHX_ "suidperl needs (suid) fd script\n");
     }
 #else /* IAMSUID */
@@ -3650,7 +3651,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 	SvREFCNT_dec(cpp);
     }
     else if (!*scriptname) {
-	forbid_setid(0);
+	forbid_setid(0, *suidscript);
 	PL_rsfp = PerlIO_stdin();
     }
     else {
@@ -3809,7 +3810,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 
 STATIC void
 S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
-		int fdscript)
+		int fdscript, int suidscript)
 {
     dVAR;
 #ifdef IAMSUID
@@ -3854,7 +3855,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	const char *s_end;
 
 #ifdef IAMSUID
-	if (fdscript < 0 || PL_suidscript != 1)
+	if (fdscript < 0 || suidscript != 1)
 	    Perl_croak(aTHX_ "Need (suid) fdscript in suidperl\n");	/* We already checked this */
 	/* PSz 11 Nov 03
 	 * Since the script is opened by perl, not suidperl, some of these
@@ -4133,7 +4134,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 #ifdef IAMSUID
     else if (PL_preprocess)	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
 	Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
-    else if (fdscript < 0 || PL_suidscript != 1)
+    else if (fdscript < 0 || suidscript != 1)
 	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
 	Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n");
     else {
@@ -4216,7 +4217,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 }
 
 STATIC void
-S_find_beginning(pTHX)
+S_find_beginning(pTHX_ const int suidscript)
 {
     dVAR;
     register char *s;
@@ -4227,7 +4228,7 @@ S_find_beginning(pTHX)
 
     /* skip forward in input to the real script? */
 
-    forbid_setid('x');
+    forbid_setid('x', suidscript);
 #ifdef MACOS_TRADITIONAL
     /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
 
@@ -4263,7 +4264,7 @@ S_find_beginning(pTHX)
 		while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
 		       || s2[-1] == '_') s2--;
 		if (strnEQ(s2-4,"perl",4))
-		    while ((s = moreswitches(s)))
+		    while ((s = moreswitches(s, suidscript)))
 			;
 	    }
 #ifdef MACOS_TRADITIONAL
@@ -4353,7 +4354,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
    "program input from stdin", which is substituted in place of '\0', which
    could never be a command line flag.  */
 STATIC void
-S_forbid_setid(pTHX_ const char flag)
+S_forbid_setid(pTHX_ const char flag, const int suidscript)
 {
     dVAR;
     char string[3] = "-x";
@@ -4392,7 +4393,7 @@ S_forbid_setid(pTHX_ const char flag)
      * 
      * Also see comments about root running a setuid script, elsewhere.
      */
-    if (PL_suidscript >= 0)
+    if (suidscript >= 0)
         Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
 #ifdef IAMSUID
     /* PSz 11 Nov 03  Catch it in suidperl, always! */