}
void
-Perl_sys_term()
+Perl_sys_term(void)
{
dVAR;
if (!PL_veto_cleanup) {
init_i18nl10n(1);
+ /* Keep LC_NUMERIC in the C locale for backwards compatibility for XS
+ * modules. (Core operations that need the underlying locale change to it
+ * temporarily). An explicit call to POSIX::setlocale() still will cause
+ * XS module failures, but this is how it has been for a long time [perl
+ * #121317] */
+ SET_NUMERIC_STANDARD();
+
#if defined(LOCAL_PATCH_COUNT)
PL_localpatches = local_patches; /* For possible -v */
#endif
msg.msg_name = NULL;
msg.msg_namelen = 0;
msg.msg_iov = vec;
- msg.msg_iovlen = sizeof(vec)/sizeof(vec[0]);
+ msg.msg_iovlen = C_ARRAY_LENGTH(vec);
vec[0].iov_base = (void*)⌖
vec[0].iov_len = sizeof(target);
SvREFCNT_dec(PL_utf8_tofold);
SvREFCNT_dec(PL_utf8_idstart);
SvREFCNT_dec(PL_utf8_idcont);
+ SvREFCNT_dec(PL_utf8_foldable);
SvREFCNT_dec(PL_utf8_foldclosures);
SvREFCNT_dec(PL_AboveLatin1);
SvREFCNT_dec(PL_UpperLatin1);
PL_debug &= ~ DEBUG_m_FLAG;
}
while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
- safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+ safesysfree(PERL_MEMORY_DEBUG_HEADER_SIZE + (char *)(aTHXx->Imemory_debug_header.next));
PL_debug = old_debug;
}
}
* --jhi */
const char *s = NULL;
int i;
- const UV mask =
- ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
+ const UV mask = ~(UV)(PTRSIZE-1);
/* Do the mask check only if the args seem like aligned. */
const UV aligned =
(mask < ~(UV)0) && ((PTR2UV(argv[0]) & mask) == PTR2UV(argv[0]));
# ifdef NO_TAINT_SUPPORT
" NO_TAINT_SUPPORT"
# endif
+# ifdef PERL_BOOL_AS_CHAR
+ " PERL_BOOL_AS_CHAR"
+# endif
# ifdef PERL_DISABLE_PMC
" PERL_DISABLE_PMC"
# endif
break;
case 't':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
s++;
goto reswitch;
case 'T':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
}
}
if (*d == 't') {
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
" q quiet - currently only suppresses the 'EXECUTING' message\n"
" M trace smart match resolution\n"
" B dump suBroutine definitions, including special Blocks like BEGIN\n",
+ " L trace some locale setting information--for Perl core development\n",
NULL
};
int i = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBL";
for (; isWORDCHAR(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
return s;
case 't':
case 'T':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
#endif
PerlIO_printf(PIO_stdout,
- "\n\nCopyright 1987-2013, Larry Wall\n");
+ "\n\nCopyright 1987-2014, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PIO_stdout,
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
PerlIO *rsfp = NULL;
dVAR;
Stat_t tmpstatbuf;
+ int fd;
PERL_ARGS_ASSERT_OPEN_SCRIPT;
const char * const err = "Failed to create a fake bit bucket";
if (strEQ(scriptname, BIT_BUCKET)) {
#ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
+ int old_umask = umask(0600);
int tmpfd = mkstemp(tmpname);
+ umask(old_umask);
if (tmpfd > -1) {
scriptname = tmpname;
close(tmpfd);
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop), Strerror(errno));
}
+ fd = PerlIO_fileno(rsfp);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- /* ensure close-on-exec */
- fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+ if (fd >= 0) {
+ /* ensure close-on-exec */
+ if (fcntl(fd, F_SETFD, 1) < 0) {
+ Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+ CopFILE(PL_curcop), Strerror(errno));
+ }
+ }
#endif
- if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0
- && S_ISDIR(tmpstatbuf.st_mode))
+ if (fd < 0 ||
+ (PerlLIO_fstat(fd, &tmpstatbuf) >= 0
+ && S_ISDIR(tmpstatbuf.st_mode)))
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop),
Strerror(EISDIR));
if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */
dVAR;
-
- PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
- if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
- ||
- (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
- )
+ int fd = PerlIO_fileno(rsfp);
+ if (fd < 0) {
+ Perl_croak(aTHX_ "Illegal suidscript");
+ } else {
+ if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */
+ Perl_croak(aTHX_ "Illegal suidscript");
+ }
+ }
+ if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
+ ||
+ (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
+ )
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");
{
/* no need to do anything here any more if we don't
* do tainting. */
-#if !NO_TAINT_SUPPORT
+#ifndef NO_TAINT_SUPPORT
dVAR;
const Uid_t my_uid = PerlProc_getuid();
const Uid_t my_euid = PerlProc_geteuid();
#ifdef PERL_IS_MINIPERL
const Size_t extra = 0;
#else
- Size_t extra = av_len(av) + 1;
+ Size_t extra = av_tindex(av) + 1;
#endif
av_unshift(inc, extra + push_basedir);
if (push_basedir)
PERL_ARGS_ASSERT_CALL_LIST;
- while (av_len(paramList) >= 0) {
+ while (av_tindex(paramList) >= 0) {
cv = MUTABLE_CV(av_shift(paramList));
if (PL_savebegin) {
if (paramList == PL_beginav) {