X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=0569d5b4265fa2b77a27ceaf1c3a221107e17505;hb=ed1af28e435c4f4992490e18b640d9daa5b5326a;hp=73f3273c0dbfded4d56568aed5906638b3532272;hpb=43c32782ed6d18ddfca58337454582a388bfa6f8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 73f3273..0569d5b 100644 --- a/perl.c +++ b/perl.c @@ -181,6 +181,9 @@ perl_construct(pTHXx) SvNV(&PL_sv_yes); SvREADONLY_on(&PL_sv_yes); SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; + + SvREADONLY_on(&PL_sv_placeholder); + SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2; } PL_sighandlerp = Perl_sighandler; @@ -260,8 +263,10 @@ perl_construct(pTHXx) ("__environ", (unsigned long *) &environ_pointer, NULL); #endif /* environ */ -#ifdef USE_ENVIRON_ARRAY +#ifndef PERL_MICRO +# ifdef USE_ENVIRON_ARRAY PL_origenviron = environ; +# endif #endif /* Use sysconf(_SC_CLK_TCK) if available, if not @@ -274,39 +279,6 @@ perl_construct(pTHXx) PL_stashcache = newHV(); -#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) - /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 */ - { - char *s = NULL; - - if (!PL_earlytaint) - s = PerlEnv_getenv("PERL_HASH_SEED"); - if (s) - while (isSPACE(*s)) s++; - if (s && isDIGIT(*s)) - PL_hash_seed = (UV)Atoul(s); -#ifndef USE_HASH_SEED_EXPLICIT - else { - /* Compute a random seed */ - (void)seedDrand01((Rand_seed_t)seed()); - PL_srand_called = TRUE; - PL_hash_seed = (UV)(Drand01() * (NV)UV_MAX); -#if RANDBITS < (UVSIZE * 8) - { - int skip = (UVSIZE * 8) - RANDBITS; - PL_hash_seed >>= skip; - /* The low bits might need extra help. */ - PL_hash_seed += (UV)(Drand01() * ((1 << skip) - 1)); - } -#endif /* RANDBITS < (UVSIZE * 8) */ - } -#endif /* USE_HASH_SEED_EXPLICIT */ - if (!PL_earlytaint && (s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"))) - PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n", - PL_hash_seed); - } -#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ - ENTER; } @@ -439,6 +411,7 @@ perl_destruct(pTHXx) /* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied * so we certainly shouldn't free it here */ +#ifndef PERL_MICRO #if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV) if (environ != PL_origenviron #ifdef USE_ITHREADS @@ -458,6 +431,7 @@ perl_destruct(pTHXx) environ = PL_origenviron; } #endif +#endif /* !PERL_MICRO */ #ifdef USE_ITHREADS /* the syntax tree is shared between clones @@ -816,6 +790,9 @@ perl_destruct(pTHXx) SvREFCNT(&PL_sv_undef) = 0; SvREADONLY_off(&PL_sv_undef); + SvREFCNT(&PL_sv_placeholder) = 0; + SvREADONLY_off(&PL_sv_placeholder); + Safefree(PL_origfilename); Safefree(PL_reg_start_tmp); if (PL_reg_curpm) @@ -930,6 +907,27 @@ setuid perl scripts securely.\n"); #endif #endif +#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) + /* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0 + * This MUST be done before any hash stores or fetches take place. + * If you set PL_hash_seed (and assumedly also PL_hash_seed_set) yourself, + * it is your responsibility to provide a good random seed! + * You can also define PERL_HASH_SEED in compile time, see hv.h. */ + if (!PL_hash_seed_set) + PL_hash_seed = get_hash_seed(); + { + char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); + + if (s) { + int i = atoi(s); + + if (i == 1) + PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n", + PL_hash_seed); + } + } +#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ + PL_origargc = argc; PL_origargv = argv; @@ -941,7 +939,7 @@ setuid perl scripts securely.\n"); * the area we are able to modify is limited to the size of * the original argv[0]. (See below for 'contiguous', though.) * --jhi */ - char *s; + char *s = NULL; int i; UV mask = ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0); @@ -958,26 +956,27 @@ setuid perl scripts securely.\n"); * PTRSIZE bytes. As long as no system has something bizarre * like the argv[] interleaved with some other data, we are * fine. (Did I just evoke Murphy's Law?) --jhi */ - s = PL_origargv[0]; - while (*s) s++; - for (i = 1; i < PL_origargc; i++) { - if ((PL_origargv[i] == s + 1 + if (PL_origargv && PL_origargc >= 1 && (s = PL_origargv[0])) { + while (*s) s++; + for (i = 1; i < PL_origargc; i++) { + if ((PL_origargv[i] == s + 1 #ifdef OS2 - || PL_origargv[i] == s + 2 + || PL_origargv[i] == s + 2 #endif - ) - || - (aligned && - (PL_origargv[i] > s && - PL_origargv[i] <= - INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask))) - ) - { - s = PL_origargv[i]; - while (*s) s++; + ) + || + (aligned && + (PL_origargv[i] > s && + PL_origargv[i] <= + INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask))) + ) + { + s = PL_origargv[i]; + while (*s) s++; + } + else + break; } - else - break; } /* Can we grab env area too to be used as the area for $0? */ if (PL_origenviron) { @@ -1450,9 +1449,7 @@ print \" \\@INC:\\n @INC\\n\";"); boot_core_PerlIO(); boot_core_UNIVERSAL(); -#ifndef PERL_MICRO boot_core_xsutils(); -#endif if (xsinit) (*xsinit)(aTHX); /* in case linked C routines want magical variables */ @@ -1670,7 +1667,7 @@ S_run_body(pTHX_ I32 oldscope) if (!PL_restartop) { DEBUG_x(dump_all()); - DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); + PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n", PTR2UV(thr))); @@ -2639,7 +2636,7 @@ Perl_moreswitches(pTHX_ char *s) #endif #ifdef MPE PerlIO_printf(PerlIO_stdout(), - "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2002\n"); + "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2003\n"); #endif #ifdef OEMVS PerlIO_printf(PerlIO_stdout(), @@ -2883,6 +2880,8 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) SV *cpp = newSVpvn("",0); SV *cmd = NEWSV(0,0); + if (cpp_cfg[0] == 0) /* PERL_MICRO? */ + Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined"); if (strEQ(cpp_cfg, "cppstdin")) Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP); sv_catpv(cpp, cpp_cfg); @@ -2980,10 +2979,12 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ + PERL_FPU_PRE_EXEC PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION), PL_origargv); + PERL_FPU_POST_EXEC Perl_croak(aTHX_ "Can't do setuid\n"); } # endif @@ -3240,9 +3241,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); (void)PerlIO_close(PL_rsfp); #ifndef IAMSUID /* try again */ + PERL_FPU_PRE_EXEC PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION), PL_origargv); + PERL_FPU_POST_EXEC #endif Perl_croak(aTHX_ "Can't do setuid\n"); } @@ -3324,9 +3327,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #if defined(HAS_FCNTL) && defined(F_SETFD) fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */ #endif + PERL_FPU_PRE_EXEC PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP, (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION), PL_origargv);/* try again */ + PERL_FPU_POST_EXEC Perl_croak(aTHX_ "Can't do setuid\n"); #endif /* IAMSUID */ #else /* !DOSUID */ @@ -3432,8 +3437,7 @@ S_init_ids(pTHX) /* This is used very early in the lifetime of the program, * before even the options are parsed, so PL_tainting has - * not been initialized properly. The variable PL_earlytaint - * is set early in main() to the result of this function. */ + * not been initialized properly. */ bool Perl_doing_taint(int argc, char *argv[], char *envp[]) { @@ -3482,17 +3486,17 @@ Perl_init_debugger(pTHX) HV *ostash = PL_curstash; PL_curstash = PL_debstash; - PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV)))); + PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV)))); AvREAL_off(PL_dbargs); - PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV); - PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV); - PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV)); + PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV); + PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV); + PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV)); sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if PERLDB_SUB_NN */ - PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV))); + PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBsingle, 0); - PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV))); + PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBtrace, 0); - PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV))); + PL_DBsignal = GvSV((gv_fetchpv("DB::signal", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBsignal, 0); PL_DBassertion = GvSV((gv_fetchpv("assertion", GV_ADDMULTI, SVt_PV))); sv_setiv(PL_DBassertion, 0); @@ -3734,6 +3738,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); hv_magic(hv, Nullgv, PERL_MAGIC_env); +#ifndef PERL_MICRO #ifdef USE_ENVIRON_ARRAY /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory @@ -3765,6 +3770,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register mg_set(sv); } #endif /* USE_ENVIRON_ARRAY */ +#endif /* !PERL_MICRO */ } TAINT_NOT; if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {