X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=eee140bdf58f796f833e5df8795f9ec3f2ed5cac;hb=72e9304675ac276b2ac244c09a40ea9e7b9ea35d;hp=58a5cd54601f9b35194a4a4387783c397a0f21ce;hpb=16bd9a85dbc3be76d00459adeafa5bf918a5212d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 58a5cd5..eee140b 100644 --- a/mg.c +++ b/mg.c @@ -1,6 +1,7 @@ /* mg.c * - * Copyright (c) 1991-2002, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -33,6 +34,8 @@ # include #endif +Signal_t Perl_csighandler(int sig); + /* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ #if !defined(HAS_SIGACTION) && defined(VMS) # define FAKE_PERSISTENT_SIGNAL_HANDLERS @@ -131,6 +134,12 @@ Perl_mg_get(pTHX_ SV *sv) if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); + + /* guard against sv having been freed */ + if (SvTYPE(sv) == SVTYPEMASK) { + Perl_croak(aTHX_ "Tied variable freed while still in use"); + } + /* Don't restore the flags for this entry if it was deleted. */ if (mg->mg_flags & MGf_GSKIP) (SSPTR(mgs_ix, MGS *))->mgs_flags = 0; @@ -676,7 +685,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setpvn(sv, WARN_NONEstring, WARNsize) ; } else if (PL_compiling.cop_warnings == pWARN_ALL) { - sv_setpvn(sv, WARN_ALLstring, WARNsize) ; + /* Get the bit mask for $warnings::Bits{all}, because + * it could have been extended by warnings::register */ + SV **bits_all; + HV *bits=get_hv("warnings::Bits", FALSE); + if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) { + sv_setsv(sv, *bits_all); + } + else { + sv_setpvn(sv, WARN_ALLstring, WARNsize) ; + } } else { sv_setsv(sv, PL_compiling.cop_warnings); @@ -1043,6 +1061,14 @@ static int sig_defaulting[SIG_SIZE]; #endif #ifndef PERL_MICRO +#ifdef HAS_SIGPROCMASK +static void +restore_sigmask(pTHX_ SV *save_sv) +{ + sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv ); + (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0); +} +#endif int Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) { @@ -1050,7 +1076,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) STRLEN n_a; /* Are we fetching a signal entry? */ i = whichsig(MgPV(mg,n_a)); - if (i) { + if (i > 0) { if(PL_psig_ptr[i]) sv_setsv(sv,PL_psig_ptr[i]); else { @@ -1076,19 +1102,67 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg) { - I32 i; + /* XXX Some of this code was copied from Perl_magic_setsig. A little + * refactoring might be in order. + */ + register char *s; STRLEN n_a; - /* Are we clearing a signal entry? */ - i = whichsig(MgPV(mg,n_a)); - if (i) { - if(PL_psig_ptr[i]) { - SvREFCNT_dec(PL_psig_ptr[i]); - PL_psig_ptr[i]=0; - } - if(PL_psig_name[i]) { - SvREFCNT_dec(PL_psig_name[i]); - PL_psig_name[i]=0; - } + SV* to_dec; + s = MgPV(mg,n_a); + if (*s == '_') { + SV** svp; + if (strEQ(s,"__DIE__")) + svp = &PL_diehook; + else if (strEQ(s,"__WARN__")) + svp = &PL_warnhook; + else + Perl_croak(aTHX_ "No such hook: %s", s); + if (*svp) { + to_dec = *svp; + *svp = 0; + SvREFCNT_dec(to_dec); + } + } + else { + I32 i; + /* Are we clearing a signal entry? */ + i = whichsig(s); + if (i > 0) { +#ifdef HAS_SIGPROCMASK + sigset_t set, save; + SV* save_sv; + /* Avoid having the signal arrive at a bad time, if possible. */ + sigemptyset(&set); + sigaddset(&set,i); + sigprocmask(SIG_BLOCK, &set, &save); + ENTER; + save_sv = newSVpv((char *)(&save), sizeof(sigset_t)); + SAVEFREESV(save_sv); + SAVEDESTRUCTOR_X(restore_sigmask, save_sv); +#endif + PERL_ASYNC_CHECK(); +#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) + if (!sig_handlers_initted) Perl_csighandler_init(); +#endif +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + sig_defaulting[i] = 1; + (void)rsignal(i, &Perl_csighandler); +#else + (void)rsignal(i, SIG_DFL); +#endif + if(PL_psig_name[i]) { + SvREFCNT_dec(PL_psig_name[i]); + PL_psig_name[i]=0; + } + if(PL_psig_ptr[i]) { + to_dec=PL_psig_ptr[i]; + PL_psig_ptr[i]=0; + LEAVE; + SvREFCNT_dec(to_dec); + } + else + LEAVE; + } } return 0; } @@ -1173,7 +1247,16 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) register char *s; I32 i; SV** svp = 0; + /* Need to be careful with SvREFCNT_dec(), because that can have side + * effects (due to closures). We must make sure that the new disposition + * is in place before it is called. + */ + SV* to_dec = 0; STRLEN len; +#ifdef HAS_SIGPROCMASK + sigset_t set, save; + SV* save_sv; +#endif s = MgPV(mg,len); if (*s == '_') { @@ -1185,17 +1268,28 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) Perl_croak(aTHX_ "No such hook: %s", s); i = 0; if (*svp) { - SvREFCNT_dec(*svp); + to_dec = *svp; *svp = 0; } } else { i = whichsig(s); /* ...no, a brick */ - if (!i) { + if (i < 0) { if (ckWARN(WARN_SIGNAL)) Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s); return 0; } +#ifdef HAS_SIGPROCMASK + /* Avoid having the signal arrive at a bad time, if possible. */ + sigemptyset(&set); + sigaddset(&set,i); + sigprocmask(SIG_BLOCK, &set, &save); + ENTER; + save_sv = newSVpv((char *)(&save), sizeof(sigset_t)); + SAVEFREESV(save_sv); + SAVEDESTRUCTOR_X(restore_sigmask, save_sv); +#endif + PERL_ASYNC_CHECK(); #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) if (!sig_handlers_initted) Perl_csighandler_init(); #endif @@ -1203,20 +1297,26 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) sig_ignoring[i] = 0; #endif #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS - sig_defaulting[i] = 0; + sig_defaulting[i] = 0; #endif SvREFCNT_dec(PL_psig_name[i]); - SvREFCNT_dec(PL_psig_ptr[i]); + to_dec = PL_psig_ptr[i]; PL_psig_ptr[i] = SvREFCNT_inc(sv); SvTEMP_off(sv); /* Make sure it doesn't go away on us */ PL_psig_name[i] = newSVpvn(s, len); SvREADONLY_on(PL_psig_name[i]); } if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) { - if (i) + if (i) { (void)rsignal(i, &Perl_csighandler); +#ifdef HAS_SIGPROCMASK + LEAVE; +#endif + } else *svp = SvREFCNT_inc(sv); + if(to_dec) + SvREFCNT_dec(to_dec); return 0; } s = SvPV_force(sv,len); @@ -1228,8 +1328,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) #else (void)rsignal(i, SIG_IGN); #endif - } else - *svp = 0; + } } else if (strEQ(s,"DEFAULT") || !*s) { if (i) @@ -1241,8 +1340,6 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) #else (void)rsignal(i, SIG_DFL); #endif - else - *svp = 0; } else { /* @@ -1257,6 +1354,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) else *svp = SvREFCNT_inc(sv); } +#ifdef HAS_SIGPROCMASK + if(i) + LEAVE; +#endif + if(to_dec) + SvREFCNT_dec(to_dec); return 0; } #endif /* !PERL_MICRO */ @@ -1818,6 +1921,13 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg) } int +Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) +{ + sv_unmagic(sv, PERL_MAGIC_qr); + return 0; +} + +int Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg) { regexp *re = (regexp *)mg->mg_obj; @@ -2330,7 +2440,7 @@ Perl_whichsig(pTHX_ char *sig) { register char **sigv; - for (sigv = PL_sig_name+1; *sigv; sigv++) + for (sigv = PL_sig_name; *sigv; sigv++) if (strEQ(sig,*sigv)) return PL_sig_num[sigv - PL_sig_name]; #ifdef SIGCLD @@ -2341,7 +2451,7 @@ Perl_whichsig(pTHX_ char *sig) if (strEQ(sig,"CLD")) return SIGCHLD; #endif - return 0; + return -1; } #if !defined(PERL_IMPLICIT_CONTEXT)