In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c1cec775e9019cc8ae244d4db239a7ea5c0b343e?hp=bb02e0c10a57ab28b9ec6ca218c7aa6aac53a90c>
- Log ----------------------------------------------------------------- commit c1cec775e9019cc8ae244d4db239a7ea5c0b343e Author: Father Chrysostomos <[email protected]> Date: Mon Oct 28 21:59:14 2013 -0700 [perl #119801] Stop @DB::dbline modifications from crashing The cop address for each breakable line was being stored in the IVX slot of ${"_<$file"}[$line]. This value itself, writable from Perl space, was being used as the address of the op to be flagged, whenever a breakpoint was set. This meant writing to ${"_<$file"}[$line] and assigning a number (like 42) would cause perl to use 42 as an op address, and crash when trying to flag the op. Furthermore, since the array holding the lines could outlive the ops, setting a breakpoint on the op could write to freed memory or to an unrelated op (even a different type), potentially changing the beha- viour of unrelated code. This commit solves those pitfalls by moving breakpoints into a global breakpoint bitfield. Dbstate ops now have an extra field on the end holding a sequence number, representing which bit holds the breakpoint for that op. ----------------------------------------------------------------------- Summary of changes: cop.h | 44 +++++++++++++++++++++++++++++--------------- embedvar.h | 6 ++++++ mg.c | 17 ++++++----------- op.c | 22 +++++++++++++++++++--- perlapi.h | 6 ++++++ perlvars.h | 4 ++++ pp_ctl.c | 4 +++- t/run/switchd.t | 19 ++++++++++++++++++- 8 files changed, 91 insertions(+), 31 deletions(-) diff --git a/cop.h b/cop.h index 6950814..d74da17 100644 --- a/cop.h +++ b/cop.h @@ -370,27 +370,41 @@ string/length pair. #include "mydtrace.h" -struct cop { - BASEOP - /* On LP64 putting this here takes advantage of the fact that BASEOP isn't - an exact multiple of 8 bytes to save structure padding. */ - line_t cop_line; /* line # of this command */ - /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS - PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the - package the line was compiled in */ +# define _COP_STASH_N_FILE \ + PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the \ + package the line was compiled in */ \ char * cop_file; /* file name the following line # is from */ #else - HV * cop_stash; /* package line was compiled in */ +# define _COP_STASH_N_FILE \ + HV * cop_stash; /* package line was compiled in */ \ GV * cop_filegv; /* file the following line # is from */ #endif - U32 cop_hints; /* hints bits from pragmata */ - U32 cop_seq; /* parse sequence number */ - /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ - STRLEN * cop_warnings; /* lexical warnings bitmask */ - /* compile time state of %^H. See the comment in op.c for how this is - used to recreate a hash to return from caller. */ + +#define _COP_FIELDS \ + /* On LP64 putting this here takes advantage of the fact that BASEOP \ + isn't an exact multiple of 8 bytes to save structure padding. */ \ + line_t cop_line; /* line # of this command */ \ + /* label for this construct is now stored in cop_hints_hash */ \ + _COP_STASH_N_FILE \ + U32 cop_hints; /* hints bits from pragmata */ \ + U32 cop_seq; /* parse sequence number */ \ + /* Beware. mg.c and warnings.pl assume the type of this \ + is STRLEN *: */ \ + STRLEN * cop_warnings; /* lexical warnings bitmask */ \ + /* compile time state of %^H. See the comment in op.c for how this \ + is used to recreate a hash to return from caller. */ \ COPHH * cop_hints_hash; + +struct cop { + BASEOP + _COP_FIELDS +}; + +struct dbop { + BASEOP + _COP_FIELDS + size_t dbop_seq; /* sequence number for breakpoint */ }; #ifdef USE_ITHREADS diff --git a/embedvar.h b/embedvar.h index 06d4e18..f90a19e 100644 --- a/embedvar.h +++ b/embedvar.h @@ -357,6 +357,12 @@ #define PL_appctx (my_vars->Gappctx) #define PL_Gappctx (my_vars->Gappctx) +#define PL_breakpoints (my_vars->Gbreakpoints) +#define PL_Gbreakpoints (my_vars->Gbreakpoints) +#define PL_breakpointseq (my_vars->Gbreakpointseq) +#define PL_Gbreakpointseq (my_vars->Gbreakpointseq) +#define PL_breakpointslen (my_vars->Gbreakpointslen) +#define PL_Gbreakpointslen (my_vars->Gbreakpointslen) #define PL_check (my_vars->Gcheck) #define PL_Gcheck (my_vars->Gcheck) #define PL_check_mutex (my_vars->Gcheck_mutex) diff --git a/mg.c b/mg.c index 8c57e2a..b98a194 100644 --- a/mg.c +++ b/mg.c @@ -2002,19 +2002,14 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); if (svp && SvIOKp(*svp)) { - OP * const o = INT2PTR(OP*,SvIVX(*svp)); - if (o) { -#ifdef PERL_DEBUG_READONLY_OPS - Slab_to_rw(OpSLAB(o)); -#endif - /* set or clear breakpoint in the relevant control op */ + size_t off = SvUVX(*svp); + size_t sz = off+8/8; + if (sz <= PL_breakpointslen) { + /* set or clear breakpoint */ if (SvTRUE(sv)) - o->op_flags |= OPf_SPECIAL; + PL_breakpoints[off/8] |= 1 << off%8; else - o->op_flags &= ~OPf_SPECIAL; -#ifdef PERL_DEBUG_READONLY_OPS - Slab_to_ro(OpSLAB(o)); -#endif + PL_breakpoints[off/8] &= ~(U8)(1 << off%8); } } return 0; diff --git a/op.c b/op.c index c040c5a..f25112a 100644 --- a/op.c +++ b/op.c @@ -5922,12 +5922,28 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) flags &= ~SVf_UTF8; - NewOp(1101, cop, 1, COP); if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) { + size_t sz, seq; + NewOp(1101, *(struct dbop **)&cop, 1, struct dbop); cop->op_type = OP_DBSTATE; cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ]; + OP_REFCNT_LOCK; + sz = PL_breakpointseq+8/8; + if (!PL_breakpoints) { + PL_breakpoints = (U8 *)PerlMemShared_malloc(sz); + PL_breakpointslen = sz; + } + else if (PL_breakpointslen < sz) { + PL_breakpoints = + (U8 *)PerlMemShared_realloc(PL_breakpoints,sz); + PL_breakpointslen = sz; + } + seq = ((struct dbop *)cop)->dbop_seq = PL_breakpointseq++; + PL_breakpoints[seq/8] &= ~(U8)(1 << seq%8); + OP_REFCNT_UNLOCK; } else { + NewOp(1101, cop, 1, COP); cop->op_type = OP_NEXTSTATE; cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } @@ -5972,13 +5988,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) CopSTASH_set(cop, PL_curstash); if (cop->op_type == OP_DBSTATE) { - /* this line can have a breakpoint - store the cop in IV */ + /* this line can have a breakpoint - store the dbop seq in IV */ AV *av = CopFILEAVx(PL_curcop); if (av) { SV * const * const svp = av_fetch(av, CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef ) { (void)SvIOK_on(*svp); - SvIV_set(*svp, PTR2IV(cop)); + SvUV_set(*svp, ((struct dbop *)cop)->dbop_seq); } } } diff --git a/perlapi.h b/perlapi.h index 910f789..4dc8074 100644 --- a/perlapi.h +++ b/perlapi.h @@ -101,6 +101,12 @@ END_EXTERN_C #undef PL_appctx #define PL_appctx (*Perl_Gappctx_ptr(NULL)) +#undef PL_breakpoints +#define PL_breakpoints (*Perl_Gbreakpoints_ptr(NULL)) +#undef PL_breakpointseq +#define PL_breakpointseq (*Perl_Gbreakpointseq_ptr(NULL)) +#undef PL_breakpointslen +#define PL_breakpointslen (*Perl_Gbreakpointslen_ptr(NULL)) #undef PL_check #define PL_check (*Perl_Gcheck_ptr(NULL)) #undef PL_check_mutex diff --git a/perlvars.h b/perlvars.h index aa724e8..56cb96c 100644 --- a/perlvars.h +++ b/perlvars.h @@ -237,3 +237,7 @@ PERLVAR(G, malloc_mutex, perl_mutex) /* Mutex for malloc */ PERLVARI(G, hash_seed_set, bool, FALSE) /* perl.c */ PERLVARA(G, hash_seed, PERL_HASH_SEED_BYTES, unsigned char) /* perl.c and hv.h */ + +PERLVARI(G, breakpoints, U8 *, NULL) /* For setting DB breakpoints */ +PERLVARI(G, breakpointslen, size_t, 0) +PERLVARI(G, breakpointseq, size_t, 0) diff --git a/pp_ctl.c b/pp_ctl.c index c06e796..70250cc 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1929,6 +1929,7 @@ PP(pp_reset) PP(pp_dbstate) { dVAR; + size_t const seq = ((struct dbop *)PL_op)->dbop_seq; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -1936,7 +1937,8 @@ PP(pp_dbstate) PERL_ASYNC_CHECK(); - if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */ + assert(seq+8/8 <= PL_breakpointslen); + if (PL_breakpoints[seq/8] & 1 << seq%8 || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { dSP; diff --git a/t/run/switchd.t b/t/run/switchd.t index f901bf6..68a97d6 100644 --- a/t/run/switchd.t +++ b/t/run/switchd.t @@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; } # This test depends on t/lib/Devel/switchd*.pm. -plan(tests => 17); +plan(tests => 18); my $r; @@ -253,3 +253,20 @@ is( "ok\n", "setting breakpoints without *DB::dbline aliased" ); + +# Test setting breakpoints after overwriting source lines +is( + runperl( + switches => [ '-Ilib', '-d:switchd_empty' ], + progs => [ split "\n", + '*DB::dbline = *{q(_<).__FILE__}; + $DB::dbline[1] = 7; # IVX used to point to the cop address + $DB::dbline{1} = 1; # crash accessing cCOPx(7)->op_flags + print qq[ok\n]; + ' + ], + stderr => 1 + ), + "ok\n", + 'no crash when setting $DB::dbline{1} after $DB::dbline[1]' +); -- Perl5 Master Repository
