From: Nicholas Clark Date: Fri, 3 Feb 2006 17:06:04 +0000 (+0000) Subject: It's actually easier to get rid of PL_fdscript than we thought. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fdf5d70d65ee03574d2027e28d2b7ce4eaddfe91;p=p5sagit%2Fp5-mst-13.2.git It's actually easier to get rid of PL_fdscript than we thought. p4raw-id: //depot/perl@27066 --- diff --git a/embed.fnc b/embed.fnc index e90c4a1..9c9cba8 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1146,9 +1146,10 @@ s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env s |void |init_predump_symbols rs |void |my_exit_jump s |void |nuke_stacks -s |void |open_script |NN const char *scriptname|bool dosearch|NN SV *sv +s |int |open_script |NN const char *scriptname|bool dosearch|NN SV *sv s |void |usage |NN const char *name -s |void |validate_suid |NN const char *validarg|NN const char *scriptname +s |void |validate_suid |NN const char *validarg \ + |NN const char *scriptname|int fdscript # if defined(IAMSUID) s |int |fd_on_nosuid_fs|int fd # endif diff --git a/intrpvar.h b/intrpvar.h index 08551a5..90f5514 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -518,7 +518,6 @@ PERLVARI(Irehash_seed_set, bool, FALSE) /* 582 hash initialized? */ /* These two variables are needed to preserve 5.8.x bincompat because we can't change function prototypes of two exported functions. Probably should be taken out of blead soon, and relevant prototypes changed. */ -PERLVARI(Ifdscript, int, -1) /* fd for script */ PERLVARI(Isuidscript, int, -1) /* fd for suid script */ #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP /* File descriptor to talk to the child which dumps scalars. */ diff --git a/perl.c b/perl.c index 3229e16..7a1eadd 100644 --- a/perl.c +++ b/perl.c @@ -1593,8 +1593,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #ifdef USE_SITECUSTOMIZE bool minus_f = FALSE; #endif + int fdscript; - PL_fdscript = -1; PL_suidscript = -1; sv_setpvn(PL_linestr,"",0); sv = newSVpvs(""); /* first used for -I flags */ @@ -2023,9 +2023,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) TAINT_NOT; init_perllib(); - open_script(scriptname,dosearch,sv); + fdscript = open_script(scriptname,dosearch,sv); - validate_suid(validarg, scriptname); + validate_suid(validarg, scriptname, fdscript); #ifndef PERL_MICRO #if defined(SIGCHLD) || defined(SIGCLD) @@ -3500,7 +3500,7 @@ S_init_main_stash(pTHX) } /* PSz 18 Nov 03 fdscript now global but do not change prototype */ -STATIC void +STATIC int S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv) { #ifndef IAMSUID @@ -3509,9 +3509,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv) const char *cpp_discard_flag; const char *perl; #endif + int fdscript = -1; dVAR; - PL_fdscript = -1; PL_suidscript = -1; if (PL_e_script) { @@ -3523,7 +3523,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv) if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) { const char *s = scriptname + 8; - PL_fdscript = atoi(s); + fdscript = atoi(s); while (isDIGIT(*s)) s++; if (*s) { @@ -3558,8 +3558,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv) CopFILE_set(PL_curcop, PL_origfilename); if (*PL_origfilename == '-' && PL_origfilename[1] == '\0') scriptname = (char *)""; - if (PL_fdscript >= 0) { - PL_rsfp = PerlIO_fdopen(PL_fdscript,PERL_SCRIPT_MODE); + if (fdscript >= 0) { + PL_rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); # if defined(HAS_FCNTL) && defined(F_SETFD) if (PL_rsfp) /* ensure close-on-exec */ @@ -3670,6 +3670,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + return fdscript; } /* Mention @@ -3807,7 +3808,8 @@ S_fd_on_nosuid_fs(pTHX_ int fd) #endif /* IAMSUID */ STATIC void -S_validate_suid(pTHX_ const char *validarg, const char *scriptname) +S_validate_suid(pTHX_ const char *validarg, const char *scriptname, + int fdscript) { dVAR; #ifdef IAMSUID @@ -3852,7 +3854,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname) const char *s_end; #ifdef IAMSUID - if (PL_fdscript < 0 || PL_suidscript != 1) + if (fdscript < 0 || PL_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 @@ -4002,7 +4004,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname) Perl_croak(aTHX_ "Args must match #! line"); #ifndef IAMSUID - if (PL_fdscript < 0 && + if (fdscript < 0 && PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) && PL_euid == PL_statbuf.st_uid) if (!PL_do_undump) @@ -4010,7 +4012,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname) FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); #endif /* IAMSUID */ - if (PL_fdscript < 0 && + if (fdscript < 0 && PL_euid) { /* oops, we're not the setuid root perl */ /* PSz 18 Feb 04 * When root runs a setuid script, we do not go through the same @@ -4023,7 +4025,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); * might run also non-setuid ones, and deserves what he gets. * * Or, we might drop the PL_euid check above (and rely just on - * PL_fdscript to avoid loops), and do the execs + * fdscript to avoid loops), and do the execs * even for root. */ #ifndef IAMSUID @@ -4131,7 +4133,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 (PL_fdscript < 0 || PL_suidscript != 1) + else if (fdscript < 0 || PL_suidscript != 1) /* PSz 13 Nov 03 Caught elsewhere, useless(?!) here */ Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n"); else {