1#!/usr/bin/perl 2# 3# dpkg-architecture 4# 5# Copyright © 1999-2001 Marcus Brinkmann <brinkmd@debian.org> 6# Copyright © 2004-2005 Scott James Remnant <scott@netsplit.com>, 7# Copyright © 2006-2014 Guillem Jover <guillem@debian.org> 8# 9# This program is free software; you can redistribute it and/or modify 10# it under the terms of the GNU General Public License as published by 11# the Free Software Foundation; either version 2 of the License, or 12# (at your option) any later version. 13# 14# This program is distributed in the hope that it will be useful, 15# but WITHOUT ANY WARRANTY; without even the implied warranty of 16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17# GNU General Public License for more details. 18# 19# You should have received a copy of the GNU General Public License 20# along with this program. If not, see <https://www.gnu.org/licenses/>. 21 22use strict; 23use warnings; 24 25use Dpkg (); 26use Dpkg::Gettext; 27use Dpkg::Getopt; 28use Dpkg::ErrorHandling; 29use Dpkg::Arch qw(:getters :mappers debarch_eq debarch_is); 30 31textdomain('dpkg-dev'); 32 33sub version { 34 printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; 35 36 printf g_(' 37This is free software; see the GNU General Public License version 2 or 38later for copying conditions. There is NO warranty. 39'); 40} 41 42sub usage { 43 printf g_( 44'Usage: %s [<option>...] [<command>]') 45 . "\n\n" . g_( 46'Commands: 47 -l, --list list variables (default). 48 -L, --list-known list valid architectures (matching some criteria). 49 -e, --equal <arch> compare with host Debian architecture. 50 -i, --is <arch-wildcard> match against host Debian architecture. 51 -q, --query <variable> prints only the value of <variable>. 52 -s, --print-set print command to set environment variables. 53 -u, --print-unset print command to unset environment variables. 54 -c, --command <command> set environment and run the command in it. 55 -?, --help show this help message. 56 --version show the version.') 57 . "\n\n" . g_( 58'Options: 59 -a, --host-arch <arch> set host Debian architecture. 60 -t, --host-type <type> set host GNU system type. 61 -A, --target-arch <arch> set target Debian architecture. 62 -T, --target-type <type> set target GNU system type. 63 -W, --match-wildcard <arch-wildcard> 64 restrict architecture list matching <arch-wildcard>. 65 -B, --match-bits <arch-bits> 66 restrict architecture list matching <arch-bits>. 67 -E, --match-endian <arch-endian> 68 restrict architecture list matching <arch-endian>. 69 -f, --force force flag (override variables set in environment).') 70 . "\n", $Dpkg::PROGNAME; 71} 72 73sub check_arch_coherency 74{ 75 my ($arch, $gnu_type) = @_; 76 77 if ($arch ne '' && $gnu_type eq '') { 78 $gnu_type = debarch_to_gnutriplet($arch); 79 error(g_('unknown Debian architecture %s, you must specify ' . 80 'GNU system type, too'), $arch) 81 unless defined $gnu_type; 82 } 83 84 if ($gnu_type ne '' && $arch eq '') { 85 $arch = gnutriplet_to_debarch($gnu_type); 86 error(g_('unknown GNU system type %s, you must specify ' . 87 'Debian architecture, too'), $gnu_type) 88 unless defined $arch; 89 } 90 91 if ($gnu_type ne '' && $arch ne '') { 92 my $dfl_gnu_type = debarch_to_gnutriplet($arch); 93 error(g_('unknown default GNU system type for Debian architecture %s'), 94 $arch) 95 unless defined $dfl_gnu_type; 96 warning(g_('default GNU system type %s for Debian arch %s does not ' . 97 'match specified GNU system type %s'), $dfl_gnu_type, 98 $arch, $gnu_type) 99 if $dfl_gnu_type ne $gnu_type; 100 } 101 102 return ($arch, $gnu_type); 103} 104 105use constant { 106 DEB_NONE => 0, 107 DEB_BUILD => 1, 108 DEB_HOST => 2, 109 DEB_TARGET => 64, 110 DEB_ARCH_INFO => 4, 111 DEB_ARCH_ATTR => 8, 112 DEB_MULTIARCH => 16, 113 DEB_GNU_INFO => 32, 114}; 115 116use constant DEB_ALL => DEB_BUILD | DEB_HOST | DEB_TARGET | 117 DEB_ARCH_INFO | DEB_ARCH_ATTR | 118 DEB_MULTIARCH | DEB_GNU_INFO; 119 120my %arch_vars = ( 121 DEB_BUILD_ARCH => DEB_BUILD, 122 DEB_BUILD_ARCH_ABI => DEB_BUILD | DEB_ARCH_INFO, 123 DEB_BUILD_ARCH_LIBC => DEB_BUILD | DEB_ARCH_INFO, 124 DEB_BUILD_ARCH_OS => DEB_BUILD | DEB_ARCH_INFO, 125 DEB_BUILD_ARCH_CPU => DEB_BUILD | DEB_ARCH_INFO, 126 DEB_BUILD_ARCH_BITS => DEB_BUILD | DEB_ARCH_ATTR, 127 DEB_BUILD_ARCH_ENDIAN => DEB_BUILD | DEB_ARCH_ATTR, 128 DEB_BUILD_MULTIARCH => DEB_BUILD | DEB_MULTIARCH, 129 DEB_BUILD_GNU_CPU => DEB_BUILD | DEB_GNU_INFO, 130 DEB_BUILD_GNU_SYSTEM => DEB_BUILD | DEB_GNU_INFO, 131 DEB_BUILD_GNU_TYPE => DEB_BUILD | DEB_GNU_INFO, 132 DEB_HOST_ARCH => DEB_HOST, 133 DEB_HOST_ARCH_ABI => DEB_HOST | DEB_ARCH_INFO, 134 DEB_HOST_ARCH_LIBC => DEB_HOST | DEB_ARCH_INFO, 135 DEB_HOST_ARCH_OS => DEB_HOST | DEB_ARCH_INFO, 136 DEB_HOST_ARCH_CPU => DEB_HOST | DEB_ARCH_INFO, 137 DEB_HOST_ARCH_BITS => DEB_HOST | DEB_ARCH_ATTR, 138 DEB_HOST_ARCH_ENDIAN => DEB_HOST | DEB_ARCH_ATTR, 139 DEB_HOST_MULTIARCH => DEB_HOST | DEB_MULTIARCH, 140 DEB_HOST_GNU_CPU => DEB_HOST | DEB_GNU_INFO, 141 DEB_HOST_GNU_SYSTEM => DEB_HOST | DEB_GNU_INFO, 142 DEB_HOST_GNU_TYPE => DEB_HOST | DEB_GNU_INFO, 143 DEB_TARGET_ARCH => DEB_TARGET, 144 DEB_TARGET_ARCH_ABI => DEB_TARGET | DEB_ARCH_INFO, 145 DEB_TARGET_ARCH_LIBC => DEB_TARGET | DEB_ARCH_INFO, 146 DEB_TARGET_ARCH_OS => DEB_TARGET | DEB_ARCH_INFO, 147 DEB_TARGET_ARCH_CPU => DEB_TARGET | DEB_ARCH_INFO, 148 DEB_TARGET_ARCH_BITS => DEB_TARGET | DEB_ARCH_ATTR, 149 DEB_TARGET_ARCH_ENDIAN => DEB_TARGET | DEB_ARCH_ATTR, 150 DEB_TARGET_MULTIARCH => DEB_TARGET | DEB_MULTIARCH, 151 DEB_TARGET_GNU_CPU => DEB_TARGET | DEB_GNU_INFO, 152 DEB_TARGET_GNU_SYSTEM => DEB_TARGET | DEB_GNU_INFO, 153 DEB_TARGET_GNU_TYPE => DEB_TARGET | DEB_GNU_INFO, 154); 155 156my $req_vars = DEB_ALL; 157my $req_host_arch = ''; 158my $req_host_gnu_type = ''; 159my $req_target_arch = ''; 160my $req_target_gnu_type = ''; 161my $req_eq_arch = ''; 162my $req_is_arch = ''; 163my $req_match_wildcard = ''; 164my $req_match_bits = ''; 165my $req_match_endian = ''; 166my $req_variable_to_print; 167my $action = 'list'; 168my $force = 0; 169 170sub action_needs($) { 171 my $bits = shift; 172 return (($req_vars & $bits) == $bits); 173} 174 175@ARGV = normalize_options(args => \@ARGV, delim => '-c'); 176 177while (@ARGV) { 178 my $arg = shift; 179 180 if ($arg eq '-a' or $arg eq '--host-arch') { 181 $req_host_arch = shift; 182 } elsif ($arg eq '-t' or $arg eq '--host-type') { 183 $req_host_gnu_type = shift; 184 } elsif ($arg eq '-A' or $arg eq '--target-arch') { 185 $req_target_arch = shift; 186 } elsif ($arg eq '-T' or $arg eq '--target-type') { 187 $req_target_gnu_type = shift; 188 } elsif ($arg eq '-W' or $arg eq '--match-wildcard') { 189 $req_match_wildcard = shift; 190 } elsif ($arg eq '-B' or $arg eq '--match-bits') { 191 $req_match_bits = shift; 192 } elsif ($arg eq '-E' or $arg eq '--match-endian') { 193 $req_match_endian = shift; 194 } elsif ($arg eq '-e' or $arg eq '--equal') { 195 $req_eq_arch = shift; 196 $req_vars = $arch_vars{DEB_HOST_ARCH}; 197 $action = 'equal'; 198 } elsif ($arg eq '-i' or $arg eq '--is') { 199 $req_is_arch = shift; 200 $req_vars = $arch_vars{DEB_HOST_ARCH}; 201 $action = 'is'; 202 } elsif ($arg eq '-u' or $arg eq '--print-unset') { 203 $req_vars = DEB_NONE; 204 $action = 'print-unset'; 205 } elsif ($arg eq '-l' or $arg eq '--list') { 206 $action = 'list'; 207 } elsif ($arg eq '-s' or $arg eq '--print-set') { 208 $req_vars = DEB_ALL; 209 $action = 'print-set'; 210 } elsif ($arg eq '-f' or $arg eq '--force') { 211 $force=1; 212 } elsif ($arg eq '-q' or $arg eq '--query') { 213 my $varname = shift; 214 error(g_('%s is not a supported variable name'), $varname) 215 unless (exists $arch_vars{$varname}); 216 $req_variable_to_print = "$varname"; 217 $req_vars = $arch_vars{$varname}; 218 $action = 'query'; 219 } elsif ($arg eq '-c' or $arg eq '--command') { 220 $action = 'command'; 221 last; 222 } elsif ($arg eq '-L' or $arg eq '--list-known') { 223 $req_vars = 0; 224 $action = 'list-known'; 225 } elsif ($arg eq '-?' or $arg eq '--help') { 226 usage(); 227 exit 0; 228 } elsif ($arg eq '--version') { 229 version(); 230 exit 0; 231 } else { 232 usageerr(g_("unknown option '%s'"), $arg); 233 } 234} 235 236my %v; 237 238# 239# Set build variables 240# 241 242$v{DEB_BUILD_ARCH} = get_raw_build_arch() 243 if (action_needs(DEB_BUILD)); 244($v{DEB_BUILD_ARCH_ABI}, $v{DEB_BUILD_ARCH_LIBC}, 245 $v{DEB_BUILD_ARCH_OS}, $v{DEB_BUILD_ARCH_CPU}) = debarch_to_debtuple($v{DEB_BUILD_ARCH}) 246 if (action_needs(DEB_BUILD | DEB_ARCH_INFO)); 247($v{DEB_BUILD_ARCH_BITS}, $v{DEB_BUILD_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_BUILD_ARCH}) 248 if (action_needs(DEB_BUILD | DEB_ARCH_ATTR)); 249 250$v{DEB_BUILD_MULTIARCH} = debarch_to_multiarch($v{DEB_BUILD_ARCH}) 251 if (action_needs(DEB_BUILD | DEB_MULTIARCH)); 252 253if (action_needs(DEB_BUILD | DEB_GNU_INFO)) { 254 $v{DEB_BUILD_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_BUILD_ARCH}); 255 ($v{DEB_BUILD_GNU_CPU}, $v{DEB_BUILD_GNU_SYSTEM}) = split(/-/, $v{DEB_BUILD_GNU_TYPE}, 2); 256} 257 258# 259# Set host variables 260# 261 262# First perform some sanity checks on the host arguments passed. 263 264($req_host_arch, $req_host_gnu_type) = check_arch_coherency($req_host_arch, $req_host_gnu_type); 265 266# Proceed to compute the host variables if needed. 267 268$v{DEB_HOST_ARCH} = $req_host_arch || get_raw_host_arch() 269 if (action_needs(DEB_HOST)); 270($v{DEB_HOST_ARCH_ABI}, $v{DEB_HOST_ARCH_LIBC}, 271 $v{DEB_HOST_ARCH_OS}, $v{DEB_HOST_ARCH_CPU}) = debarch_to_debtuple($v{DEB_HOST_ARCH}) 272 if (action_needs(DEB_HOST | DEB_ARCH_INFO)); 273($v{DEB_HOST_ARCH_BITS}, $v{DEB_HOST_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_HOST_ARCH}) 274 if (action_needs(DEB_HOST | DEB_ARCH_ATTR)); 275 276$v{DEB_HOST_MULTIARCH} = debarch_to_multiarch($v{DEB_HOST_ARCH}) 277 if (action_needs(DEB_HOST | DEB_MULTIARCH)); 278 279if (action_needs(DEB_HOST | DEB_GNU_INFO)) { 280 if ($req_host_gnu_type eq '') { 281 $v{DEB_HOST_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_HOST_ARCH}); 282 } else { 283 $v{DEB_HOST_GNU_TYPE} = $req_host_gnu_type; 284 } 285 ($v{DEB_HOST_GNU_CPU}, $v{DEB_HOST_GNU_SYSTEM}) = split(/-/, $v{DEB_HOST_GNU_TYPE}, 2); 286 287 my $host_gnu_type = get_host_gnu_type(); 288 289 warning(g_('specified GNU system type %s does not match CC system ' . 290 'type %s, try setting a correct CC environment variable'), 291 $v{DEB_HOST_GNU_TYPE}, $host_gnu_type) 292 if ($host_gnu_type ne '') && ($host_gnu_type ne $v{DEB_HOST_GNU_TYPE}); 293} 294 295# 296# Set target variables 297# 298 299# First perform some sanity checks on the target arguments passed. 300 301($req_target_arch, $req_target_gnu_type) = check_arch_coherency($req_target_arch, $req_target_gnu_type); 302 303# Proceed to compute the target variables if needed. 304 305$v{DEB_TARGET_ARCH} = $req_target_arch || $req_host_arch || get_raw_host_arch() 306 if (action_needs(DEB_TARGET)); 307($v{DEB_TARGET_ARCH_ABI}, $v{DEB_TARGET_ARCH_LIBC}, 308 $v{DEB_TARGET_ARCH_OS}, $v{DEB_TARGET_ARCH_CPU}) = debarch_to_debtuple($v{DEB_TARGET_ARCH}) 309 if (action_needs(DEB_TARGET | DEB_ARCH_INFO)); 310($v{DEB_TARGET_ARCH_BITS}, $v{DEB_TARGET_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_TARGET_ARCH}) 311 if (action_needs(DEB_TARGET | DEB_ARCH_ATTR)); 312 313$v{DEB_TARGET_MULTIARCH} = debarch_to_multiarch($v{DEB_TARGET_ARCH}) 314 if (action_needs(DEB_TARGET | DEB_MULTIARCH)); 315 316if (action_needs(DEB_TARGET | DEB_GNU_INFO)) { 317 if ($req_target_gnu_type eq '') { 318 $v{DEB_TARGET_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_TARGET_ARCH}); 319 } else { 320 $v{DEB_TARGET_GNU_TYPE} = $req_target_gnu_type; 321 } 322 ($v{DEB_TARGET_GNU_CPU}, $v{DEB_TARGET_GNU_SYSTEM}) = split(/-/, $v{DEB_TARGET_GNU_TYPE}, 2); 323} 324 325 326for my $k (keys %arch_vars) { 327 $v{$k} = $ENV{$k} if (length $ENV{$k} && !$force); 328} 329 330if ($action eq 'list') { 331 foreach my $k (sort keys %arch_vars) { 332 print "$k=$v{$k}\n"; 333 } 334} elsif ($action eq 'print-set') { 335 foreach my $k (sort keys %arch_vars) { 336 print "$k=$v{$k}; "; 337 } 338 print 'export ' . join(' ', sort keys %arch_vars) . "\n"; 339} elsif ($action eq 'print-unset') { 340 print 'unset ' . join(' ', sort keys %arch_vars) . "\n"; 341} elsif ($action eq 'equal') { 342 exit !debarch_eq($v{DEB_HOST_ARCH}, $req_eq_arch); 343} elsif ($action eq 'is') { 344 exit !debarch_is($v{DEB_HOST_ARCH}, $req_is_arch); 345} elsif ($action eq 'command') { 346 @ENV{keys %v} = values %v; 347 exec @ARGV; 348} elsif ($action eq 'query') { 349 print "$v{$req_variable_to_print}\n"; 350} elsif ($action eq 'list-known') { 351 foreach my $arch (get_valid_arches()) { 352 my ($bits, $endian) = debarch_to_abiattrs($arch); 353 354 next if $req_match_endian and $endian ne $req_match_endian; 355 next if $req_match_bits and $bits ne $req_match_bits; 356 next if $req_match_wildcard and not debarch_is($arch, $req_match_wildcard); 357 358 print "$arch\n"; 359 } 360} 361