X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=0341f6e9d6296a96bf733b121cea1823b8fb0442;hb=4207d19c588387e70524000ff324caaf2ca59f41;hp=cc015475707f2a560d1983a0dd54bc7fece1d1d4;hpb=d931b1bedc59d4625c59047dfda2b1bd83ff9f71;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index cc01547..0341f6e 100644 --- a/mg.c +++ b/mg.c @@ -57,6 +57,10 @@ tie. # include #endif +#ifdef HAS_PRCTL_SET_NAME +# include +#endif + #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) Signal_t Perl_csighandler(int sig, siginfo_t *, void *); #else @@ -193,7 +197,7 @@ Perl_mg_get(pTHX_ SV *sv) { dVAR; const I32 mgs_ix = SSNEW(sizeof(MGS)); - const bool was_temp = (bool)SvTEMP(sv); + const bool was_temp = cBOOL(SvTEMP(sv)); bool have_new = 0; MAGIC *newmg, *head, *cur, *mg; /* guard against sv having being freed midway by holding a private @@ -991,8 +995,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) } break; case '^': - if (GvIOp(PL_defoutgv)) - s = IoTOP_NAME(GvIOp(PL_defoutgv)); + if (!isGV_with_GP(PL_defoutgv)) + s = ""; + else if (GvIOp(PL_defoutgv)) + s = IoTOP_NAME(GvIOp(PL_defoutgv)); if (s) sv_setpv(sv,s); else { @@ -1001,22 +1007,24 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) } break; case '~': - if (GvIOp(PL_defoutgv)) + if (!isGV_with_GP(PL_defoutgv)) + s = ""; + else if (GvIOp(PL_defoutgv)) s = IoFMT_NAME(GvIOp(PL_defoutgv)); if (!s) s = GvENAME(PL_defoutgv); sv_setpv(sv,s); break; case '=': - if (GvIOp(PL_defoutgv)) + if (GvIO(PL_defoutgv)) sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv))); break; case '-': - if (GvIOp(PL_defoutgv)) + if (GvIO(PL_defoutgv)) sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv))); break; case '%': - if (GvIOp(PL_defoutgv)) + if (GvIO(PL_defoutgv)) sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv))); break; case ':': @@ -1027,7 +1035,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop)); break; case '|': - if (GvIOp(PL_defoutgv)) + if (GvIO(PL_defoutgv)) sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 ); break; case '\\': @@ -1048,7 +1056,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) else #endif sv_setpv(sv, errno ? Strerror(errno) : ""); - SvPOK_on(sv); /* may have got removed during taint processing */ + if (SvPOKp(sv)) + SvPOK_on(sv); /* may have got removed during taint processing */ RESTORE_ERRNO; } @@ -1690,7 +1699,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg) { PERL_ARGS_ASSERT_MAGIC_GETPACK; - if (mg->mg_ptr) + if (mg->mg_type == PERL_MAGIC_tiedelem) mg->mg_flags |= MGf_GSKIP; magic_methpack(sv,mg,"FETCH"); return 0; @@ -1700,12 +1709,33 @@ int Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg) { dVAR; dSP; + MAGIC *tmg; + SV *val; PERL_ARGS_ASSERT_MAGIC_SETPACK; + /* in the code C<$tied{foo} = $val>, the "thing" that gets passed to + * STORE() is not $val, but rather a PVLV (the sv in this call), whose + * public flags indicate its value based on copying from $val. Doing + * mg_set() on the PVLV temporarily does SvMAGICAL_off(), then calls us. + * So STORE()'s $_[2] arg is a temporarily disarmed PVLV. This goes + * wrong if $val happened to be tainted, as sv hasn't got magic + * enabled, even though taint magic is in the chain. In which case, + * fake up a temporary tainted value (this is easier than temporarily + * re-enabling magic on sv). */ + + if (PL_tainting && (tmg = mg_find(sv, PERL_MAGIC_taint)) + && (tmg->mg_len & 1)) + { + val = sv_mortalcopy(sv); + SvTAINTED_on(val); + } + else + val = sv; + ENTER; PUSHSTACKi(PERLSI_MAGIC); - magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); + magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, val); POPSTACK; LEAVE; return 0; @@ -2333,7 +2363,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) sv_setsv(PL_bodytarget, sv); break; case '\003': /* ^C */ - PL_minus_c = (bool)SvIV(sv); + PL_minus_c = cBOOL(SvIV(sv)); break; case '\004': /* ^D */ @@ -2501,29 +2531,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv); break; case '^': - Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); - s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); - IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + if (isGV_with_GP(PL_defoutgv)) { + Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); + s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); + IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + } break; case '~': - Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); - s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); - IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + if (isGV_with_GP(PL_defoutgv)) { + Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); + s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); + IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + } break; case '=': - IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv)); + if (isGV_with_GP(PL_defoutgv)) + IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv)); break; case '-': - IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv)); - if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L) - IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L; + if (isGV_with_GP(PL_defoutgv)) { + IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv)); + if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L) + IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L; + } break; case '%': - IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv)); + if (isGV_with_GP(PL_defoutgv)) + IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv)); break; case '|': { - IO * const io = GvIOp(PL_defoutgv); + IO * const io = GvIO(PL_defoutgv); if(!io) break; if ((SvIV(sv)) == 0) @@ -2611,7 +2649,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif #endif PL_uid = PerlProc_getuid(); - PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case '>': PL_euid = SvIV(sv); @@ -2638,7 +2675,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif #endif PL_euid = PerlProc_geteuid(); - PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case '(': PL_gid = SvIV(sv); @@ -2665,7 +2701,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif #endif PL_gid = PerlProc_getgid(); - PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ')': #ifdef HAS_SETGROUPS @@ -2727,7 +2762,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #endif #endif PL_egid = PerlProc_getegid(); - PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ':': PL_chopset = SvPV_force(sv,len); @@ -2793,6 +2827,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_origargv[0][PL_origalen-1] = 0; for (i = 1; i < PL_origargc; i++) PL_origargv[i] = 0; +#ifdef HAS_PRCTL_SET_NAME + /* Set the legacy process name in addition to the POSIX name on Linux */ + if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) { + /* diag_listed_as: SKIPME */ + Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno)); + } +#endif } #endif UNLOCK_DOLLARZERO_MUTEX;