scripts: Use new Dpkg::Arch functions to validate and parse architectures

Closes: #784808

debian/changelog

@@ -51,6 +51,8 @@ dpkg (1.18.5) UNRELEASED; urgency=medium
     build dependency.
   * Be more strict when parsing the COLUMNS environment variable in dpkg-query.
   * Make the Architecture field mandatory on package builds.
+  * Use new Dpkg::Arch functions to validate and parse architectures when
+    building source packages. Closes: #784808
   * Portability:
     - Move DPKG_ADMINDIR environment variable name out from update-alternatives
       code, to make life easier for non-dpkg-based systems.

scripts/Dpkg/Deps.pm

@@ -551,7 +551,7 @@ use warnings;
 
 use Carp;
 
-use Dpkg::Arch qw(debarch_is_concerned);
+use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse);
 use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula);
 use Dpkg::Version;
 use Dpkg::ErrorHandling;
@@ -627,7 +627,7 @@ sub parse_string {
 	$self->{version} = Dpkg::Version->new($4);
     }
     if (defined($5)) {
-	$self->{arches} = [ split(/\s+/, $5) ];
+	$self->{arches} = [ debarch_list_parse($5) ];
     }
     if (defined($6)) {
 	$self->{restrictions} = [ parse_build_profiles($6) ];

scripts/dpkg-genchanges.pl

@@ -34,7 +34,7 @@ use Dpkg::ErrorHandling;
 use Dpkg::Build::Types;
 use Dpkg::BuildProfiles qw(get_build_profiles parse_build_profiles
                            evaluate_restriction_formula);
-use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
+use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is debarch_list_parse);
 use Dpkg::Compression;
 use Dpkg::Control::Info;
 use Dpkg::Control::Fields;
@@ -332,7 +332,7 @@ foreach my $pkg ($control->get_packages()) {
 	# No files for this package... warn if it's unexpected
 	if (((build_has(BUILD_ARCH_INDEP) and debarch_eq('all', $a)) or
 	     (build_has(BUILD_ARCH_DEP) and
-	      (any { debarch_is($host_arch, $_) } split /\s+/, $a))) and
+	      (any { debarch_is($host_arch, $_) } debarch_list_parse($a)))) and
 	    (@restrictions == 0 or
 	     evaluate_restriction_formula(\@restrictions, \@profiles)))
 	{
@@ -351,7 +351,7 @@ foreach my $pkg ($control->get_packages()) {
 	    $f2pricf{$_} = $v foreach (@f);
 	} elsif (m/^Architecture$/) {
 	    if (build_has(BUILD_ARCH_DEP) and
-	        (any { debarch_is($host_arch, $_) } split /\s+/, $v)) {
+	        (any { debarch_is($host_arch, $_) } debarch_list_parse($v))) {
 		$v = $host_arch;
 	    } elsif (!debarch_eq('all', $v)) {
 		$v = '';

scripts/dpkg-gencontrol.pl

@@ -30,7 +30,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Util qw(:list);
 use Dpkg::File;
-use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
+use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is debarch_list_parse);
 use Dpkg::Package;
 use Dpkg::BuildProfiles qw(get_build_profiles);
 use Dpkg::Deps;
@@ -212,13 +212,8 @@ foreach (keys %{$pkg}) {
 	if (debarch_eq('all', $v)) {
 	    $fields->{$_} = $v;
 	} else {
-	    my @archlist = split(/\s+/, $v);
-	    my @invalid_archs = grep { m/[^\w-]/ } @archlist;
-	    warning(P_("'%s' is not a legal architecture string.",
-	               "'%s' are not legal architecture strings.",
-	               scalar(@invalid_archs)),
-	            join("' '", @invalid_archs))
-		if @invalid_archs >= 1;
+	    my @archlist = debarch_list_parse($v);
+
 	    if (none { debarch_is($host_arch, $_) } @archlist) {
 		error(g_("current host architecture '%s' does not " .
 			 "appear in package's architecture list (%s)"),

scripts/dpkg-source.pl

@@ -36,7 +36,7 @@ use Dpkg ();
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 use Dpkg::Util qw(:list);
-use Dpkg::Arch qw(debarch_eq debarch_is debarch_is_wildcard);
+use Dpkg::Arch qw(debarch_eq debarch_is debarch_is_wildcard debarch_is_illegal);
 use Dpkg::Deps;
 use Dpkg::Compression;
 use Dpkg::Conf;
@@ -313,9 +313,8 @@ if ($options{opmode} =~ /^(build|print-format|(before|after)-build|commit)$/) {
                     push(@sourcearch, $v) unless $archadded{$v}++;
                 } else {
                     for my $a (split(/\s+/, $v)) {
-                        error(g_("'%s' is not a legal architecture string"),
-                              $a)
-                            unless $a =~ /^[\w-]+$/;
+                        error(g_("'%s' is not a legal architecture string"), $a)
+                            if debarch_is_illegal($a);
                         error(g_('architecture %s only allowed on its ' .
                                  "own (list for package %s is '%s')"),
                               $a, $p, $a)