dlmax = 128; \
laststatval = -1; \
laststype = OP_STAT; \
+ mess_sv = Nullsv; \
} STMT_END
static void find_beginning _((void));
if (origfilename)
Safefree(origfilename);
nuke_stacks();
- hints = 0; /* Reset hints. Should hints be per-interpreter ? */
+ hints = 0; /* Reset hints. Should hints be per-interpreter ? */
DEBUG_P(debprofdump());
+
+ /* As the absolutely last thing, free the non-arena SV for mess() */
+
+ if (mess_sv) {
+ /* we know that type >= SVt_PV */
+ SvOOK_off(mess_sv);
+ Safefree(SvPVX(mess_sv));
+ Safefree(SvANY(mess_sv));
+ Safefree(mess_sv);
+ mess_sv = Nullsv;
+ }
}
void
sv_catpv(Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
#if defined(DEBUGGING) || defined(NO_EMBED) || defined(MULTIPLICITY)
- strcpy(buf,"\" Compile-time options:");
+ sv_catpv(Sv,"\" Compile-time options:");
# ifdef DEBUGGING
- strcat(buf," DEBUGGING");
+ sv_catpv(Sv," DEBUGGING");
# endif
# ifdef NO_EMBED
- strcat(buf," NO_EMBED");
+ sv_catpv(Sv," NO_EMBED");
# endif
# ifdef MULTIPLICITY
- strcat(buf," MULTIPLICITY");
+ sv_catpv(Sv," MULTIPLICITY");
# endif
- strcat(buf,"\\n\",");
- sv_catpv(Sv,buf);
+ sv_catpv(Sv,"\\n\",");
#endif
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0) {
int i;
sv_catpv(Sv,"\" Locally applied patches:\\n\",");
for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
- if (localpatches[i]) {
- sprintf(buf,"\" \\t%s\\n\",",localpatches[i]);
- sv_catpv(Sv,buf);
- }
+ if (localpatches[i])
+ sv_catpvf(Sv,"\" \\t%s\\n\",",localpatches[i]);
}
}
#endif
- sprintf(buf,"\" Built under %s\\n\"",OSNAME);
- sv_catpv(Sv,buf);
+ sv_catpvf(Sv,"\" Built under %s\\n\"",OSNAME);
#ifdef __DATE__
# ifdef __TIME__
- sprintf(buf,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
+ sv_catpvf(Sv,",\" Compiled at %s %s\\n\"",__DATE__,__TIME__);
# else
- sprintf(buf,",\" Compiled on %s\\n\"",__DATE__);
+ sv_catpvf(Sv,",\" Compiled on %s\\n\"",__DATE__);
# endif
- sv_catpv(Sv,buf);
#endif
sv_catpv(Sv, "; \
$\"=\"\\n \"; \
forbid_setid("-d");
s++;
if (*s == ':' || *s == '=') {
- sprintf(buf, "use Devel::%s;", ++s);
+ my_setenv("PERL5DB", form("use Devel::%s;", ++s));
s += strlen(s);
- my_setenv("PERL5DB",buf);
}
if (!perldb) {
perldb = TRUE;
my_unexec()
{
#ifdef UNEXEC
+ SV* prog;
+ SV* file;
int status;
extern int etext;
- sprintf (buf, "%s.perldump", origfilename);
- sprintf (tokenbuf, "%s/perl", BIN_EXP);
+ prog = newSVpv(BIN_EXP);
+ sv_catpv(prog, "/perl");
+ file = newSVpv(origfilename);
+ sv_catpv(file, ".perldump");
- status = unexec(buf, tokenbuf, &etext, sbrk(0), 0);
+ status = unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
if (status)
- PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n", tokenbuf, buf);
+ PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n",
+ SvPVX(prog), SvPVX(file));
exit(status);
#else
# ifdef VMS
I32 len;
int retval;
#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
-#define SEARCH_EXTS ".bat", ".cmd", NULL
+# define SEARCH_EXTS ".bat", ".cmd", NULL
+# define MAX_EXT_LEN 4
#endif
#ifdef VMS
# define SEARCH_EXTS ".pl", ".com", NULL
+# define MAX_EXT_LEN 4
#endif
/* additional extensions to try in each dir if scriptname not found */
#ifdef SEARCH_EXTS
char *ext[] = { SEARCH_EXTS };
int extidx = (strchr(scriptname,'.')) ? -1 : 0; /* has ext already */
+#else
+# define MAX_EXT_LEN 0
#endif
#ifdef VMS
hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
/* The first time through, just add SEARCH_EXTS to whatever we
* already have, so we can check for default file types. */
- while (deftypes || (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) ) {
- if (deftypes) { deftypes = 0; *tokenbuf = '\0'; }
- strcat(tokenbuf,scriptname);
+ while (deftypes ||
+ (!hasdir && my_trnlnm("DCL$PATH",tokenbuf,idx++)) )
+ {
+ if (deftypes) {
+ deftypes = 0;
+ *tokenbuf = '\0';
+ }
+ if ((strlen(tokenbuf) + strlen(scriptname)
+ + MAX_EXT_LEN) >= sizeof tokenbuf)
+ continue; /* don't search dir with too-long name */
+ strcat(tokenbuf, scriptname);
#else /* !VMS */
if (dosearch && !strchr(scriptname, '/') && (s = getenv("PATH"))) {
-
bufend = s + strlen(s);
- while (*s) {
-#ifndef DOSISH
- s = cpytill(tokenbuf,s,bufend,':',&len);
-#else
-#ifdef atarist
- for (len = 0; *s && *s != ',' && *s != ';'; tokenbuf[len++] = *s++);
- tokenbuf[len] = '\0';
+ while (s < bufend) {
+#ifndef atarist
+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+#ifdef DOSISH
+ ';',
#else
- for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
- tokenbuf[len] = '\0';
+ ':',
#endif
-#endif
- if (*s)
+ &len);
+#else /* atarist */
+ for (len = 0; *s && *s != ',' && *s != ';'; len++, s++) {
+ if (len < sizeof tokenbuf)
+ tokenbuf[len] = *s;
+ }
+ if (len < sizeof tokenbuf)
+ tokenbuf[len] = '\0';
+#endif /* atarist */
+ if (s < bufend)
s++;
-#ifndef DOSISH
- if (len && tokenbuf[len-1] != '/')
-#else
-#ifdef atarist
- if (len && ((tokenbuf[len-1] != '\\') && (tokenbuf[len-1] != '/')))
-#else
- if (len && tokenbuf[len-1] != '\\')
-#endif
-#endif
- (void)strcat(tokenbuf+len,"/");
- (void)strcat(tokenbuf+len,scriptname);
+ if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
+ continue; /* don't search dir with too-long name */
+ if (len
+#if defined(atarist) && !defined(DOSISH)
+ && tokenbuf[len - 1] != '/'
+#endif
+#if defined(atarist) || defined(DOSISH)
+ && tokenbuf[len - 1] != '\\'
+#endif
+ )
+ tokenbuf[len++] = '/';
+ (void)strcpy(tokenbuf + len, scriptname);
#endif /* !VMS */
#ifdef SEARCH_EXTS
#endif
}
else if (preprocess) {
- char *cpp = CPPSTDIN;
+ char *cpp_cfg = CPPSTDIN;
+ SV *cpp = NEWSV(0,0);
+ SV *cmd = NEWSV(0,0);
+
+ if (strEQ(cpp_cfg, "cppstdin"))
+ sv_catpvf(cpp, "%s/", BIN_EXP);
+ sv_catpv(cpp, cpp_cfg);
- if (strEQ(cpp,"cppstdin"))
- sprintf(tokenbuf, "%s/%s", BIN_EXP, cpp);
- else
- sprintf(tokenbuf, "%s", cpp);
sv_catpv(sv,"-I");
sv_catpv(sv,PRIVLIB_EXP);
+
#ifdef MSDOS
- (void)sprintf(buf, "\
+ sv_setpvf(cmd, "\
sed %s -e \"/^[^#]/b\" \
-e \"/^#[ ]*include[ ]/b\" \
-e \"/^#[ ]*define[ ]/b\" \
-e \"/^#[ ]*undef[ ]/b\" \
-e \"/^#[ ]*endif/b\" \
-e \"s/^#.*//\" \
- %s | %s -C %s %s",
+ %s | %_ -C %_ %s",
(doextract ? "-e \"1,/^#/d\n\"" : ""),
#else
- (void)sprintf(buf, "\
+ sv_setpvf(cmd, "\
%s %s -e '/^[^#]/b' \
-e '/^#[ ]*include[ ]/b' \
-e '/^#[ ]*define[ ]/b' \
-e '/^#[ ]*undef[ ]/b' \
-e '/^#[ ]*endif/b' \
-e 's/^[ ]*#.*//' \
- %s | %s -C %s %s",
+ %s | %_ -C %_ %s",
#ifdef LOC_SED
LOC_SED,
#else
#endif
(doextract ? "-e '1,/^#/d\n'" : ""),
#endif
- scriptname, tokenbuf, SvPV(sv, na), CPPMINUS);
+ scriptname, cpp, sv, CPPMINUS);
doextract = FALSE;
#ifdef IAMSUID /* actually, this is caught earlier */
if (euid != uid && !euid) { /* if running suidperl */
croak("Can't do seteuid!\n");
}
#endif /* IAMSUID */
- rsfp = my_popen(buf,"r");
+ rsfp = my_popen(SvPVX(cmd), "r");
+ SvREFCNT_dec(cmd);
+ SvREFCNT_dec(cpp);
}
else if (!*scriptname) {
forbid_setid("program input from stdin");
#ifndef IAMSUID /* in case script is not readable before setuid */
if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
statbuf.st_mode & (S_ISUID|S_ISGID)) {
- (void)sprintf(buf, "%s/sperl%s", BIN_EXP, patchlevel);
- execv(buf, origargv); /* try again */
+ /* try again */
+ execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
croak("Can't do setuid\n");
}
#endif
if (euid) { /* oops, we're not the setuid root perl */
(void)PerlIO_close(rsfp);
#ifndef IAMSUID
- (void)sprintf(buf, "%s/sperl%s", BIN_EXP, patchlevel);
- execv(buf, origargv); /* try again */
+ /* try again */
+ execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
#endif
croak("Can't do setuid\n");
}
for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
if (!origargv[which])
croak("Permission denied");
- (void)sprintf(buf, "/dev/fd/%d/%.127s", PerlIO_fileno(rsfp), origargv[which]);
- origargv[which] = buf;
-
+ origargv[which] = savepv(form("/dev/fd/%d/%s",
+ PerlIO_fileno(rsfp), origargv[which]));
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
-
- (void)sprintf(tokenbuf, "%s/perl%s", BIN_EXP, patchlevel);
- execv(tokenbuf, origargv); /* try again */
+ execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv); /* try again */
croak("Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */