char *getenv _((char *)); /* Usually in <stdlib.h> */
#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
#ifdef IAMSUID
#endif
}
+ init_stacks(ARGS);
#ifdef MULTIPLICITY
I_REINIT;
perl_destruct_level = 1;
fdpid = newAV(); /* for remembering popen pids by fd */
- init_stacks(ARGS);
DEBUG( {
New(51,debname,128,char);
New(52,debdelim,128,char);
if (hent) {
warn("Unbalanced string table refcount: (%d) for \"%s\"",
HeVAL(hent) - Nullsv, HeKEY(hent));
- HeVAL(hent) = Nullsv;
+ HeVAL(hent) = &sv_undef;
hent = HeNEXT(hent);
}
if (!hent) {
if (euid != uid || egid != gid)
croak("No -e allowed in setuid scripts");
if (!e_fp) {
+#ifdef HAS_UMASK
+ int oldumask = PerlLIO_umask(0177);
+#endif
e_tmpname = savepv(TMPPATH);
#ifdef HAS_MKSTEMP
e_tmpfd = PerlLIO_mkstemp(e_tmpname);
-
- if (e_tmpfd < 0)
- croak("Can't mkstemp() temporary file \"%s\"", e_tmpname);
- e_fp = PerlIO_fdopen(e_tmpfd,"w");
#else /* use mktemp() */
(void)PerlLIO_mktemp(e_tmpname);
if (!*e_tmpname)
- croak("Can't mktemp() temporary file \"%s\"", e_tmpname);
+ croak("Cannot generate temporary filename");
+# if defined(HAS_OPEN3) && defined(O_EXCL)
+ e_tmpfd = open(e_tmpname,
+ O_WRONLY | O_CREAT | O_EXCL,
+ 0600);
+# else
+ (void)UNLINK(e_tmpname);
+ /* Yes, potential race. But at least we can say we tried. */
e_fp = PerlIO_open(e_tmpname,"w");
-#endif /* HAS_MKSTEMP */
+# endif
+#endif /* ifdef HAS_MKSTEMP */
+#if defined(HAS_MKSTEMP) || (defined(HAS_OPEN3) && defined(O_EXCL))
+ if (e_tmpfd < 0)
+ croak("Cannot create temporary file \"%s\"", e_tmpname);
+ e_fp = PerlIO_fdopen(e_tmpfd,"w");
+#endif
if (!e_fp)
- croak("Cannot open temporary file \"%s\"", e_tmpname);
+ croak("Cannot create temporary file \"%s\"", e_tmpname);
+#ifdef HAS_UMASK
+ (void)PerlLIO_umask(oldumask);
+#endif
}
if (*++s)
PerlIO_puts(e_fp,s);
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Looking for %s\n",cur));
- if (Stat(cur,&statbuf) >= 0) {
+ if (PerlLIO_stat(cur,&statbuf) >= 0) {
dosearch = 0;
scriptname = cur;
#ifdef SEARCH_EXTS
do {
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
- retval = Stat(tokenbuf,&statbuf);
+ retval = PerlLIO_stat(tokenbuf,&statbuf);
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
xfailed = savepv(tokenbuf);
}
#ifndef DOSISH
- if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0))
+ if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
#endif
seen_dot = 1; /* Disable message. */
if (!xfound)
if (!rsfp) {
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
- if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
+ if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
statbuf.st_mode & (S_ISUID|S_ISGID)) {
/* try again */
PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
#endif
|| getuid() != euid || geteuid() != uid)
croak("Can't swap uid and euid"); /* really paranoid */
- if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
+ if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
croak("Permission denied"); /* testing full pathname here */
if (tmpstatbuf.st_dev != statbuf.st_dev ||
tmpstatbuf.st_ino != statbuf.st_ino) {
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
sv_catpv(subdir, archpat_auto);
- if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(incgv),
newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
strlen(patchlevel) + 1, "", 0);
- if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+ if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(incgv),
newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));