add patch for C<use re 'debug'>

	Message-Id: <199807070224.WAA10318@monk.mps.ohio-state.edu>
	Subject: Re: _70 and Devel::RE

p4raw-id: //depot/perl@1371

3 files changed, 142 insertions, 0 deletions

diff --git a/ext/re/Makefile.PL b/ext/re/Makefile.PL
new file mode 100644
index 0000000000..c6a55a6f44
--- /dev/null
+++ b/ext/re/Makefile.PL
@@ -0,0 +1,22 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME		=> 're',
+    VERSION_FROM	=> 're.pm',
+    MAN3PODS		=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG		=> '-noprototypes',
+    OBJECT		=> 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
+    DEFINE		=> '-DDEBUGGING -DIN_XSUB_RE',
+);
+
+sub MY::postamble {
+    return <<'EOF';
+re_comp.c: ../../regcomp.c
+	-$(RM) $@
+	$(CP) ../../regcomp.c $@
+
+re_exec.c: ../../regexec.c
+	-$(RM) $@
+	$(CP) ../../regexec.c $@
+
+EOF
+}
diff --git a/ext/re/re.pm b/ext/re/re.pm
new file mode 100644
index 0000000000..53873fca4c
--- /dev/null
+++ b/ext/re/re.pm
@@ -0,0 +1,82 @@
+package re;
+
+$VERSION = 0.02;
+
+=head1 NAME
+
+re - Perl pragma to alter regular expression behaviour
+
+=head1 SYNOPSIS
+
+    use re 'taint';
+    ($x) = ($^X =~ /^(.*)$/s);     # $x is tainted here
+
+    use re 'eval';
+    /foo(?{ $foo = 1 })bar/;	   # won't fail (when not under -T switch)
+
+    {
+	no re 'taint';		   # the default
+	($x) = ($^X =~ /^(.*)$/s); # $x is not tainted here
+
+	no re 'eval';		   # the default
+	/foo(?{ $foo = 1 })bar/;   # disallowed (with or without -T switch)
+    }
+
+=head1 DESCRIPTION
+
+When C<use re 'taint'> is in effect, and a tainted string is the target
+of a regex, the regex memories (or values returned by the m// operator
+in list context) are tainted.  This feature is useful when regex operations
+on tainted data aren't meant to extract safe substrings, but to perform
+other transformations.
+
+When C<use re 'eval'> is in effect, a regex is allowed to contain
+C<(?{ ... })> zero-width assertions (which may not be interpolated in
+the regex).  That is normally disallowed, since it is a potential security
+risk.  Note that this pragma is ignored when perl detects tainted data,
+i.e.  evaluation is always disallowed with tainted data.  See
+L<perlre/(?{ code })>.
+
+See L<perlmodlib/Pragmatic Modules>.
+
+=cut
+
+my %bitmask = (
+taint	=> 0x00100000,
+eval	=> 0x00200000,
+);
+
+sub bits {
+    my $on = shift;
+    my $bits = 0;
+    unless(@_) {
+	require Carp;
+	Carp::carp("Useless use of \"re\" pragma");
+    }
+    foreach my $s (@_){
+      if ($s eq 'debug') {
+	  eval <<'EOE';
+	    use DynaLoader;
+	    @ISA = ('DynaLoader');
+	    bootstrap re;
+EOE
+	  install() if $on;
+	  uninstall() unless $on;
+	  next;
+      }
+      $bits |= $bitmask{$s} || 0;
+    }
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(1,@_);
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(0,@_);
+}
+
+1;
diff --git a/ext/re/re.xs b/ext/re/re.xs
new file mode 100644
index 0000000000..7b9fb379cd
--- /dev/null
+++ b/ext/re/re.xs
@@ -0,0 +1,38 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+extern regexp*	my_regcomp _((char* exp, char* xend, PMOP* pm));
+extern I32	my_regexec _((regexp* prog, char* stringarg, char* strend,
+			      char* strbeg, I32 minend, SV* screamer,
+			      void* data, U32 flags));
+
+static int oldfl;
+
+#define R_DB 512
+
+static void
+deinstall(void)
+{
+    regexecp = &regexec_flags;
+    regcompp = &pregcomp;
+    if (!oldfl)
+	debug &= ~R_DB;
+}
+
+static void
+install(void)
+{
+    regexecp = &my_regexec;
+    regcompp = &my_regcomp;
+    oldfl = debug & R_DB;
+    debug |= R_DB;
+}
+
+MODULE = re	PACKAGE = re
+
+void
+install()
+
+void
+deinstall()