New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Modifying @DB::dbline entries can crash perl #13260
Comments
From @cpansprout#!perl -d:Peek *DB::dbline = *{"_<".__FILE__}; Maybe we should make @DB::dbline and its elements read-only. In fact, I wonder whether we should stop storing breakpoints in the ops themselves, since the dblines array may outlive the ops. Applying this little diff will cause an op to be dumped when a breakpoint is set on it: Inline Patchdiff --git a/mg.c b/mg.c
index d0fbd47..01163c5 100644
--- a/mg.c
+++ b/mg.c
@@ -1979,6 +1979,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
if (svp && SvIOKp(*svp)) {
OP * const o = INT2PTR(OP*,SvIVX(*svp));
if (o) {
+Perl_op_dump(aTHX_ o);
#ifdef PERL_DEBUG_READONLY_OPS
Slab_to_rw(OpSLAB(o));
#endif
#!perl -d:Peek You get: { which shows that we are setting a breakpoint on a freed op. No doubt AddressSanitizer will complain about writing to freed memory, as the slab has also been freed at this point. #!perl -d:Peek Here I’m setting the OPf_SPECIAL flag on an unrelated op. So attempting to set a breakpoint can change the behaviour of ops elsewhere in the same subroutine. This, of course, will never affect production code, so is it worth worrying about it? Flags: Site configuration information for perl 5.19.4: Configured by sprout at Mon Sep 9 00:16:24 PDT 2013. Summary of my perl5 (revision 5 version 19 subversion 4) configuration: @INC for perl 5.19.4: Environment for perl 5.19.4: |
From @nwc10On Sun, Sep 15, 2013 at 01:04:04PM -0700, Father Chrysostomos wrote:
I don't think that this helps, because it's aliased to the glob for the $ cat /tmp/119801-v print "Set a breakpoint here\n"; BEGIN { Loading DB routines from perl5db.pl version 1.33 Enter h or `h h' for help, or `man perldebug' for more help. main::(/tmp/119801-v:3): 3
I guess that there are roughly three requirements 1) A way for C code to know if an OP to know if a breakpoint is set As you demonstrate below, we're certainly missing the last one, and as It probably makes sense for the elements of @DB::dbline to be read only, If we swapped to some alternative representation of breakpoints But I'm not sure what the speed of that is - hash lookup for each COP? But hanging magic on every element of every array that @DB::dbline points It's not obvious to me that a safe, small, fast way exists to deliver all But if we can find one, as only 6 distributions independent of the core even
That is impressively evil.
But it could make debugging code harder, so I'd consider it as worth fixing, Nicholas Clark |
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn Mon Sep 16 12:39:24 2013, nicholas wrote:
I think we should change that. That is the subject of ticket #119799. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Sep 16 12:39:24 2013, nicholas wrote:
I think we should change that. That is the subject of ticket #119799. -- Father Chrysostomos |
From @cpansproutOn Mon Sep 16 12:39:24 2013, nicholas wrote:
:-) OPf_SPECIAL of course means nothing to pp_add. I tried to come up with a case that would cause goto() to ignore its -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Sep 16 12:39:24 2013, nicholas wrote:
:-) OPf_SPECIAL of course means nothing to pp_add. I tried to come up with a case that would cause goto() to ignore its -- Father Chrysostomos |
From @cpansproutOn Mon Sep 16 12:39:24 2013, nicholas wrote:
It’s a little worse, as the op may be reused for anything, not just
How about having an array shared between threads and indexed by cop_seq? Or, if that makes the array too long, extend the struct for dbstate ops When the op is freed, it can invalidate its entry. We would need three The numeric values stored in @DB::dbline elements would be indices into That array would always grow, and never shrink, creating a memory leak. How would that interfere with PERL_GLOBAL_STRUCT_PRIVATE (something I -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Sep 16 12:39:24 2013, nicholas wrote:
It’s a little worse, as the op may be reused for anything, not just
How about having an array shared between threads and indexed by cop_seq? Or, if that makes the array too long, extend the struct for dbstate ops When the op is freed, it can invalidate its entry. We would need three The numeric values stored in @DB::dbline elements would be indices into That array would always grow, and never shrink, creating a memory leak. How would that interfere with PERL_GLOBAL_STRUCT_PRIVATE (something I -- Father Chrysostomos |
From @nwc10On Mon, Sep 16, 2013 at 12:52:52PM -0700, Father Chrysostomos via RT wrote:
Yes, as I commented on that ticket, I really don't think keeping the current On Mon, Sep 16, 2013 at 11:53:12PM -0700, Father Chrysostomos via RT wrote:
I really don't know. I don't have any intuition of what is a good solution
Yes, saved lines only grows. This doesn't seem to be problem in reality, as
It shouldn't matter. That just plays games with how the process-wide variables Nicholas Clark |
From @cpansproutOn Mon Sep 16 23:53:11 2013, sprout wrote:
Please review the attached patch, which is also on the sprout/dbline branch. -- Father Chrysostomos |
From @cpansproutFrom fe14422 Mon Sep 17 00:00:00 2001 [perl #119801] Stop @DB::dbline modifications from crashing The cop address for each breakable line was being stored in the IVX This meant writing to ${"_<$file"}[$line] and assigning a number (like Furthermore, since the array holding the lines could outlive the ops, This commit solves those pitfalls by moving breakpoints into a global Inline Patchdiff --git a/cop.h b/cop.h
index 2a976ad..d4551e7 100644
--- a/cop.h
+++ b/cop.h
@@ -369,27 +369,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 83aafa4..ec8a446 100644
--- a/mg.c
+++ b/mg.c
@@ -1978,19 +1978,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 7a35797..7ce458e 100644
--- a/op.c
+++ b/op.c
@@ -5884,12 +5884,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 ];
}
@@ -5931,13 +5947,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
CopSTASH_set(cop, PL_curstash);
if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash) {
- /* 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 c3b66bb..c04c670 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1972,6 +1972,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;
@@ -1979,7 +1980,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]'
+); |
From [Unknown Contact. See original ticket]On Mon Sep 16 23:53:11 2013, sprout wrote:
Please review the attached patch, which is also on the sprout/dbline branch. -- Father Chrysostomos |
From @cpansproutOn Mon Oct 28 22:02:51 2013, sprout wrote:
In particular, does B::C need to access the extra fields that dbstate ops now have, or can we keep the cop–dbop distinction private? -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Oct 28 22:02:51 2013, sprout wrote:
In particular, does B::C need to access the extra fields that dbstate ops now have, or can we keep the cop–dbop distinction private? -- Father Chrysostomos |
From @cpansproutOn Wed Oct 30 21:29:27 2013, sprout wrote:
Having received no response, I applied this yesterday, as c1cec77. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Wed Oct 30 21:29:27 2013, sprout wrote:
Having received no response, I applied this yesterday, as c1cec77. -- Father Chrysostomos |
@cpansprout - Status changed from 'open' to 'resolved' |
From @jimcI noticed this, which looks like its missing parens around the addition: + size_t sz = off+8/8; that said, it didnt break on any configs I tried (on a 32bit linux box) On Mon, Dec 23, 2013 at 7:09 AM, Father Chrysostomos via RT <
|
From @rurbanOn Wed, Oct 30, 2013 at 11:29 PM, Father Chrysostomos via RT
Sorry, just saw this today. No, B::C doesn't need to access private dbstate fields, since this is However, Enbugger has a problem. A dummy nextstate field would be |
From @cpansproutOn Mon Dec 23 06:09:05 2013, sprout wrote:
I have just reverted it till after 5.20, in commit 88df5f0. -- Father Chrysostomos |
From [Unknown Contact. See original ticket]On Mon Dec 23 06:09:05 2013, sprout wrote:
I have just reverted it till after 5.20, in commit 88df5f0. -- Father Chrysostomos |
@cpansprout - Status changed from 'resolved' to 'open' |
Migrated from rt.perl.org#119801 (status was 'open')
Searchable as RT119801$
The text was updated successfully, but these errors were encountered: