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;
("__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
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;
}
/* 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
environ = PL_origenviron;
}
#endif
+#endif /* !PERL_MICRO */
#ifdef USE_ITHREADS
/* the syntax tree is shared between clones
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)
#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;
* 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);
* 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) {
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 */
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)));
#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(),
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);
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
(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");
}
#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 */
/* 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[])
{
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);
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
mg_set(sv);
}
#endif /* USE_ENVIRON_ARRAY */
+#endif /* !PERL_MICRO */
}
TAINT_NOT;
if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
projects / p5sagit/p5-mst-13.2.git / blobdiff