Dpkg::Getopt: Do not normalize args past a passthrough stop word

Some commands pass some arguments through to another command, and those
must not be normalized as that might break their invocation.

Reported-by: Helmut Grohne <helmut@subdivi.de>
Stable-Candidate: 1.17.x 1.18.x

5 files changed, 22 insertions, 10 deletions

diff --git a/debian/changelog b/debian/changelog
index 6231ede13..22af260ce 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -115,6 +115,10 @@ dpkg (1.19.0) UNRELEASED; urgency=medium
       the code already handles the commands not being present.
     - Do not unnecessarily require setting the host_arch in Dpkg::Deps.
       Closes: #856396
+    - Do not normalize args past a passthrough stop word in Dpkg::Getopt.
+      Some commands pass some arguments through to another command, and
+      those must not be normalized as that might break their invocation.
+      Reported by Helmut Grohne <helmut@subdivi.de>.
   * Documentation:
     - Document currently accepted syntax for changelogs in deb-changelog(5).
       Closes: #858579
diff --git a/scripts/Dpkg/Getopt.pm b/scripts/Dpkg/Getopt.pm
index 4d677f391..bebe9f8d3 100644
--- a/scripts/Dpkg/Getopt.pm
+++ b/scripts/Dpkg/Getopt.pm
@@ -18,7 +18,7 @@ package Dpkg::Getopt;
 use strict;
 use warnings;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 our @EXPORT = qw(
     normalize_options
 );
@@ -27,17 +27,20 @@ use Exporter qw(import);
 
 sub normalize_options
 {
-    my (@args) = @_;
+    my (%opts) = @_;
+    my $norm = 1;
+    my @args;
 
     @args = map {
-        if (m/^(-[A-Za-z])(.+)$/) {
+        if ($norm and m/^(-[A-Za-z])(.+)$/) {
             ($1, $2)
-        } elsif (m/^(--[A-Za-z-]+)=(.*)$/) {
+        } elsif ($norm and m/^(--[A-Za-z-]+)=(.*)$/) {
             ($1, $2)
         } else {
+            $norm = 0 if defined $opts{delim} and $_ eq $opts{delim};
             $_;
         }
-    } @args;
+    } @{$opts{args}};
 
     return @args;
 }
diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl
index be99240cd..99624272c 100755
--- a/scripts/dpkg-architecture.pl
+++ b/scripts/dpkg-architecture.pl
@@ -172,7 +172,7 @@ sub action_needs($) {
   return (($req_vars & $bits) == $bits);
 }
 
-@ARGV = normalize_options(@ARGV);
+@ARGV = normalize_options(args => \@ARGV, delim => '-c');
 
 while (@ARGV) {
     my $arg = shift;
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index 9f826a9eb..86c30b451 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -70,7 +70,7 @@ sub usage {
 "), $Dpkg::PROGNAME;
 }
 
-@ARGV = normalize_options(@ARGV);
+@ARGV = normalize_options(args => \@ARGV, delim => '--');
 
 while (@ARGV) {
     last unless $ARGV[0] =~ m/^-/;
diff --git a/scripts/t/Dpkg_Getopt.t b/scripts/t/Dpkg_Getopt.t
index 186679636..32edeec53 100644
--- a/scripts/t/Dpkg_Getopt.t
+++ b/scripts/t/Dpkg_Getopt.t
@@ -16,7 +16,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 BEGIN {
     use_ok('Dpkg::Getopt');
@@ -24,12 +24,17 @@ BEGIN {
 
 my @expect_argv;
 
-@ARGV = normalize_options(qw(-a -bfoo -c var));
+@ARGV = normalize_options(args => [ qw(-a -bfoo -c var) ]);
 @expect_argv = qw(-a -b foo -c var);
 is_deeply(\@ARGV, \@expect_argv, 'unbundle short options');
 
-@ARGV = normalize_options(qw(--option-a --option-b value --option-c=value));
+@ARGV = normalize_options(args => [ qw(--option-a --option-b value --option-c=value) ]);
 @expect_argv = qw(--option-a --option-b value --option-c value);
 is_deeply(\@ARGV, \@expect_argv, 'unbundle long options');
 
+@ARGV = normalize_options(args => [ qw(-aaa -bbb --option-a=oa -- --opt=arg -dval) ],
+                          delim => '--');
+@expect_argv = qw(-a aa -b bb --option-a oa -- --opt=arg -dval);
+is_deeply(\@ARGV, \@expect_argv, 'unbundle options with delimiter');
+
 1;