On Sat, 2009-09-05 at 18:35 +0200, Martín Ferrari wrote:
> On Sat, Sep 5, 2009 at 15:36, Martín Ferrari<martin.ferr...@gmail.com> wrote:
>
> > $ perl -MPET::Watch -e '$r = shift; $s = shift;
> > PET::Watch::safe_replace($s, $r); print "$s\n"' 's/()/./g' foo
> > foo
>
> This was a mistake, I didn't call the function properly. Raphael's
> patch makes this loop forever!
Indeed. We (well I) knew that though. :) Raphael just hadn't had time to
look at zero-width matches.
> See the patch below, or refer to revision 748 of
> svn://svn.debian.org/svn/pet/trunk/PET/Watch.pm
Thanks for the patch. There were a couple of issues with it, one of
which I know you're aware of - the "build array of captures" loop always
used the first capture as it needed s/0/$i/g. The other was that Perl's
magic regex engine variables - @- etc - are only changed on /successful/
matches. If the last match attempt failed then those variables retain
their contents from the last successful match. In this case that meant
a load of Perl warnings as the code attempted to access beyond the end
of the string.
I've included an updated patch below. PET SVN has also been updated to
fix both of the issues mentioned above.
I also reverted your changes near the bottom of the diff as, whilst I
agree that getting rid of the "if foo bar else baz" block results in
cleaner code, I'd like to keep the diff for the security team as small
as possible.
Regards,
Adam
--- scripts/uscan.pl (revision 1995)
+++ scripts/uscan.pl (working copy)
@@ -1880,8 +1880,6 @@
my $global = ($flags =~ s/g//);
$flags = "(?$flags)" if length $flags;
- my (@captures, $first, $last);
-
# Behave like Perl and treat e.g. "\." in replacement as "."
# We allow the case escape characters to remain and
# process them later
@@ -1901,24 +1899,39 @@
# the global flag was set on the input pattern.
my $orig_replacement = $replacement;
+ my ($first, $last, $pos, $matched, @captures) = (0, -1);
while (1) {
eval {
# handle errors due to unsafe constructs in $regexp
no re 'eval';
- my $re = qr/$flags$regexp/;
+ # restore position
+ pos($$in) = $pos if($pos);
- @captures = ($$in =~ $re);
- ($first, $last) = ($-[0], $+[0]);
+ if($last - $first == 0) {
+ # previous match was a zero-width match, simulate it to set
+ # the internal flag that avoids the infinite loop
+ $$in =~ /()/g;
+ }
+ # Need to use /g to make it use and save pos()
+ $matched = scalar($$in =~ /$flags$regexp/g);
+
+ if ($matched) {
+ # save position and size of the match
+ $pos = pos($$in);
+ ($first, $last) = ($-[0], $+[0]);
+ for my $i (0..$#-) {
+ $captures[$i] = substr $$in, $-[$i], $+[$i] - $-[$i];
+ }
+ }
};
return 0 if $@;
# No match; leave the original string untouched but return
# success as there was nothing wrong with the pattern
- return 1 if @captures == 0;
+ return 1 unless $matched;
# Replace $X
- unshift @captures, substr $$in, $first, $last - $first;
$replacement =~ s/[\$\\](\d)/defined $captures[$1] ?
$captures[$1] : ''/ge;
$replacement =~ s/\$\{(\d)\}/defined $captures[$1] ?
$captures[$1] : ''/ge;
$replacement =~ s/\$&/$captures[0]/g;
@@ -1931,6 +1944,8 @@
# Actually do the replacement
substr $$in, $first, $last - $first, $replacement;
+ # Update position
+ $pos += length($replacement)- ($last - $first);
if ($global) {
$replacement = $orig_replacement;
--
To UNSUBSCRIBE, email to debian-bugs-dist-requ...@lists.debian.org
with a subject of "unsubscribe". Trouble? Contact listmas...@lists.debian.org
