if (PL_perl_destruct_level > 0)
init_interp();
#endif
-
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
#ifdef PERL_FLEXIBLE_EXCEPTIONS
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;
}
PL_origargc = argc;
PL_origargv = argv;
+ {
+ /* Set PL_origalen be the sum of the contiguous argv[]
+ * elements plus the size of the env in case that it is
+ * contiguous with the argv[]. This is used in mg.c:mg_set()
+ * as the maximum modifiable length of $0. In the worst case
+ * the area we are able to modify is limited to the size of
+ * the original argv[0].
+ * --jhi */
+ char *s;
+ int i;
+ int mask =
+ ~(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
+
+ /* See if all the arguments are contiguous in memory.
+ * Note that 'contiguous' is a loose term because some
+ * platforms align the argv[] and the envp[]. We just check
+ * that they are within aligned 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 &&
+ PL_origargv[i] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+ s = PL_origargv[i];
+ while (*s) s++;
+ }
+ else
+ break;
+ }
+ /* Can we grab env area too to be used as the area for $0? */
+ if (PL_origenviron &&
+ PL_origenviron[0] > s &&
+ PL_origenviron[0] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+ s = PL_origenviron[0];
+ while (*s) s++;
+ my_setenv("NoNe SuCh", Nullch);
+ /* Force copy of environment. */
+ for (i = 1; PL_origenviron[i]; i++)
+ if (PL_origenviron[i] > s &&
+ PL_origenviron[i] <=
+ INT2PTR(char *, PTR2UV(s + PTRSIZE) & mask)) {
+ s = PL_origenviron[i];
+ while (*s) s++;
+ }
+ else
+ break;
+ }
+ PL_origalen = s - PL_origargv[0];
+ }
+
if (PL_do_undump) {
/* Come here if running an undumped a.out. */
break;
case 't':
+ CHECK_MALLOC_TOO_LATE_FOR('t');
if( !PL_tainting ) {
PL_taint_warn = TRUE;
PL_tainting = TRUE;
s++;
goto reswitch;
case 'T':
+ CHECK_MALLOC_TOO_LATE_FOR('T');
PL_tainting = TRUE;
PL_taint_warn = FALSE;
s++;
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
+ CHECK_MALLOC_TOO_LATE_FOR('T');
PL_tainting = TRUE;
PL_taint_warn = FALSE;
}
PerlIO_printf(PerlIO_stdout(), "\n %s", *p++);
}
+/* convert a string of -D options (or digits) into an int.
+ * sets *s to point to the char after the options */
+
+#ifdef DEBUGGING
+int
+Perl_get_debug_opts(pTHX_ char **s)
+{
+ int i = 0;
+ if (isALPHA(**s)) {
+ /* if adding extra options, remember to update DEBUG_MASK */
+ static char debopts[] = "psltocPmfrxu HXDSTRJvC";
+
+ for (; isALNUM(**s); (*s)++) {
+ char *d = strchr(debopts,**s);
+ if (d)
+ i |= 1 << (d - debopts);
+ else if (ckWARN_d(WARN_DEBUGGING))
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+ "invalid option -D%c\n", **s);
+ }
+ }
+ else {
+ i = atoi(*s);
+ for (; isALNUM(**s); (*s)++) ;
+ }
+# ifdef EBCDIC
+ if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
+ "-Dp not implemented on this platform\n");
+# endif
+ return i;
+}
+#endif
+
/* This routine handles any switches that can be given during run */
char *
{
#ifdef DEBUGGING
forbid_setid("-D");
- if (isALPHA(s[1])) {
- /* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxu HXDSTRJvC";
- char *d;
-
- for (s++; *s && (d = strchr(debopts,*s)); s++)
- PL_debug |= 1 << (d - debopts);
- }
- else {
- PL_debug = atoi(s+1);
- for (s++; isDIGIT(*s); s++) ;
- }
-#ifdef EBCDIC
- if (DEBUG_p_TEST_ && ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
- "-Dp not implemented on this platform\n");
-#endif
- PL_debug |= DEBUG_TOP_FLAG;
+ s++;
+ PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
if (ckWARN_d(WARN_DEBUGGING))
Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
return s;
case 't':
if (!PL_tainting)
- Perl_croak(aTHX_ "Too late for \"-t\" option");
+ TOO_LATE_FOR('t');
s++;
return s;
case 'T':
if (!PL_tainting)
- Perl_croak(aTHX_ "Too late for \"-T\" option");
+ TOO_LATE_FOR('T');
s++;
return s;
case 'u':
PL_uid |= PL_gid << 16;
PL_euid |= PL_egid << 16;
#endif
+ /* Should not happen: */
+ CHECK_MALLOC_TAINT(PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
}
+/* 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. */
+bool
+Perl_doing_taint(int argc, char *argv[], char *envp[])
+{
+ int uid = PerlProc_getuid();
+ int euid = PerlProc_geteuid();
+ int gid = PerlProc_getgid();
+ int egid = PerlProc_getegid();
+
+#ifdef VMS
+ uid |= gid << 16;
+ euid |= egid << 16;
+#endif
+ if (uid && (euid != uid || egid != gid))
+ return 1;
+ /* This is a really primitive check; environment gets ignored only
+ * if -T are the first chars together; otherwise one gets
+ * "Too late" message. */
+ if ( argc > 1 && argv[1][0] == '-'
+ && (argv[1][1] == 't' || argv[1][1] == 'T') )
+ return 1;
+ return 0;
+}
+
STATIC void
S_forbid_setid(pTHX_ char *s)
{
char *s;
SV *sv;
GV* tmpgv;
- char **dup_env_base = 0;
- int dup_env_count = 0;
PL_toptarget = NEWSV(0,0);
sv_upgrade(PL_toptarget, SVt_PVFM);
{
environ[0] = Nullch;
}
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
- {
- char **env_base;
- for (env_base = env; *env; env++)
- dup_env_count++;
- if ((dup_env_base = (char **)
- safesysmalloc( sizeof(char *) * (dup_env_count+1) ))) {
- char **dup_env;
- for (env = env_base, dup_env = dup_env_base;
- *env;
- env++, dup_env++) {
- /* With environ one needs to use safesysmalloc(). */
- *dup_env = safesysmalloc(strlen(*env) + 1);
- (void)strcpy(*dup_env, *env);
- }
- *dup_env = Nullch;
- env = dup_env_base;
- } /* else what? */
- }
-#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
if (env)
for (; *env; env++) {
if (!(s = strchr(*env,'=')))
if (env != environ)
mg_set(sv);
}
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
- if (dup_env_base) {
- char **dup_env;
- for (dup_env = dup_env_base; *dup_env; dup_env++)
- safesysfree(*dup_env);
- safesysfree(dup_env_base);
- }
-#endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
#endif /* USE_ENVIRON_ARRAY */
}
TAINT_NOT;
https://perl5.git.perl.org / perl5.git / blobdiff