From: Gurusamy Sarathy Date: Mon, 26 Apr 1999 17:30:31 +0000 (+0000) Subject: allow embedded null characters in diagnostics X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=06bf62c76633176572262d33d1b4072ea6d227a8;p=p5sagit%2Fp5-mst-13.2.git allow embedded null characters in diagnostics p4raw-id: //depot/perl@3274 --- diff --git a/pp_ctl.c b/pp_ctl.c index 7ac600b..0beaea9 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1319,7 +1319,7 @@ dounwind(I32 cxix) } OP * -die_where(char *message) +die_where(char *message, STRLEN msglen) { dSP; STRLEN n_a; @@ -1332,9 +1332,8 @@ die_where(char *message) if (message) { if (PL_in_eval & 4) { SV **svp; - STRLEN klen = strlen(message); - svp = hv_fetch(ERRHV, message, klen, TRUE); + svp = hv_fetch(ERRHV, message, msglen, TRUE); if (svp) { if (!SvIOK(*svp)) { static char prefix[] = "\t(in cleanup) "; @@ -1343,11 +1342,11 @@ die_where(char *message) (void)SvIOK_only(*svp); if (!SvPOK(err)) sv_setpv(err,""); - SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); + SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); sv_catpvn(err, prefix, sizeof(prefix)-1); - sv_catpvn(err, message, klen); + sv_catpvn(err, message, msglen); if (ckWARN(WARN_UNSAFE)) { - STRLEN start = SvCUR(err)-klen-sizeof(prefix)+1; + STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; warner(WARN_UNSAFE, SvPVX(err)+start); } } @@ -1355,10 +1354,10 @@ die_where(char *message) } } else - sv_setpv(ERRSV, message); + sv_setpvn(ERRSV, message, msglen); } else - message = SvPVx(ERRSV, n_a); + message = SvPVx(ERRSV, msglen); while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { dounwind(-1); @@ -1373,7 +1372,8 @@ die_where(char *message) POPBLOCK(cx,PL_curpm); if (CxTYPE(cx) != CXt_EVAL) { - PerlIO_printf(PerlIO_stderr(), "panic: die %s", message); + PerlIO_write(PerlIO_stderr(), "panic: die ", 11); + PerlIO_write(PerlIO_stderr(), message, msglen); my_exit(1); } POPEVAL(cx); @@ -1392,13 +1392,13 @@ die_where(char *message) } } if (!message) - message = SvPVx(ERRSV, n_a); + message = SvPVx(ERRSV, msglen); { #ifdef USE_SFIO /* SFIO can really mess with your errno */ int e = errno; #endif - PerlIO_puts(PerlIO_stderr(), message); + PerlIO_write(PerlIO_stderr(), message, msglen); (void)PerlIO_flush(PerlIO_stderr()); #ifdef USE_SFIO errno = e; diff --git a/pp_sys.c b/pp_sys.c index 3998497..45eee0b 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -400,27 +400,31 @@ PP(pp_rcatline) PP(pp_warn) { djSP; dMARK; + SV *tmpsv; char *tmps; - STRLEN n_a; + STRLEN len; if (SP - MARK != 1) { dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); - tmps = SvPV(TARG, n_a); + tmpsv = TARG; SP = MARK + 1; } else { - tmps = SvPV(TOPs, n_a); + tmpsv = TOPs; } - if (!tmps || !*tmps) { + tmps = SvPV(tmpsv, len); + if (!tmps || !len) { SV *error = ERRSV; (void)SvUPGRADE(error, SVt_PV); if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...caught"); - tmps = SvPV(error, n_a); + tmpsv = error; + tmps = SvPV(tmpsv, len); } - if (!tmps || !*tmps) - tmps = "Warning: something's wrong"; - warn("%s", tmps); + if (!tmps || !len) + tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26)); + + warn("%_", tmpsv); RETSETYES; } @@ -428,26 +432,28 @@ PP(pp_die) { djSP; dMARK; char *tmps; - SV *tmpsv = Nullsv; - char *pat = "%s"; - STRLEN n_a; + SV *tmpsv; + STRLEN len; + bool multiarg = 0; if (SP - MARK != 1) { dTARGET; do_join(TARG, &PL_sv_no, MARK, SP); - tmps = SvPV(TARG, n_a); + tmpsv = TARG; + tmps = SvPV(tmpsv, len); + multiarg = 1; SP = MARK + 1; } else { tmpsv = TOPs; - tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a); + tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len); } - if (!tmps || !*tmps) { + if (!tmps || !len) { SV *error = ERRSV; (void)SvUPGRADE(error, SVt_PV); - if(tmpsv ? SvROK(tmpsv) : SvROK(error)) { - if(tmpsv) + if (multiarg ? SvROK(error) : SvROK(tmpsv)) { + if (!multiarg) SvSetSV(error,tmpsv); - else if(sv_isobject(error)) { + else if (sv_isobject(error)) { HV *stash = SvSTASH(SvRV(error)); GV *gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { @@ -464,17 +470,19 @@ PP(pp_die) sv_setsv(error,*PL_stack_sp--); } } - pat = Nullch; + DIE(Nullch); } else { if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...propagated"); - tmps = SvPV(error, n_a); + tmpsv = error; + tmps = SvPV(tmpsv, len); } } - if (!tmps || !*tmps) - tmps = "Died"; - DIE(pat, tmps); + if (!tmps || !len) + tmpsv = sv_2mortal(newSVpvn("Died", 4)); + + DIE("%_", tmpsv); } /* I/O. */ diff --git a/proto.h b/proto.h index cc98104..d430c45 100644 --- a/proto.h +++ b/proto.h @@ -91,7 +91,7 @@ VIRTUAL char* delimcpy _((char* to, char* toend, char* from, char* fromend, int delim, I32* retlen)); VIRTUAL void deprecate _((char* s)); VIRTUAL OP* die _((const char* pat,...)); -VIRTUAL OP* die_where _((char* message)); +VIRTUAL OP* die_where _((char* message, STRLEN msglen)); VIRTUAL void dounwind _((I32 cxix)); VIRTUAL bool do_aexec _((SV* really, SV** mark, SV** sp)); VIRTUAL int do_binmode _((PerlIO *fp, int iotype, int flag)); @@ -302,7 +302,7 @@ VIRTUAL void markstack_grow _((void)); #ifdef USE_LOCALE_COLLATE VIRTUAL char* mem_collxfrm _((const char* s, STRLEN len, STRLEN* xlen)); #endif -VIRTUAL char* mess _((const char* pat, va_list* args)); +VIRTUAL SV* mess _((const char* pat, va_list* args)); VIRTUAL int mg_clear _((SV* sv)); VIRTUAL int mg_copy _((SV* sv, SV* nsv, const char* key, I32 klen)); VIRTUAL MAGIC* mg_find _((SV* sv, int type)); diff --git a/regcomp.c b/regcomp.c index d8a62da..2755d61 100644 --- a/regcomp.c +++ b/regcomp.c @@ -3192,6 +3192,7 @@ re_croak2(const char* pat1,const char* pat2,...) STRLEN l1 = strlen(pat1); STRLEN l2 = strlen(pat2); char buf[512]; + SV *msv; char *message; if (l1 > 510) @@ -3203,9 +3204,9 @@ re_croak2(const char* pat1,const char* pat2,...) buf[l1 + l2] = '\n'; buf[l1 + l2 + 1] = '\0'; va_start(args, pat2); - message = mess(buf, &args); + msv = mess(buf, &args); va_end(args); - l1 = strlen(message); + message = SvPV(msv,l1); if (l1 > 512) l1 = 512; Copy(message, buf, l1 , char); diff --git a/t/op/die.t b/t/op/die.t index d473ed6..cf4f8b0 100755 --- a/t/op/die.t +++ b/t/op/die.t @@ -4,7 +4,7 @@ print "1..10\n"; $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ; -$err = "ok 1\n"; +$err = "#[\000]\nok 1\n"; eval { die $err; }; diff --git a/util.c b/util.c index b6a9fe0..1318c31 100644 --- a/util.c +++ b/util.c @@ -1213,7 +1213,7 @@ form(const char* pat, ...) return SvPVX(sv); } -char * +SV * mess(const char *pat, va_list *args) { SV *sv = mess_alloc(); @@ -1239,7 +1239,7 @@ mess(const char *pat, va_list *args) sv_catpv(sv, ".\n"); } } - return SvPVX(sv); + return sv; } OP * @@ -1252,13 +1252,21 @@ die(const char* pat, ...) HV *stash; GV *gv; CV *cv; + SV *msv; + STRLEN msglen; DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: die: curstack = %p, mainstack = %p\n", thr, PL_curstack, PL_mainstack)); va_start(args, pat); - message = pat ? mess(pat, &args) : Nullch; + if (pat) { + msv = mess(pat, &args); + message = SvPV(msv,msglen); + } + else { + message = Nullch; + } va_end(args); DEBUG_S(PerlIO_printf(PerlIO_stderr(), @@ -1278,7 +1286,7 @@ die(const char* pat, ...) ENTER; if (message) { - msg = newSVpv(message, 0); + msg = newSVpvn(message, msglen); SvREADONLY_on(msg); SAVEFREESV(msg); } @@ -1296,7 +1304,7 @@ die(const char* pat, ...) } } - PL_restartop = die_where(message); + PL_restartop = die_where(message, msglen); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n", thr, PL_restartop, was_in_eval, PL_top_env)); @@ -1314,9 +1322,12 @@ croak(const char* pat, ...) HV *stash; GV *gv; CV *cv; + SV *msv; + STRLEN msglen; va_start(args, pat); - message = mess(pat, &args); + msv = mess(pat, &args); + message = SvPV(msv,msglen); va_end(args); DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message)); if (PL_diehook) { @@ -1332,7 +1343,7 @@ croak(const char* pat, ...) SV *msg; ENTER; - msg = newSVpv(message, 0); + msg = newSVpvn(message, msglen); SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1346,7 +1357,7 @@ croak(const char* pat, ...) } } if (PL_in_eval) { - PL_restartop = die_where(message); + PL_restartop = die_where(message, msglen); JMPENV_JUMP(3); } { @@ -1354,7 +1365,7 @@ croak(const char* pat, ...) /* SFIO can really mess with your errno */ int e = errno; #endif - PerlIO_puts(PerlIO_stderr(), message); + PerlIO_write(PerlIO_stderr(), message, msglen); (void)PerlIO_flush(PerlIO_stderr()); #ifdef USE_SFIO errno = e; @@ -1371,9 +1382,12 @@ warn(const char* pat,...) HV *stash; GV *gv; CV *cv; + SV *msv; + STRLEN msglen; va_start(args, pat); - message = mess(pat, &args); + msv = mess(pat, &args); + message = SvPV(msv, msglen); va_end(args); if (PL_warnhook) { @@ -1390,7 +1404,7 @@ warn(const char* pat,...) SV *msg; ENTER; - msg = newSVpv(message, 0); + msg = newSVpvn(message, msglen); SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1404,7 +1418,7 @@ warn(const char* pat,...) return; } } - PerlIO_puts(PerlIO_stderr(),message); + PerlIO_write(PerlIO_stderr(), message, msglen); #ifdef LEAKTEST DEBUG_L(*message == '!' ? (xstat(message[1]=='!' @@ -1425,9 +1439,12 @@ warner(U32 err, const char* pat,...) HV *stash; GV *gv; CV *cv; + SV *msv; + STRLEN msglen; va_start(args, pat); - message = mess(pat, &args); + msv = mess(pat, &args); + message = SvPV(msv, msglen); va_end(args); if (ckDEAD(err)) { @@ -1447,7 +1464,7 @@ warner(U32 err, const char* pat,...) SV *msg; ENTER; - msg = newSVpv(message, 0); + msg = newSVpvn(message, msglen); SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1460,10 +1477,10 @@ warner(U32 err, const char* pat,...) } } if (PL_in_eval) { - PL_restartop = die_where(message); + PL_restartop = die_where(message, msglen); JMPENV_JUMP(3); } - PerlIO_puts(PerlIO_stderr(),message); + PerlIO_write(PerlIO_stderr(), message, msglen); (void)PerlIO_flush(PerlIO_stderr()); my_failure_exit(); @@ -1483,7 +1500,7 @@ warner(U32 err, const char* pat,...) SV *msg; ENTER; - msg = newSVpv(message, 0); + msg = newSVpvn(message, msglen); SvREADONLY_on(msg); SAVEFREESV(msg); @@ -1496,7 +1513,7 @@ warner(U32 err, const char* pat,...) return; } } - PerlIO_puts(PerlIO_stderr(),message); + PerlIO_write(PerlIO_stderr(), message, msglen); #ifdef LEAKTEST DEBUG_L(xstat()); #endif