PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
+ INIT_TRACK_MEMPOOL(PL_memory_debug_header, my_perl);
return my_perl;
}
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
+#ifndef PERL_TRACK_MEMPOOL
return (PerlInterpreter *) ZeroD(my_perl, 1, PerlInterpreter);
+#else
+ Zero(my_perl, 1, PerlInterpreter);
+ INIT_TRACK_MEMPOOL(PL_memory_debug_header, my_perl);
+ return my_perl;
+#endif
}
#endif /* PERL_IMPLICIT_SYS */
void
perl_free(pTHXx)
{
+#ifdef PERL_TRACK_MEMPOOL
+ /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
+ thread at thread exit. */
+ while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
+ safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+#endif
+
#if defined(WIN32) || defined(NETWARE)
# if defined(PERL_IMPLICIT_SYS)
+ {
# ifdef NETWARE
- void *host = nw_internal_host;
+ void *host = nw_internal_host;
# else
- void *host = w32_internal_host;
+ void *host = w32_internal_host;
# endif
- PerlMem_free(aTHXx);
+ PerlMem_free(aTHXx);
# ifdef NETWARE
- nw_delete_internal_host(host);
+ nw_delete_internal_host(host);
# else
- win32_delete_internal_host(host);
+ win32_delete_internal_host(host);
# endif
+ }
# else
PerlMem_free(aTHXx);
# endif
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
- int fdscript;
- int suidscript;
sv_setpvn(PL_linestr,"",0);
sv = newSVpvs(""); /* first used for -I flags */
case 'X':
case 'w':
case 'A':
- if ((s = moreswitches(s, suidscript)))
+ if ((s = moreswitches(s)))
goto reswitch;
break;
if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
break;
#endif
- forbid_setid('e', suidscript);
+ forbid_setid('e', -1);
if (!PL_e_script) {
PL_e_script = newSVpvs("");
filter_add(read_e_script, NULL);
goto reswitch;
case 'I': /* -I handled both here and in moreswitches() */
- forbid_setid('I', suidscript);
+ forbid_setid('I', -1);
if (!*++s && (s=argv[1]) != NULL) {
argc--,argv++;
}
Perl_croak(aTHX_ "No directory specified for -I");
break;
case 'P':
- forbid_setid('P', suidscript);
+ forbid_setid('P', -1);
PL_preprocess = TRUE;
s++;
goto reswitch;
case 'S':
- forbid_setid('S', suidscript);
+ forbid_setid('S', -1);
dosearch = TRUE;
s++;
goto reswitch;
PL_tainting = TRUE;
}
} else {
- moreswitches(d, suidscript);
+ moreswitches(d);
}
}
}
else if (scriptname == NULL) {
#ifdef MSDOS
if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
- moreswitches("h", suidscript);
+ moreswitches("h");
#endif
scriptname = "-";
}
TAINT_NOT;
init_perllib();
- fdscript = open_script(scriptname, dosearch, sv, &suidscript);
+ {
+ int suidscript;
+ const int fdscript
+ = open_script(scriptname, dosearch, sv, &suidscript);
- validate_suid(validarg, scriptname, fdscript, suidscript);
+ 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(suidscript);
- 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);
/* This routine handles any switches that can be given during run */
char *
-Perl_moreswitches(pTHX_ char *s, const int suidscript)
+Perl_moreswitches(pTHX_ char *s)
{
dVAR;
UV rschar;
s++;
return s;
case 'd':
- forbid_setid('d', suidscript);
+ forbid_setid('d', -1);
s++;
/* -dt indicates to the debugger that threads will be used */
case 'D':
{
#ifdef DEBUGGING
- forbid_setid('D', suidscript);
+ forbid_setid('D', -1);
s++;
PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
#else /* !DEBUGGING */
}
return s;
case 'I': /* -I handled both here and in parse_body() */
- forbid_setid('I', suidscript);
+ forbid_setid('I', -1);
++s;
while (*s && isSPACE(*s))
++s;
}
return s;
case 'A':
- forbid_setid('A', suidscript);
+ forbid_setid('A', -1);
if (!PL_preambleav)
PL_preambleav = newAV();
s++;
return s;
}
case 'M':
- forbid_setid('M', suidscript); /* XXX ? */
+ forbid_setid('M', -1); /* XXX ? */
/* FALL THROUGH */
case 'm':
- forbid_setid('m', suidscript); /* XXX ? */
+ forbid_setid('m', -1); /* XXX ? */
if (*++s) {
char *start;
SV *sv;
s++;
return s;
case 's':
- forbid_setid('s', suidscript);
+ forbid_setid('s', -1);
PL_doswitches = TRUE;
s++;
return s;
sv_setpvn(get_sv("/", TRUE), "\n", 1);
}
-/* 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,
int *suidscript)
}
STATIC void
-S_find_beginning(pTHX_ const int suidscript)
+S_find_beginning(pTHX)
{
dVAR;
register char *s;
/* skip forward in input to the real script? */
- forbid_setid('x', suidscript);
#ifdef MACOS_TRADITIONAL
/* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
|| s2[-1] == '_') s2--;
if (strnEQ(s2-4,"perl",4))
- while ((s = moreswitches(s, suidscript)))
+ while ((s = moreswitches(s)))
;
}
#ifdef MACOS_TRADITIONAL
projects / p5sagit/p5-mst-13.2.git / blobdiff