Package: dpkg
Version: 1.13.9
Author: Guillem Jover <guillem@debian.org>
Status: fixed
Debbug: 291939
Description:
 Implement Debian architecture alias support, and export an equality and
 identity operators via the new dpkg-architecture -e and -i actions.
 .
 Will take a virtual arch like <kernel>-any or any-<cpu> and expand to all
 available arches. And will also normalize linux-<cpu> to <cpu> for
 consistency.

diff -Naur dpkg-1.13.9.email/scripts/controllib.pl dpkg-1.13.9.arch-alias/scripts/controllib.pl
--- dpkg-1.13.9.email/scripts/controllib.pl	2005-06-06 07:07:12.000000000 +0300
+++ dpkg-1.13.9.arch-alias/scripts/controllib.pl	2005-06-21 04:12:19.000000000 +0300
@@ -80,6 +80,36 @@
     $substvar{'Arch'}= $arch;
 }
 
+sub debian_arch_split {
+    local ($_) = @_;
+
+    if (/^([^-]*)-(.*)/) {
+	return ($1, $2);
+    } elsif (/any/ || /all/) {
+	return ($_, $_);
+    } else {
+	return ("linux", $_);
+    }
+}
+
+sub debian_arch_is {
+    my ($real, $alias) = @_;
+    my ($real_os, $real_cpu) = debian_arch_split($real);
+    my ($alias_os, $alias_cpu) = debian_arch_split($alias);
+
+    if ("$real_os-$real_cpu" eq "$alias_os-$alias_cpu") {
+	return 1;
+    } elsif ("$alias_os-$alias_cpu" eq "any-any") {
+	return 1;
+    } elsif ("$alias_os-$alias_cpu" eq "any-$real_cpu") {
+	return 1;
+    } elsif ("$alias_os-$alias_cpu" eq "$real_os-any") {
+	return 1;
+    }
+
+    return 0;
+}
+
 sub substvars {
     my ($v) = @_;
     my ($lhs,$vn,$rhs,$count);
@@ -188,10 +218,12 @@
                 my $seen_arch='';
                 foreach my $arch (@arches) {
                     $arch=lc($arch);
-                    if ($arch eq $host_arch) {
+                    if (debian_arch_is($host_arch, $arch)) {
                         $seen_arch=1;
                         next;
                     } elsif ($arch eq "!$host_arch") {
+                    } elsif ($arch =~ /^!/ "!$host_arch" &&
+			     !debian_arch_is($host_arch, $arch)) {
                         next ALTERNATE;
                     } elsif ($arch =~ /!/) {
                         # This is equivilant to
diff -Naur dpkg-1.13.9.email/scripts/dpkg-architecture.pl dpkg-1.13.9.arch-alias/scripts/dpkg-architecture.pl
--- dpkg-1.13.9.email/scripts/dpkg-architecture.pl	2005-06-19 19:42:29.000000000 +0300
+++ dpkg-1.13.9.arch-alias/scripts/dpkg-architecture.pl	2005-06-20 03:11:07.000000000 +0300
@@ -45,6 +45,7 @@
        -f                 force flag (override variables set in environment)
 Actions:
        -l                 list variables (default)
+       -e<alias-arch>     expand Debian architecture alias into real ones.
        -q<variable>       prints only the value of <variable>.
        -s                 print command to set environment variables
        -u                 print command to unset environment variables
@@ -78,6 +79,17 @@
     close OSTABLE;
 }
 
+sub fix_debian
+{
+    local ($os, $cpu) = @_;
+
+    if ($os eq "linux") {
+	return $cpu;
+    } else {
+	return "$os-$cpu";
+    }
+}
+
 sub split_debian {
     local ($_) = @_;
     
@@ -124,11 +136,32 @@
     }
 
     return undef if !defined($cpu) || !defined($os);
-    if ($os eq "linux") {
-	return $cpu;
+    return fix_debian($os, $cpu);
+}
+
+sub expand_debian
+{
+    local ($arch) = @_;
+    local ($os, $cpu) = debian_arch_split($arch);
+    local @list;
+
+    if ("$os-$cpu" eq 'any-any') {
+	@list = 'any';
+    } elsif ($os eq 'all' or $cpu eq 'all') {
+	@list = 'all';
+    } elsif ($cpu eq 'any') {
+	foreach my $_cpu (@cpu) {
+	    push @list, fix_debian($os, $_cpu);
+	}
+    } elsif ($os eq 'any') {
+	foreach my $_os (@os) {
+	    push @list, fix_debian($_os, $cpu);
+	}
     } else {
-	return "$os-$cpu";
+	push @list, fix_debian($os, $cpu);
     }
+
+    return @list;
 }
 
 &read_cputable;
@@ -138,11 +171,7 @@
 if (grep { m/^-L$/ } @ARGV) {
     foreach $os (@os) {
 	foreach $cpu (@cpu) {
-	    if ($os eq "linux") {
-		print "$cpu\n"
-	    } else {
-		print "$os-$cpu\n";
-	    }
+	    print fix_debian($os, $cpu)."\n";
 	}
     }
     exit unless $#ARGV;
@@ -182,6 +211,7 @@
 $req_host_arch = '';
 $req_host_gnu_type = '';
 $req_build_gnu_type = '';
+$req_expand_arch = '';
 $action='l';
 $force=0;
 
@@ -191,6 +221,9 @@
 	$req_host_arch = "$'";
     } elsif (m/^-t/) {
 	$req_host_gnu_type = "$'";
+    } elsif (m/^-e/) {
+	$req_expand_arch = "$'";
+	$action = 'e';
     } elsif (m/^-[lsu]$/) {
 	$action = $_;
 	$action =~ s/^-//;
@@ -282,6 +315,9 @@
     print "export ".join(" ",@ordered)."\n";
 } elsif ($action eq 'u') {
     print "unset ".join(" ",@ordered)."\n";
+} elsif ($action eq 'e') {
+    @arch_list = expand_debian($req_expand_arch);
+    print "@arch_list\n";
 } elsif ($action eq 'c') {
     @ENV{keys %env} = values %env;
     exec @ARGV;
diff -Naur dpkg-1.13.9.email/scripts/dpkg-genchanges.pl dpkg-1.13.9.arch-alias/scripts/dpkg-genchanges.pl
--- dpkg-1.13.9.email/scripts/dpkg-genchanges.pl	2005-06-06 07:07:12.000000000 +0300
+++ dpkg-1.13.9.arch-alias/scripts/dpkg-genchanges.pl	2005-06-19 21:29:38.000000000 +0300
@@ -168,8 +168,9 @@
     } elsif (s/^C(\d+) //) {
 	$i=$1; $p=$fi{"C$i Package"}; $a=$fi{"C$i Architecture"};
 	if (!defined($p2f{$p}) && not $sourceonly) {
-	    if ($a eq 'any' || ($a eq 'all' && !$archspecific) ||
-		grep($_ eq $substvar{'Arch'}, split(/\s+/, $a))) {
+	    if (($a eq 'all' && !$archspecific) ||
+		debian_arch_is($arch, $a) ||
+		grep(debian_arch_is($arch, $_), split(/\s+/, $a))) {
 		&warn("package $p in control file but not in files list");
 		next;
 	    }
@@ -191,7 +192,8 @@
 		$f{$_}= $v;
 	    } elsif (m/^Architecture$/) {
 		if (not $sourceonly) {
-		    if ($v eq 'any' || grep($_ eq $arch, split(/\s+/, $v))) {
+		    if (debian_arch_is($arch, $v) ||
+			grep(debian_arch_is($arch, $_), split(/\s+/, $v))) {
 			$v= $arch;
 		    } elsif ($v ne 'all') {
 			$v= '';
diff -Naur dpkg-1.13.9.email/scripts/dpkg-gencontrol.pl dpkg-1.13.9.arch-alias/scripts/dpkg-gencontrol.pl
--- dpkg-1.13.9.email/scripts/dpkg-gencontrol.pl	2005-06-06 07:07:12.000000000 +0300
+++ dpkg-1.13.9.arch-alias/scripts/dpkg-gencontrol.pl	2005-06-19 19:17:31.000000000 +0300
@@ -135,11 +135,11 @@
         } elsif (m/^Architecture$/) {
             if ($v eq 'all') {
                 $f{$_}= $v;
-            } elsif ($v eq 'any') {
+            } elsif (debian_arch_is($arch, $v)) {
                 $f{$_}= $arch;
             } else {
                 @archlist= split(/\s+/,$v);
-                grep($arch eq $_, @archlist) ||
+                grep(debian_arch_is($arch, $_), @archlist) ||
                     &error("current build architecture $arch does not".
                            " appear in package's list (@archlist)");
                 $f{$_}= $arch;
diff -Naur dpkg-1.13.9.email/scripts/dpkg-source.pl dpkg-1.13.9.arch-alias/scripts/dpkg-source.pl
--- dpkg-1.13.9.email/scripts/dpkg-source.pl	2005-06-11 21:59:47.000000000 +0300
+++ dpkg-1.13.9.arch-alias/scripts/dpkg-source.pl	2005-06-20 03:09:31.000000000 +0300
@@ -161,9 +161,9 @@
             $i=$1; $p=$fi{"C$i Package"};
             push(@binarypackages,$p) unless $packageadded{$p}++;
             if (m/^Architecture$/) {
-                if ($v eq 'any') {
+                if (debian_arch_is($v, 'any')) {
                     @sourcearch= ('any');
-                } elsif ($v eq 'all') {
+                } elsif (debian_arch_is($v, 'all')) {
                     if (!@sourcearch || $sourcearch[0] eq 'all') {
                         @sourcearch= ('all');
                     } else {
@@ -173,7 +173,10 @@
 		    if (grep($sourcearch[0] eq $_, 'any','all'))  {
 			@sourcearch= ('any');
 		    } else {
-                        for $a (split(/\s+/,$v)) {
+			my @arches = map(split(/\s+/, `dpkg-architecture -e$_`),
+					 split(/\s+/, $v));
+			chomp @arches;
+                        for $a (@arches) {
                             &error("architecture $a only allowed on its own".
                                    " (list for package $p is `$a')")
                                    if grep($a eq $_, 'any','all');