Control: tag -1 patch

On Sun, Jun 18, 2017 at 11:21:10PM +0300, Niko Tyni wrote:
> On Sun, Jun 05, 2016 at 10:41:41PM +0300, Niko Tyni wrote:
> > Package: swissknife
> > Version: 1.67-1.1
> > Severity: normal
> > User: debian-p...@lists.debian.org
> > Usertags: perl-5.24-transition
> > 
> > Building this package triggers deprecation warnings with Perl 5.24
> > (currently in experimental), and probably with Perl 5.22 (current sid)
> > too.
> > 
> >   Unescaped left brace in regex is deprecated, passed through in regex; 
> > marked by <-- HERE in m/^(\S{ <-- HERE 0,-1}/|-(?![>\-]))/ at 
> > /<<PKGBUILDDIR>>/blib/lib/SWISS/TextFunc.pm line 196, <IN> chunk 25.
> >   Unescaped left brace in regex is deprecated, passed through in regex; 
> > marked by <-- HERE in m/^(\S{ <-- HERE 0,-1}(?<!\([ET]C)\s+|(?<! 
> > )-(?=[A-Za-z0-9\(\[]))/ at /<<PKGBUILDDIR>>/blib/lib/SWISS/TextFunc.pm line 
> > 196, <IN> chunk 25.
> 
> This is fatal in Perl 5.26 (currently in experimental), making the
> package fail to build from source. Raising the severity accordingly.

The first pattern reads

    /^(\S{0,$w1}$separators[$j])/

It looks like the curly brace is not intended as a literal, but rather
to put together a quantifier so it matches 0 to $w1 non-whitespace
characters.

Somewhat interestingly, this is legal as long as $w1 >= 0. However, if it
goes negative the regexp code sees that {0,-1} can not be a quantifier
and decides that it must be a literal instead, causing warnings / fatal
runtime errors.

So this seems to have been a longstanding hidden bug in the code.

I'm attaching two proposed patches, one for this and the other for
a similar, related warning that was only introduced Perl 5.26. I've
tested that the package builds with these on both sid and with Perl
5.26 from experimental, but I'm not sure at all whether it still works
as intended. But at least the test suite passes now.

I see there have been quite a few new upstream releases but the last (and
only) maintainer upload was in 2009. Steffen, are you still maintaining
this package? Is it worth patching or should it rather be removed?
-- 
Niko Tyni   nt...@debian.org
>From 916994ccaa72399f9f2d3fad41f439ec393d23ce Mon Sep 17 00:00:00 2001
From: Niko Tyni <nt...@debian.org>
Date: Sun, 25 Jun 2017 20:40:06 +0000
Subject: [PATCH 1/2] Fix broken regexp quantifiers

When $w1 is negative, the regexp parser sees that {0,-1} can not
be a quantifier so it parses it as a literal instead. This does
not seem to be the intended behaviour.

Only try the match with nonnegative numbers, and short-circuit
to 'no match' otherwise.

Bug-Debian: https://bugs.debian.org/826505
---
 lib/SWISS/TextFunc.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/SWISS/TextFunc.pm b/lib/SWISS/TextFunc.pm
index 5a340cd..47641a1 100644
--- a/lib/SWISS/TextFunc.pm
+++ b/lib/SWISS/TextFunc.pm
@@ -193,7 +193,7 @@ sub wrapOn {
                   # of length 1 ($sepLength = 1)
                   my $sepLength = 1;
                   my $w1 = $cutPos - $sepLength;
-                  if ($postMatch =~ /^(\S{0,$w1}$separators[$j])/) {
+                  if ($w1 >= 0 and $postMatch =~ /^(\S{0,$w1}$separators[$j])/) {
                     $cutPos = length($1);
                     last;
                   }
-- 
2.13.1

>From 0f6c9ea418bcdf7650ff3ede46a7bd44e8da6783 Mon Sep 17 00:00:00 2001
From: Niko Tyni <nt...@debian.org>
Date: Sun, 25 Jun 2017 20:43:55 +0000
Subject: [PATCH 2/2] Fix regexp quoting

When $tag starts with a left brace, the interpolation will result
in a warning about an unenscaped left brace starting with Perl 5.26.

Presumably any regexp meta characters in $tag are intended to be
used as literals, so guard the interpolation with \Q...\E.
---
 lib/SWISS/BaseClass.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/SWISS/BaseClass.pm b/lib/SWISS/BaseClass.pm
index 34ce34d..ae76059 100644
--- a/lib/SWISS/BaseClass.pm
+++ b/lib/SWISS/BaseClass.pm
@@ -168,7 +168,7 @@ sub setEvidenceTags {
 sub addEvidenceTag {
   my $self = shift;
   my $tag = shift;
-  unless ($self->{'evidenceTags'} =~ /[\{\,]$tag[\}\,]/) {
+  unless ($self->{'evidenceTags'} =~ /[\{\,]\Q$tag\E[\}\,]/) {
     if ($self->{'evidenceTags'} eq '{}') {
       $self->{'evidenceTags'} = '{' . $tag . '}';
     } else {
-- 
2.13.1

Reply via email to