diff options
| -rw-r--r-- | embed.fnc | 12 | ||||
| -rw-r--r-- | embed.h | 10 | ||||
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | intrpvar.h | 4 | ||||
| -rw-r--r-- | perl.c | 65 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | proto.h | 13 | ||||
| -rw-r--r-- | toke.c | 7 |
8 files changed, 58 insertions, 57 deletions
@@ -469,7 +469,7 @@ Ap |I32 |mg_size |NN SV* sv Ap |void |mini_mktime |NN struct tm *pm p |OP* |mod |NULLOK OP* o|I32 type p |int |mode_from_discipline|NULLOK SV* discp -Ap |char* |moreswitches |NN char* s +Ap |char* |moreswitches |NN char* s|int suidscript p |OP* |my |NN OP* o Ap |NV |my_atof |NN const char *s #if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) @@ -1134,8 +1134,8 @@ Ap |void |Slab_Free |NN void *op #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -s |void |find_beginning -s |void |forbid_setid |char flag +s |void |find_beginning |int suidscript +s |void |forbid_setid |char flag|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 @@ -1146,10 +1146,12 @@ 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 |int |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|int fdscript + |NN const char *scriptname|int fdscript \ + |int suidscript # if defined(IAMSUID) s |int |fd_on_nosuid_fs|int fd # endif @@ -2530,7 +2530,7 @@ #define mod(a,b) Perl_mod(aTHX_ a,b) #define mode_from_discipline(a) Perl_mode_from_discipline(aTHX_ a) #endif -#define moreswitches(a) Perl_moreswitches(aTHX_ a) +#define moreswitches(a,b) Perl_moreswitches(aTHX_ a,b) #ifdef PERL_CORE #define my(a) Perl_my(aTHX_ a) #endif @@ -3188,8 +3188,8 @@ #endif #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 find_beginning(a) S_find_beginning(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) @@ -3200,9 +3200,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,c) S_validate_suid(aTHX_ a,b,c) +#define validate_suid(a,b,c,d) S_validate_suid(aTHX_ a,b,c,d) #endif # if defined(IAMSUID) #ifdef PERL_CORE diff --git a/embedvar.h b/embedvar.h index ecc46a009a..f2e09eb963 100644 --- a/embedvar.h +++ b/embedvar.h @@ -393,7 +393,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_no (vTHX->Isv_no) @@ -674,7 +673,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_no PL_sv_no diff --git a/intrpvar.h b/intrpvar.h index 90f5514418..dc5868a1e8 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -515,10 +515,6 @@ PERLVARI(Irehash_seed, UV, 0) /* 582 hash initializer */ 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(Isuidscript, int, -1) /* fd for suid script */ #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP /* File descriptor to talk to the child which dumps scalars. */ PERLVARI(Idumper_fd, int, -1) @@ -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! */ @@ -584,8 +584,6 @@ END_EXTERN_C #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 @@ -1306,7 +1306,7 @@ PERL_CALLCONV void Perl_mini_mktime(pTHX_ struct tm *pm) PERL_CALLCONV OP* Perl_mod(pTHX_ OP* o, I32 type); PERL_CALLCONV int Perl_mode_from_discipline(pTHX_ SV* discp); -PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s) +PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s, int suidscript) __attribute__nonnull__(pTHX_1); PERL_CALLCONV OP* Perl_my(pTHX_ OP* o) @@ -3167,8 +3167,8 @@ PERL_CALLCONV void Perl_Slab_Free(pTHX_ void *op) #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -STATIC void S_find_beginning(pTHX); -STATIC void S_forbid_setid(pTHX_ char flag); +STATIC void S_find_beginning(pTHX_ int suidscript); +STATIC void S_forbid_setid(pTHX_ char flag, 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); @@ -3183,14 +3183,15 @@ STATIC void S_my_exit_jump(pTHX) __attribute__noreturn__; STATIC void S_nuke_stacks(pTHX); -STATIC int 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) __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_3); + __attribute__nonnull__(pTHX_3) + __attribute__nonnull__(pTHX_4); STATIC void S_usage(pTHX_ const char *name) __attribute__nonnull__(pTHX_1); -STATIC void S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript) +STATIC void S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, int suidscript) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); @@ -3008,7 +3008,12 @@ Perl_yylex(pTHX) Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); } - d = moreswitches(d); + /* Given that these switches are within the script, + then it is not unsafe to allow them even within + a suidperl fd script. Hence pass in the + suidscript flag as -1, irrespective of what we + really are. */ + d = moreswitches(d, -1); } while (d); if (PL_doswitches && !switches_done) { int argc = PL_origargc; |