Modifying @DB::dbline entries can crash perl

[p5pRT]

Migrated from rt.perl.org#119801 (status was 'open')

Searchable as RT119801$

[p5pRT]

From @cpansprout

#!perl -d​:Peek
sub DB​::DB {}
# (That header just enables debugging mode without loading any
# debugger.)

*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline[6] = 7; # IVX normally points to the cop address
$DB​::dbline{6} = 1; # crash accessing cCOPx(7)->op_flags

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 Patch

diff --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

If you apply it and then run this script:

#!perl -d​:Peek
sub DB​::DB{}
sub foo {
  //;
}
undef *foo;
*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline{4} = 1;

You get​:

{
1 TYPE = freed ===> NULL
  FLAGS = (VOID,SLABBED)
}

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
sub DB​::DB{}
if(0){
  foo();
  bar();
}
() = $1+$1+$1+$1+$1+$1+$1+$1+$1+$1+$1+$1; # lots of ops
*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline{4} = 1;
__END__
{
1 TYPE = add ===> 2
  TARG = 2
  FLAGS = (SCALAR,KIDS,SLABBED)
  PRIVATE = (0x2)
  {
....

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​:
  category=core
  severity=low

---

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​:
  Commit id​: d47819ff6f55bfaa4b7eddc66c6db7d7dfdec11c
  Platform​:
  osname=darwin, osvers=12.2.0, archname=darwin-2level
  uname='darwin pint.local 12.2.0 darwin kernel version 12.2.0​: sat aug 25 00​:48​:52 pdt 2012; root​:xnu-2050.18.24~1release_x86_64 x86_64 '
  config_args='-de -Dcc=gcc -Dusedevel -Doptimize=-ggdb3 -Aoptimize=-O0 -DDEBUGGING'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=undef, usemultiplicity=undef
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include',
  optimize='-ggdb3 -O0',
  cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.2.1 (Based on Apple Inc. build 5658) (LLVM build 2336.11.00)', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib
  libs=-ldbm -ldl -lm -lutil -lc
  perllibs=-ldl -lm -lutil -lc
  libc=, so=dylib, useshrplib=false, libperl=libperl.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector'

---

@​INC for perl 5.19.4​:
  lib
  /usr/local/lib/perl5/site_perl/5.19.4/darwin-2level
  /usr/local/lib/perl5/site_perl/5.19.4
  /usr/local/lib/perl5/5.19.4/darwin-2level
  /usr/local/lib/perl5/5.19.4
  /usr/local/lib/perl5/site_perl
  .

---

Environment for perl 5.19.4​:
  DYLD_LIBRARY_PATH (unset)
  HOME=/Users/sprout
  LANG=en_US.UTF-8
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/usr/bin​:/bin​:/usr/sbin​:/sbin​:/usr/local/bin​:/usr/local/bin
  PERL_BADLANG (unset)
  SHELL=/bin/bash

[p5pRT]

From @nwc10

On Sun, Sep 15, 2013 at 01​:04​:04PM -0700, Father Chrysostomos wrote​:

#!perl -d​:Peek
sub DB​::DB {}
# (That header just enables debugging mode without loading any
# debugger.)

*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline[6] = 7; # IVX normally points to the cop address
$DB​::dbline{6} = 1; # crash accessing cCOPx(7)->op_flags

Maybe we should make @​DB​::dbline and its elements read-only.

I don't think that this helps, because it's aliased to the glob for the
file in question, and with enough typeglob or symbol table manipulation,
the array can be swapped out whilst leaving the hash present, which means
that an access to the hash still triggers a memory access based on the value
held in the array. So it would be possible to do something like this, even
if the array and hash were marked read-only​:

$ cat /tmp/119801-v
#!/usr/bin/perl

print "Set a breakpoint here\n";

BEGIN {
  ${"_<".__FILE__}[3] = 3;
}
$ perl -d /tmp/119801-v

Loading DB routines from perl5db.pl version 1.33
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

main​::(/tmp/119801-v​:3)​: 3
  DB<1> b
Signal SEGV at /opt/local/lib/perl5/5.12.4/perl5db.pl line 4412
  eval {...} called at /opt/local/lib/perl5/5.12.4/perl5db.pl line 4412
  DB​::cmd_b_line(3, 1) called at /opt/local/lib/perl5/5.12.4/perl5db.pl line 4090
  DB​::cmd_b('b', '', 3) called at /opt/local/lib/perl5/5.12.4/perl5db.pl line 3942
  DB​::cmd_wrapper(undef, undef, 3) called at /opt/local/lib/perl5/5.12.4/perl5db.pl line 2603
  DB​::DB called at /tmp/119801-v line 3
Abort trap

In fact, I wonder whether we should stop storing breakpoints in the ops themselves, since the dblines array may outlive the ops.

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
  (which is done once per statement, so is going to be common)
2) A way for Perl code to map lines to OPs in order to set breakpoints
3) A way to clear the mapping when an OP is deleted
  (op addresses can get reused. It's the same issue with caching using SV
  addresses)

As you demonstrate below, we're certainly missing the last one, and as
you demonstrate above, the second one is currently subvertable.

It probably makes sense for the elements of @​DB​::dbline to be read only,
but I might be biased because I can't actually see a use case for modifying
them that is sane enough that we'd want to support it.

If we swapped to some alternative representation of breakpoints
(such as a hash-like structure keyed on OP address, value is breakpoints,
which is the best I can think of so far) it might be safe enough.

But I'm not sure what the speed of that is - hash lookup for each COP?
The alternative seems to be to "enforce" safety in perl space by having the
address of the COP stored in the same SV as has the magic that does the
COP access (somehow, somewhere), so that attempting to assign to that SV
from perl space eliminates the magic. The SEGV problem right now is because
Perl space actually has complete unguarded write-access to the storage
location of value that is used as a pointer from C-space.

But hanging magic on every element of every array that @​DB​::dbline points
to would consume a lot more memory.

It's not obvious to me that a safe, small, fast way exists to deliver all
3 requirements.

But if we can find one, as only 6 distributions independent of the core even
reference DB​::dbline, I think that it's reasonable to consider a breaking
change to the internals, if that's what is needed to get somewhere better.

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
sub DB​::DB{}
if(0){
foo();
bar();
}
() = $1+$1+$1+$1+$1+$1+$1+$1+$1+$1+$1+$1; # lots of ops
*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline{4} = 1;
__END__
{
1 TYPE = add ===> 2
TARG = 2
FLAGS = (SCALAR,KIDS,SLABBED)
PRIVATE = (0x2)
{
....

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.

That is impressively evil.

This, of course, will never affect production code, so is it worth worrying about it?

But it could make debugging code harder, so I'd consider it as worth fixing,
but not "urgent".

Nicholas Clark

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @cpansprout

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

On Sun, Sep 15, 2013 at 01​:04​:04PM -0700, Father Chrysostomos wrote​:

#!perl -d​:Peek
sub DB​::DB {}
# (That header just enables debugging mode without loading any
# debugger.)

*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline[6] = 7; # IVX normally points to the cop address
$DB​::dbline{6} = 1; # crash accessing cCOPx(7)->op_flags

Maybe we should make @​DB​::dbline and its elements read-only.

I don't think that this helps, because it's aliased to the glob for
the
file in question, and with enough typeglob or symbol table
manipulation,
the array can be swapped out whilst leaving the hash present, which
means
that an access to the hash still triggers a memory access based on the
value
held in the array.

I think we should change that. That is the subject of ticket #119799.

--

Father Chrysostomos

[p5pRT]

From [Unknown Contact. See original ticket]

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

On Sun, Sep 15, 2013 at 01​:04​:04PM -0700, Father Chrysostomos wrote​:

#!perl -d​:Peek
sub DB​::DB {}
# (That header just enables debugging mode without loading any
# debugger.)

*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline[6] = 7; # IVX normally points to the cop address
$DB​::dbline{6} = 1; # crash accessing cCOPx(7)->op_flags

Maybe we should make @​DB​::dbline and its elements read-only.

I don't think that this helps, because it's aliased to the glob for
the
file in question, and with enough typeglob or symbol table
manipulation,
the array can be swapped out whilst leaving the hash present, which
means
that an access to the hash still triggers a memory access based on the
value
held in the array.

I think we should change that. That is the subject of ticket #119799.

--

Father Chrysostomos

[p5pRT]

From @cpansprout

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

That is impressively evil.

:-)

OPf_SPECIAL of course means nothing to pp_add.

I tried to come up with a case that would cause goto() to ignore its
label and croak, but it proved to be too time-consuming.

--

Father Chrysostomos

[p5pRT]

From [Unknown Contact. See original ticket]

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

That is impressively evil.

:-)

OPf_SPECIAL of course means nothing to pp_add.

I tried to come up with a case that would cause goto() to ignore its
label and croak, but it proved to be too time-consuming.

--

Father Chrysostomos

[p5pRT]

From @cpansprout

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

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
(which is done once per statement, so is going to be common)
2) A way for Perl code to map lines to OPs in order to set breakpoints
3) A way to clear the mapping when an OP is deleted
(op addresses can get reused. It's the same issue with caching
using SV
addresses)

It’s a little worse, as the op may be reused for anything, not just
another op. If it were the latter, we could check the type, line and
file before setting the breakpoint.

It's not obvious to me that a safe, small, fast way exists to deliver
all
3 requirements.

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

That array would always grow, and never shrink, creating a memory leak.
But saved lines already do that.

How would that interfere with PERL_GLOBAL_STRUCT_PRIVATE (something I
have very little understanding of)?

--

Father Chrysostomos

[p5pRT]

From [Unknown Contact. See original ticket]

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

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
(which is done once per statement, so is going to be common)
2) A way for Perl code to map lines to OPs in order to set breakpoints
3) A way to clear the mapping when an OP is deleted
(op addresses can get reused. It's the same issue with caching
using SV
addresses)

It’s a little worse, as the op may be reused for anything, not just
another op. If it were the latter, we could check the type, line and
file before setting the breakpoint.

It's not obvious to me that a safe, small, fast way exists to deliver
all
3 requirements.

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

That array would always grow, and never shrink, creating a memory leak.
But saved lines already do that.

How would that interfere with PERL_GLOBAL_STRUCT_PRIVATE (something I
have very little understanding of)?

--

Father Chrysostomos

[p5pRT]

From @nwc10

On Mon, Sep 16, 2013 at 12​:52​:52PM -0700, Father Chrysostomos via RT wrote​:

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

On Sun, Sep 15, 2013 at 01​:04​:04PM -0700, Father Chrysostomos wrote​:

#!perl -d​:Peek
sub DB​::DB {}
# (That header just enables debugging mode without loading any
# debugger.)

*DB​::dbline = *{"_<".__FILE__};
$DB​::dbline[6] = 7; # IVX normally points to the cop address
$DB​::dbline{6} = 1; # crash accessing cCOPx(7)->op_flags

Maybe we should make @​DB​::dbline and its elements read-only.

I don't think that this helps, because it's aliased to the glob for
the
file in question, and with enough typeglob or symbol table
manipulation,
the array can be swapped out whilst leaving the hash present, which
means
that an access to the hash still triggers a memory access based on the
value
held in the array.

I think we should change that. That is the subject of ticket #119799.

Yes, as I commented on that ticket, I really don't think keeping the current
implementation is necessary, if there's a better way to do things.

On Mon, Sep 16, 2013 at 11​:53​:12PM -0700, Father Chrysostomos via RT wrote​:

On Mon Sep 16 12​:39​:24 2013, nicholas wrote​:

It's not obvious to me that a safe, small, fast way exists to deliver
all
3 requirements.

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

I really don't know. I don't have any intuition of what is a good solution
for this, other than it would be good if it couldn't be subverted to SEGV.

That array would always grow, and never shrink, creating a memory leak.
But saved lines already do that.

Yes, saved lines only grows. This doesn't seem to be problem in reality, as
I don't think that most people run under the debugger in production, and
repeatedly parse code (eg evals)

How would that interfere with PERL_GLOBAL_STRUCT_PRIVATE (something I
have very little understanding of)?

It shouldn't matter. That just plays games with how the process-wide variables
are found. If a solution ends up adding a variable to perlvars.h, it should
all "just work".

Nicholas Clark

[p5pRT]

From @cpansprout

On Mon Sep 16 23​:53​:11 2013, sprout wrote​:

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

Please review the attached patch, which is also on the sprout/dbline branch.

--

Father Chrysostomos

[p5pRT]

From @cpansprout

From fe14422 Mon Sep 17 00​:00​:00 2001
From​: Father Chrysostomos <sprout@​cpan.org>
Date​: Mon, 28 Oct 2013 21​:59​:14 -0700
Subject​: [PATCH]

[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.

Inline Patch

diff --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]'
+);

[p5pRT]

From [Unknown Contact. See original ticket]

On Mon Sep 16 23​:53​:11 2013, sprout wrote​:

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

Please review the attached patch, which is also on the sprout/dbline branch.

--

Father Chrysostomos

[p5pRT]

From @cpansprout

On Mon Oct 28 22​:02​:51 2013, sprout wrote​:

On Mon Sep 16 23​:53​:11 2013, sprout wrote​:

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

Please review the attached patch, which is also on the sprout/dbline branch.

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

[p5pRT]

From [Unknown Contact. See original ticket]

On Mon Oct 28 22​:02​:51 2013, sprout wrote​:

On Mon Sep 16 23​:53​:11 2013, sprout wrote​:

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
and store a separate sequence number.

When the op is freed, it can invalidate its entry. We would need three
values​: 0 = no op available, 1 = no breakpoint, 2 = breakpoint set.

The numeric values stored in @​DB​::dbline elements would be indices into
that breakpoint array.

Please review the attached patch, which is also on the sprout/dbline branch.

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