Change 29854 by [EMAIL PROTECTED] on 2007/01/17 18:52:01
Integrate:
[ 27066]
It's actually easier to get rid of PL_fdscript than we thought.
[ 27068]
Oops. I *thought* that I had checked that all changed files were open.
Clearly not. (Fixes change 27066)
[ 27069]
Passing the flag to S_forbit_setid as a single char rather than a
string is a slight space optimisation.
[ 27070]
Eliminating PL_suidscript is more tricky, and requires changing the
prototype of Perl_moreswitches.
[ 27072]
Change 27070 failed to initialise a variable. (But despite that still
passed all tests locally.)
[ 27073]
Pull the variables fdscript and suidscript into a much smaller scope.
Replace suidscript with literal -1 where it could only have been -1.
(Re-indent the other code inside the new block creating the scope.
Rejig the indentation of the conditionals)
[ 27074]
The MSDOS-only call to moreswitches will never reach forbid_setid, so
it can have a parameter of -1 without changing any behaviour.
I see no reason to forbid "command line" switches when they are
actually coming from the #! line of the script itself (as read by perl)
as they must have been written by the owner of the script, rather than
being crafted by the user manipulating the command line, and therefore
cannot be subverted. (Or alternatively, can be subverted as easily as
the rest of the script, and we're permitting *that* to be run)
[ 27075]
And as we've now got to the point where all calls to Perl_moreswitches
have -1 as the second argument, we can remove the second argument,
which gets us back to where we started, only with the elimination of
a per-thread variable.
[ 27076]
S_find_beginning is only called from one place, so by hoisting the
forbid_setid check for -x into the caller, we can eliminate the
suidscript parameter from S_find_beginning.
[ 27077]
Remove obsolete comment.
[ 27087]
Fixed embed.fnc entry for S_forbid_setid() and picked up a change in
pod/perlapi.pod for good measure when regenerating files.
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#166 integrate
... //depot/maint-5.8/perl/embed.h#126 integrate
... //depot/maint-5.8/perl/embedvar.h#58 integrate
... //depot/maint-5.8/perl/intrpvar.h#50 integrate
... //depot/maint-5.8/perl/perl.c#181 integrate
... //depot/maint-5.8/perl/perlapi.h#50 integrate
... //depot/maint-5.8/perl/pod/perlapi.pod#80 integrate
... //depot/maint-5.8/perl/proto.h#155 integrate
... //depot/maint-5.8/perl/toke.c#131 integrate
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#166 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#165~29806~ 2007-01-14 04:49:30.000000000 -0800
+++ perl/embed.fnc 2007-01-17 10:52:01.000000000 -0800
@@ -1109,7 +1109,7 @@
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
s |void |find_beginning
-s |void |forbid_setid |NN const char * s
+s |void |forbid_setid |const char flag|const int suidscript
s |void |incpush |NULLOK const char *dir|bool addsubdirs|bool
addoldvers|bool usesep|bool canrelocate
s |void |init_interp
s |void |init_ids
@@ -1120,9 +1120,12 @@
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|NN int *suidscript
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 \
+ |int suidscript
# if defined(IAMSUID)
s |int |fd_on_nosuid_fs|int fd
# endif
==== //depot/maint-5.8/perl/embed.h#126 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#125~29806~ 2007-01-14 04:49:30.000000000 -0800
+++ perl/embed.h 2007-01-17 10:52:01.000000000 -0800
@@ -3188,7 +3188,7 @@
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define find_beginning() S_find_beginning(aTHX)
-#define forbid_setid(a) S_forbid_setid(aTHX_ a)
+#define forbid_setid(a,b) S_forbid_setid(aTHX_ a,b)
#define incpush(a,b,c,d,e) S_incpush(aTHX_ a,b,c,d,e)
#define init_interp() S_init_interp(aTHX)
#define init_ids() S_init_ids(aTHX)
@@ -3199,9 +3199,9 @@
#define init_predump_symbols() S_init_predump_symbols(aTHX)
#define my_exit_jump() S_my_exit_jump(aTHX)
#define nuke_stacks() S_nuke_stacks(aTHX)
-#define open_script(a,b,c) S_open_script(aTHX_ a,b,c)
+#define open_script(a,b,c,d) S_open_script(aTHX_ a,b,c,d)
#define usage(a) S_usage(aTHX_ a)
-#define validate_suid(a,b) S_validate_suid(aTHX_ a,b)
+#define validate_suid(a,b,c,d) S_validate_suid(aTHX_ a,b,c,d)
#endif
# if defined(IAMSUID)
#ifdef PERL_CORE
==== //depot/maint-5.8/perl/embedvar.h#58 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#57~29846~ 2007-01-17 03:36:40.000000000 -0800
+++ perl/embedvar.h 2007-01-17 10:52:01.000000000 -0800
@@ -758,7 +758,6 @@
#define PL_sublex_info (vTHX->Isublex_info)
#define PL_subline (vTHX->Isubline)
#define PL_subname (vTHX->Isubname)
-#define PL_suidscript (vTHX->Isuidscript)
#define PL_sv_arenaroot (vTHX->Isv_arenaroot)
#define PL_sv_count (vTHX->Isv_count)
#define PL_sv_lock_mutex (vTHX->Isv_lock_mutex)
@@ -1091,7 +1090,6 @@
#define PL_Isublex_info PL_sublex_info
#define PL_Isubline PL_subline
#define PL_Isubname PL_subname
-#define PL_Isuidscript PL_suidscript
#define PL_Isv_arenaroot PL_sv_arenaroot
#define PL_Isv_count PL_sv_count
#define PL_Isv_lock_mutex PL_sv_lock_mutex
==== //depot/maint-5.8/perl/intrpvar.h#50 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#49~29846~ 2007-01-17 03:36:40.000000000 -0800
+++ perl/intrpvar.h 2007-01-17 10:52:01.000000000 -0800
@@ -574,9 +574,10 @@
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. */
+/* These two variables aren't used any more, but need to be kept for bincompat.
+ The irony is that they were added to avoid changing the prototypes of static
+ functions, which actualy could have been changed quite safely without
+ breaking bincompat. */
PERLVARI(Ifdscript, int, -1) /* fd for script */
PERLVARI(Isuidscript, int, -1) /* fd for suid script */
==== //depot/maint-5.8/perl/perl.c#181 (text) ====
Index: perl/perl.c
--- perl/perl.c#180~29846~ 2007-01-17 03:36:40.000000000 -0800
+++ perl/perl.c 2007-01-17 10:52:01.000000000 -0800
@@ -1734,8 +1734,6 @@
bool minus_f = FALSE;
#endif
- PL_fdscript = -1;
- PL_suidscript = -1;
sv_setpvn(PL_linestr,"",0);
sv = newSVpvs(""); /* first used for -I flags */
SAVEFREESV(sv);
@@ -1809,7 +1807,7 @@
if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
break;
#endif
- forbid_setid("-e");
+ forbid_setid('e', -1);
if (!PL_e_script) {
PL_e_script = newSVpvs("");
filter_add(read_e_script, NULL);
@@ -1833,7 +1831,7 @@
goto reswitch;
case 'I': /* -I handled both here and in moreswitches() */
- forbid_setid("-I");
+ forbid_setid('I', -1);
if (!*++s && (s=argv[1]) != NULL) {
argc--,argv++;
}
@@ -1850,12 +1848,12 @@
Perl_croak(aTHX_ "No directory specified for -I");
break;
case 'P':
- forbid_setid("-P");
+ forbid_setid('P', -1);
PL_preprocess = TRUE;
s++;
goto reswitch;
case 'S':
- forbid_setid("-S");
+ forbid_setid('S', -1);
dosearch = TRUE;
s++;
goto reswitch;
@@ -2159,36 +2157,45 @@
TAINT_NOT;
init_perllib();
- open_script(scriptname,dosearch,sv);
+ {
+ int suidscript;
+ const int fdscript
+ = open_script(scriptname, dosearch, sv, &suidscript);
- validate_suid(validarg, scriptname);
+ validate_suid(validarg, scriptname, fdscript, suidscript);
#ifndef PERL_MICRO
-#if defined(SIGCHLD) || defined(SIGCLD)
- {
-#ifndef SIGCHLD
-# define SIGCHLD SIGCLD
-#endif
- Sighandler_t sigstate = rsignal_state(SIGCHLD);
- if (sigstate == (Sighandler_t) SIG_IGN) {
- if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
- "Can't ignore signal CHLD, forcing to default");
- (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
+# if defined(SIGCHLD) || defined(SIGCLD)
+ {
+# ifndef SIGCHLD
+# define SIGCHLD SIGCLD
+# endif
+ Sighandler_t sigstate = rsignal_state(SIGCHLD);
+ if (sigstate == (Sighandler_t) SIG_IGN) {
+ if (ckWARN(WARN_SIGNAL))
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
+ "Can't ignore signal CHLD, forcing to default");
+ (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
+ }
}
- }
-#endif
+# endif
#endif
+ if (PL_doextract
#ifdef MACOS_TRADITIONAL
- if (PL_doextract || gMacPerl_AlwaysExtract) {
-#else
- if (PL_doextract) {
+ || gMacPerl_AlwaysExtract
#endif
- find_beginning();
- if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
- Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+ ) {
+ /* This will croak if suidscript is >= 0, as -x cannot be used with
+ setuid scripts. */
+ forbid_setid('x', suidscript);
+ /* Hence you can't get here if suidscript >= 0 */
+
+ find_beginning();
+ if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
+ Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+ }
}
PL_main_cv = PL_compcv = (CV*)newSV(0);
@@ -3187,7 +3194,7 @@
s++;
return s;
case 'd':
- forbid_setid("-d");
+ forbid_setid('d', -1);
s++;
/* -dt indicates to the debugger that threads will be used */
@@ -3221,7 +3228,7 @@
case 'D':
{
#ifdef DEBUGGING
- forbid_setid("-D");
+ forbid_setid('D', -1);
s++;
PL_debug = get_debug_opts_flags( &s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
@@ -3253,7 +3260,7 @@
}
return s;
case 'I': /* -I handled both here and in parse_body() */
- forbid_setid("-I");
+ forbid_setid('I', -1);
++s;
while (*s && isSPACE(*s))
++s;
@@ -3302,10 +3309,10 @@
}
return s;
case 'M':
- forbid_setid("-M"); /* XXX ? */
+ forbid_setid('M', -1); /* XXX ? */
/* FALL THROUGH */
case 'm':
- forbid_setid("-m"); /* XXX ? */
+ forbid_setid('m', -1); /* XXX ? */
if (*++s) {
char *start;
SV *sv;
@@ -3352,7 +3359,7 @@
s++;
return s;
case 's':
- forbid_setid("-s");
+ forbid_setid('s', -1);
PL_doswitches = TRUE;
s++;
return s;
@@ -3642,9 +3649,9 @@
sv_setpvn(get_sv("/", TRUE), "\n", 1);
}
-/* PSz 18 Nov 03 fdscript now global but do not change prototype */
-STATIC void
-S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
+STATIC int
+S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
+ int *suidscript)
{
#ifndef IAMSUID
const char *quote;
@@ -3652,9 +3659,9 @@
const char *cpp_discard_flag;
const char *perl;
#endif
+ int fdscript = -1;
- PL_fdscript = -1;
- PL_suidscript = -1;
+ *suidscript = -1;
if (PL_e_script) {
PL_origfilename = savepvs("-e");
@@ -3665,7 +3672,7 @@
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) {
@@ -3678,7 +3685,7 @@
* 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?
@@ -3700,8 +3707,8 @@
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 */
@@ -3721,7 +3728,7 @@
* 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 */
@@ -3792,7 +3799,7 @@
SvREFCNT_dec(cpp);
}
else if (!*scriptname) {
- forbid_setid("program input from stdin");
+ forbid_setid(0, *suidscript);
PL_rsfp = PerlIO_stdin();
}
else {
@@ -3812,6 +3819,7 @@
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop), Strerror(errno));
}
+ return fdscript;
}
/* Mention
@@ -3949,7 +3957,8 @@
#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, int suidscript)
{
#ifdef IAMSUID
/* int which; */
@@ -3993,7 +4002,7 @@
const char *s_end;
#ifdef IAMSUID
- if (PL_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
@@ -4143,7 +4152,7 @@
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)
@@ -4151,7 +4160,7 @@
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
@@ -4164,7 +4173,7 @@
* 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
@@ -4272,7 +4281,7 @@
#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 || suidscript != 1)
/* PSz 13 Nov 03 Caught elsewhere, useless(?!) here */
Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n");
else {
@@ -4365,7 +4374,6 @@
/* skip forward in input to the real script? */
- forbid_setid("-x");
#ifdef MACOS_TRADITIONAL
/* Since the Mac OS does not honor #! arguments for us, we do it ourselves
*/
@@ -4485,14 +4493,26 @@
return 0;
}
+/* Passing the flag as a single char rather than a string is a slight space
+ optimisation. The only message that isn't /^-.$/ is
+ "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 *s)
+S_forbid_setid(pTHX_ const char flag, const int suidscript)
{
+ char string[3] = "-x";
+ const char *message = "program input from stdin";
+
+ if (flag) {
+ string[1] = flag;
+ message = string;
+ }
+
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
if (PL_euid != PL_uid)
- Perl_croak(aTHX_ "No %s allowed while running setuid", s);
+ Perl_croak(aTHX_ "No %s allowed while running setuid", message);
if (PL_egid != PL_gid)
- Perl_croak(aTHX_ "No %s allowed while running setgid", s);
+ Perl_croak(aTHX_ "No %s allowed while running setgid", message);
#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
/* PSz 29 Feb 04
* Checks for UID/GID above "wrong": why disallow
@@ -4516,11 +4536,11 @@
*
* Also see comments about root running a setuid script, elsewhere.
*/
- if (PL_suidscript >= 0)
- Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", s);
+ if (suidscript >= 0)
+ Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
#ifdef IAMSUID
/* PSz 11 Nov 03 Catch it in suidperl, always! */
- Perl_croak(aTHX_ "No %s allowed in suidperl", s);
+ Perl_croak(aTHX_ "No %s allowed in suidperl", message);
#endif /* IAMSUID */
}
==== //depot/maint-5.8/perl/perlapi.h#50 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#49~29846~ 2007-01-17 03:36:40.000000000 -0800
+++ perl/perlapi.h 2007-01-17 10:52:01.000000000 -0800
@@ -283,8 +283,6 @@
#define PL_fdpid (*Perl_Ifdpid_ptr(aTHX))
#undef PL_fdpid_mutex
#define PL_fdpid_mutex (*Perl_Ifdpid_mutex_ptr(aTHX))
-#undef PL_fdscript
-#define PL_fdscript (*Perl_Ifdscript_ptr(aTHX))
#undef PL_filemode
#define PL_filemode (*Perl_Ifilemode_ptr(aTHX))
#undef PL_forkprocess
@@ -597,8 +595,6 @@
#define PL_subline (*Perl_Isubline_ptr(aTHX))
#undef PL_subname
#define PL_subname (*Perl_Isubname_ptr(aTHX))
-#undef PL_suidscript
-#define PL_suidscript (*Perl_Isuidscript_ptr(aTHX))
#undef PL_sv_arenaroot
#define PL_sv_arenaroot (*Perl_Isv_arenaroot_ptr(aTHX))
#undef PL_sv_count
==== //depot/maint-5.8/perl/proto.h#155 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#154~29806~ 2007-01-14 04:49:30.000000000 -0800
+++ perl/proto.h 2007-01-17 10:52:01.000000000 -0800
@@ -1645,7 +1645,7 @@
#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
STATIC void S_find_beginning(pTHX);
-STATIC void S_forbid_setid(pTHX_ const char * s);
+STATIC void S_forbid_setid(pTHX_ const char flag, const int suidscript);
STATIC void S_incpush(pTHX_ const char *dir, bool addsubdirs, bool
addoldvers, bool usesep, bool canrelocate);
STATIC void S_init_interp(pTHX);
STATIC void S_init_ids(pTHX);
@@ -1658,9 +1658,9 @@
__attribute__noreturn__;
STATIC void S_nuke_stacks(pTHX);
-STATIC void S_open_script(pTHX_ const char *scriptname, bool dosearch, SV
*sv);
+STATIC int S_open_script(pTHX_ const char *scriptname, bool dosearch, SV
*sv, int *suidscript);
STATIC void S_usage(pTHX_ const char *name);
-STATIC void S_validate_suid(pTHX_ const char *validarg, const char
*scriptname);
+STATIC void S_validate_suid(pTHX_ const char *validarg, const char
*scriptname, int fdscript, int suidscript);
# if defined(IAMSUID)
STATIC int S_fd_on_nosuid_fs(pTHX_ int fd);
# endif
End of Patch.
