Check for illegal architecture strings in dpkg-gencontrol and

dpkg-source. dpkg-gencontrol will only issue a warning while
dpkg-source will error out. Closes: #96920

ChangeLog

@@ -45,6 +45,12 @@
 	directory mode 0700 to not allow anyone exploiting races
 	between the extraction and the chown.
 
+	* scripts/dpkg-gencontrol.pl: Warn about illegal architecture
+	strings. This will warn e.g. about comma-separated architecture
+	lists.
+	* scripts/dpkg-source.pl: Also check architecture strings and
+	error out if we find illegal ones.
+
 2005-08-27  Frank Lichtenheld  <djpig@debian.org>
 
 	* scripts/dpkg-gencontrol: Bail out with an error if parsedep

debian/changelog

@@ -17,6 +17,9 @@ dpkg (1.13.12~) unstable; urgency=low
   * Let dpkg-source ensure (as good as possible) that all
     build source packages can also be unpacked.
     Closes: #6820, #7014
+  * Check for illegal architecture strings in dpkg-gencontrol and
+    dpkg-source. dpkg-gencontrol will only issue a warning while
+    dpkg-source will error out. Closes: #96920
 
  --
 

scripts/dpkg-gencontrol.pl

@@ -139,6 +139,11 @@ for $_ (keys %fi) {
                 $f{$_}= $arch;
             } else {
                 @archlist= split(/\s+/,$v);
+		my @invalid_archs = grep m/[^\w-]/, @archlist;
+		&warn("`".join("' `", @invalid_archs)."' are not legal ".
+		      "architecture strings.") if @invalid_archs > 1;
+		&warn("`@invalid_archs' is not a legal ".
+		      "architecture string.") if @invalid_archs == 1;
                 grep($arch eq $_, @archlist) ||
                     &error("current build architecture $arch does not".
                            " appear in package's list (@archlist)");

scripts/dpkg-source.pl

@@ -195,6 +195,8 @@ if ($opmode eq 'build') {
 			@sourcearch= ('any');
 		    } else {
                         for $a (split(/\s+/,$v)) {
+			    &error("`$a' is not a legal architecture string")
+				unless $a =~ /^[\w-]$/;
                             &error("architecture $a only allowed on its own".
                                    " (list for package $p is `$a')")
                                    if grep($a eq $_, 'any','all');