Bug#519268: lintian: same problem in mksh, but with a twist

[Raphael Geissert <atomo64+debian@gmail.com>]

Russ Allbery wrote:

> Raphael Geissert writes:
>> Russ Allbery wrote:
> 
>>> The fix for the first and the last will be to just bail in Lintian if
>>> there are variables on the dpkg-divert and not assume we know what
>>> people are doing.  I'll get that into the next release.
> 
>> I'm already working on another way to fix it by replacing var names with
>> regexes, more on it later.
> 
> I don't think doing anything other than bailing is going to make sense.
> The preinst and postrm scripts could use completely different loops and
> expressions and phrase the conditionals in entirely different ways.
> Unless you've found a way to deal with that, I'd rather just suppress the
> test if variables are used.
> 

I think I addressed most¹ cases, please try the attached patch (note that it
won't work with latest HEAD, as it needs more changes due to 297135b0; try
with HEAD^).

¹ we are not handling the cases when for example postinst uses --rename and
the pre/postrm removes that renamed divertion; neither in the current nor
the proposed code.

Cheers,
-- 
Raphael Geissert - Debian Maintainer
www.debian.org - get.debian.net

diff --git a/checks/scripts b/checks/scripts
index 3dbcfec..fb458ef 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -527,6 +527,7 @@ open(SCRIPTS, '<', "control-scripts")
 
 my %added_diversions;
 my %removed_diversions;
+my $expand_diversions = 0;
 while (<SCRIPTS>) {
     chop;
 
@@ -881,12 +882,16 @@ while (<SCRIPTS>) {
 		# remove the leading / because it's not in the index hash
 		$divert =~ s,^/,,;
 
+		$divert = quotemeta($divert);
+
+		# For now just replace variables, they will later be normalised
+		$expand_diversions = 1 if $divert =~ s/\\\$\w+/.+/g;
+		$expand_diversions = 1 if $divert =~ s/\\\$\\{\w+\\}/.+/g;
+
 		if ($mode eq 'add') {
-		    $added_diversions{$divert} = $file;
-		    tag 'diversion-for-unknown-file', $divert, "$file:$."
-			unless (exists $info->index->{$divert});
+		    $added_diversions{$divert} = {'f'=>$file, 'l'=>$.};
 		} elsif ($mode eq 'remove') {
-		    $removed_diversions{$divert} = [ $file, $. ];
+		    $removed_diversions{$divert} = {'f'=>$file, 'l'=>$.};
 		} else {
 		    fail "Internal error: \$mode has unknown value: ".
 			"$mode";
@@ -914,25 +919,94 @@ while (<SCRIPTS>) {
 }
 close(SCRIPTS);
 
+# If any of the maintainer scripts used a variable in the file or
+# diversion name normalise them all
+if ($expand_diversions) {
+    for my $divert (keys %removed_diversions, keys %added_diversions) {
+
+	# if a wider regex was found, the entries might no longer be there
+	unless (exists($removed_diversions{$divert})
+	    or exists($added_diversions{$divert})) {
+	    next;
+	}
+
+	my $wider = $divert;
+
+	# find the widest regex:
+	my @matches = grep {
+		    if ($wider =~ m/^$_$/) {
+			$wider = $_;
+		    } elsif ($_ =~ m/^$wider$/) {
+			1;
+		    } else {
+			0;
+		    }
+		} (keys %removed_diversions, keys %added_diversions);
+
+	# replace all the occurences with the widest regex:
+	for my $k (@matches) {
+	    next if ($k eq $wider);
+
+	    if (exists($removed_diversions{$k})) {
+		$removed_diversions{$wider} = $removed_diversions{$k};
+		delete $removed_diversions{$k};
+	    }
+	    if (exists($added_diversions{$k})) {
+		$added_diversions{$wider} = $added_diversions{$k};
+		delete $added_diversions{$k};
+	    }
+	}
+    }
+}
+
 for my $divert (keys %removed_diversions) {
-    my $file = $removed_diversions{$divert}[0];
-    my $line = $removed_diversions{$divert}[1];
+    my $file = $removed_diversions{$divert}{'f'};
+    my $line = $removed_diversions{$divert}{'l'};
 
     if (exists $added_diversions{$divert}) {
-	# do not really delete the entry, because a --remove
-	# might happen in two branches in the script, i.e. we
+	# just mark the entry, because a --remove might
+	# happen in two branches in the script, i.e. we
 	# see it twice, which is not a bug
-	undef $added_diversions{$divert};
+	$added_diversions{$divert}{'r'} = 1;
     } elsif ($file eq 'postrm') {
 	# Allow preinst and postinst to remove diversions the
 	# package doesn't add to clean up after previous
 	# versions of the package.
+
+	# remove all the backslashes added by quotemeta:
+	$divert =~ s/\\//g;
+
+	# beautify the file name:
+	if ($expand_diversions) {
+	    $divert =~ s/\.\+/*/g;
+	}
+
 	tag 'remove-of-unknown-diversion', $divert, "$file:$line";
     }
 }
 
-for my $file (grep { defined $added_diversions{$_} } keys %added_diversions) {
-    tag 'orphaned-diversion', $file, $added_diversions{$file};
+for my $divert (keys %added_diversions) {
+    my $d = $added_diversions{$divert};
+
+    my $divertrx = $divert;
+    # remove all the backslashes added by quotemeta:
+    $divert =~ s/\\//g;
+
+    # beautify the file name:
+    if ($expand_diversions) {
+	$divert =~ s/\.\+/*/g;
+    }
+
+    tag 'diversion-for-unknown-file', $divert, "$d->{'f'}:$d->{'l'}"
+	unless ($expand_diversions || exists $info->index->{$divert});
+
+    tag 'diversion-for-unknown-file', $divert, "$d->{'f'}:$d->{'l'}"
+	if ($expand_diversions
+	    && not grep { $_ =~ m/$divertrx/ } keys %{$info->index});
+
+    if (not exists $d->{'r'}) {
+	tag 'orphaned-diversion', $divert, $d->{'f'};
+    }
 }
 }