/* Destroy the main CV and syntax tree */
if (PL_main_root) {
+ /* ensure comppad/curpad to refer to main's pad */
+ if (CvPADLIST(PL_main_cv)) {
+ PAD_SET_CUR_NOSAVE(CvPADLIST(PL_main_cv), 1);
+ }
op_free(PL_main_root);
PL_main_root = Nullop;
}
* Non-referenced objects are on their own.
*/
sv_clean_objs();
+ PL_sv_objcount = 0;
}
/* unhook hooks which will soon be, or use, destroyed data */
PL_e_script = Nullsv;
}
+ PL_perldb = 0;
+
/* magical thingies */
SvREFCNT_dec(PL_ofs_sv); /* $, */
PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
+ PL_DBgv = Nullgv;
+ PL_DBline = Nullgv;
+ PL_DBsub = Nullgv;
+ PL_DBsingle = Nullsv;
+ PL_DBtrace = Nullsv;
+ PL_DBsignal = Nullsv;
+ PL_DBassertion = Nullsv;
+ PL_DBcv = Nullcv;
+ PL_dbargs = Nullav;
PL_debstash = Nullhv;
/* reset so print() ends up where we expect */
Safefree(PL_numeric_name);
PL_numeric_name = Nullch;
SvREFCNT_dec(PL_numeric_radix_sv);
+ PL_numeric_radix_sv = Nullsv;
#endif
/* clear utf8 character classes */
#ifdef USE_ITHREADS
/* free the pointer table used for cloning */
ptr_table_free(PL_ptr_table);
+ PL_ptr_table = (PTR_TBL_t*)NULL;
#endif
/* free special SVs */
}
}
#endif
+ PL_sv_count = 0;
#if defined(PERLIO_LAYERS)
SvREADONLY_off(&PL_sv_placeholder);
Safefree(PL_origfilename);
+ PL_origfilename = Nullch;
Safefree(PL_reg_start_tmp);
+ PL_reg_start_tmp = (char**)NULL;
+ PL_reg_start_tmpl = 0;
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
Safefree(PL_reg_poscache);
free_tied_hv_pool();
Safefree(PL_op_mask);
Safefree(PL_psig_ptr);
+ PL_psig_ptr = (SV**)NULL;
Safefree(PL_psig_name);
+ PL_psig_name = (SV**)NULL;
Safefree(PL_bitcount);
+ PL_bitcount = Nullch;
Safefree(PL_psig_pend);
+ PL_psig_pend = (int*)NULL;
+ PL_formfeed = Nullsv;
+ Safefree(PL_ofmt);
+ PL_ofmt = Nullch;
nuke_stacks();
+ PL_tainting = FALSE;
+ PL_taint_warn = FALSE;
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
+ PL_debug = 0;
DEBUG_P(debprofdump());
* 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();
+ PL_new_hash_seed = get_hash_seed();
{
char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
if (i == 1)
PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
- PL_hash_seed);
+ PL_new_hash_seed);
}
}
#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
static char *usage_msg[] = {
"-0[octal] specify record separator (\\0, if no argument)",
"-a autosplit mode with -n or -p (splits $_ into @F)",
-"-C enable native wide character system interfaces",
+"-C[number/list] enables the listed Unicode features",
"-c check syntax only (runs BEGIN and CHECK blocks)",
"-d[:debugger] run program under debugger",
"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
-"-e 'command' one line of program (several -e's allowed, omit programfile)",
+"-e program one line of program (several -e's allowed, omit programfile)",
"-F/pattern/ split() pattern for -a switch (//'s are optional)",
"-i[extension] edit <> files in place (makes backup if extension supplied)",
"-Idirectory specify @INC/#include directory (several -I's allowed)",
"-P run program through C preprocessor before compilation",
"-s enable rudimentary parsing for switches after programfile",
"-S look for programfile using PATH environment variable",
-"-T enable tainting checks",
"-t enable tainting warnings",
+"-T enable tainting checks",
"-u dump core after parsing program",
"-U allow unsafe operations",
"-v print version, subversion (includes VERY IMPORTANT perl info)",
"-V[:variable] print configuration summary (or a single Config.pm variable)",
"-w enable many useful warnings (RECOMMENDED)",
"-W enable all warnings",
-"-X disable all warnings",
"-x[directory] strip off text before #!perl line and perhaps cd to directory",
+"-X disable all warnings",
"\n",
NULL
};
sv_catpvn(sv, start, s-start);
sv_catpv(sv, " split(/,/,q{");
sv_catpv(sv, ++s);
- sv_catpv(sv, "})");
+ sv_catpv(sv, "})");
}
s += strlen(s);
my_setenv("PERL5DB", SvPV(sv, PL_na));
if (!PL_preambleav)
PL_preambleav = newAV();
if (*++s) {
- SV *sv = newSVpvn("use assertions::activate split(/,/,q{",37);
+ SV *sv = newSVpv("use assertions::activate split(/,/,q", 0);
+ sv_catpvn(sv, "\0", 1); /* Use NUL as q//-delimiter. */
sv_catpv(sv,s);
- sv_catpv(sv,"})");
+ sv_catpvn(sv, "\0)", 2);
s+=strlen(s);
av_push(PL_preambleav, sv);
}
Perl_croak(aTHX_ "Module name required with -%c option",
s[-1]);
sv_catpvn(sv, start, s-start);
- sv_catpv(sv, " split(/,/,q{");
+ sv_catpv(sv, " split(/,/,q");
+ sv_catpvn(sv, "\0)", 1); /* Use NUL as q//-delimiter. */
sv_catpv(sv, ++s);
- sv_catpv(sv, "})");
+ sv_catpvn(sv, "\0)", 2);
}
s += strlen(s);
if (!PL_preambleav)
# endif
# ifdef IAMSUID
errno = EPERM;
- Perl_croak(aTHX_ "Can't open perl script: %s\n",
- Strerror(errno));
+ Perl_croak(aTHX_ "Permission denied\n");
# else
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop), Strerror(errno));
* But I don't think it's too important. The manual lies when
* it says access() is useful in setuid programs.
*/
- if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/
- Perl_croak(aTHX_ "Permission denied");
+ if (PerlLIO_access(CopFILE(PL_curcop),1)) { /*double check*/
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n");
+ }
#else
/* If we can swap euid and uid, then we can determine access rights
* with a simple stat of the file, and then compare device and
#endif
|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
Perl_croak(aTHX_ "Can't swap uid and euid"); /* really paranoid */
- if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0)
- Perl_croak(aTHX_ "Permission denied"); /* testing full pathname here */
+ if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0) {
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n"); /* testing full pathname here */
+ }
#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
- if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
- Perl_croak(aTHX_ "Permission denied");
+ if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) {
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n");
+ }
#endif
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(void)PerlIO_close(PL_rsfp);
+ errno = EPERM;
Perl_croak(aTHX_ "Permission denied\n");
}
if (
#endif /* HAS_SETREUID */
#endif /* IAMSUID */
- if (!S_ISREG(PL_statbuf.st_mode))
- Perl_croak(aTHX_ "Permission denied");
+ if (!S_ISREG(PL_statbuf.st_mode)) {
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n");
+ }
if (PL_statbuf.st_mode & S_IWOTH)
Perl_croak(aTHX_ "Setuid/gid script is writable by world");
PL_doswitches = FALSE; /* -s is insecure in suid */
PL_euid == PL_statbuf.st_uid)
if (!PL_do_undump)
Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
-FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
+FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
#endif /* IAMSUID */
if (PL_euid) { /* oops, we're not the setuid root perl */
Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
else if (fdscript >= 0)
Perl_croak(aTHX_ "fd script not allowed in suidperl\n");
- else
- Perl_croak(aTHX_ "Script is not setuid/setgid in suidperl\n");
+ else {
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n");
+ }
/* We absolutely must clear out any saved ids here, so we */
/* exec the real perl, substituting fd script for scriptname. */
PerlIO_rewind(PL_rsfp);
PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0); /* just in case rewind didn't */
for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
- if (!PL_origargv[which])
- Perl_croak(aTHX_ "Permission denied");
+ if (!PL_origargv[which]) {
+ errno = EPERM;
+ Perl_croak(aTHX_ "Permission denied\n");
+ }
PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
PerlIO_fileno(PL_rsfp), PL_origargv[which]));
#if defined(HAS_FCNTL) && defined(F_SETFD)
sv_setiv(PL_DBtrace, 0);
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)));
+ PL_DBassertion = GvSV((gv_fetchpv("DB::assertion", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBassertion, 0);
PL_curstash = ostash;
}