diff options
Diffstat (limited to '')
| -rwxr-xr-x | scripts/dpkg-architecture.pl | 360 |
1 files changed, 360 insertions, 0 deletions
diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl new file mode 100755 index 0000000..9962427 --- /dev/null +++ b/scripts/dpkg-architecture.pl @@ -0,0 +1,360 @@ +#!/usr/bin/perl +# +# dpkg-architecture +# +# Copyright © 1999-2001 Marcus Brinkmann <brinkmd@debian.org> +# Copyright © 2004-2005 Scott James Remnant <scott@netsplit.com>, +# Copyright © 2006-2014 Guillem Jover <guillem@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +use strict; +use warnings; + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::Getopt; +use Dpkg::ErrorHandling; +use Dpkg::Arch qw(:getters :mappers debarch_eq debarch_is); + +textdomain('dpkg-dev'); + +sub version { + printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; + + printf g_(' +This is free software; see the GNU General Public License version 2 or +later for copying conditions. There is NO warranty. +'); +} + +sub usage { + printf g_( +'Usage: %s [<option>...] [<command>]') + . "\n\n" . g_( +'Commands: + -l, --list list variables (default). + -L, --list-known list valid architectures (matching some criteria). + -e, --equal <arch> compare with host Debian architecture. + -i, --is <arch-wildcard> match against host Debian architecture. + -q, --query <variable> prints only the value of <variable>. + -s, --print-set print command to set environment variables. + -u, --print-unset print command to unset environment variables. + -c, --command <command> set environment and run the command in it. + -?, --help show this help message. + --version show the version.') + . "\n\n" . g_( +'Options: + -a, --host-arch <arch> set host Debian architecture. + -t, --host-type <type> set host GNU system type. + -A, --target-arch <arch> set target Debian architecture. + -T, --target-type <type> set target GNU system type. + -W, --match-wildcard <arch-wildcard> + restrict architecture list matching <arch-wildcard>. + -B, --match-bits <arch-bits> + restrict architecture list matching <arch-bits>. + -E, --match-endian <arch-endian> + restrict architecture list matching <arch-endian>. + -f, --force force flag (override variables set in environment).') + . "\n", $Dpkg::PROGNAME; +} + +sub check_arch_coherency +{ + my ($arch, $gnu_type) = @_; + + if ($arch ne '' && $gnu_type eq '') { + $gnu_type = debarch_to_gnutriplet($arch); + error(g_('unknown Debian architecture %s, you must specify ' . + 'GNU system type, too'), $arch) + unless defined $gnu_type; + } + + if ($gnu_type ne '' && $arch eq '') { + $arch = gnutriplet_to_debarch($gnu_type); + error(g_('unknown GNU system type %s, you must specify ' . + 'Debian architecture, too'), $gnu_type) + unless defined $arch; + } + + if ($gnu_type ne '' && $arch ne '') { + my $dfl_gnu_type = debarch_to_gnutriplet($arch); + error(g_('unknown default GNU system type for Debian architecture %s'), + $arch) + unless defined $dfl_gnu_type; + warning(g_('default GNU system type %s for Debian arch %s does not ' . + 'match specified GNU system type %s'), $dfl_gnu_type, + $arch, $gnu_type) + if $dfl_gnu_type ne $gnu_type; + } + + return ($arch, $gnu_type); +} + +use constant { + DEB_NONE => 0, + DEB_BUILD => 1, + DEB_HOST => 2, + DEB_TARGET => 64, + DEB_ARCH_INFO => 4, + DEB_ARCH_ATTR => 8, + DEB_MULTIARCH => 16, + DEB_GNU_INFO => 32, +}; + +use constant DEB_ALL => DEB_BUILD | DEB_HOST | DEB_TARGET | + DEB_ARCH_INFO | DEB_ARCH_ATTR | + DEB_MULTIARCH | DEB_GNU_INFO; + +my %arch_vars = ( + DEB_BUILD_ARCH => DEB_BUILD, + DEB_BUILD_ARCH_ABI => DEB_BUILD | DEB_ARCH_INFO, + DEB_BUILD_ARCH_LIBC => DEB_BUILD | DEB_ARCH_INFO, + DEB_BUILD_ARCH_OS => DEB_BUILD | DEB_ARCH_INFO, + DEB_BUILD_ARCH_CPU => DEB_BUILD | DEB_ARCH_INFO, + DEB_BUILD_ARCH_BITS => DEB_BUILD | DEB_ARCH_ATTR, + DEB_BUILD_ARCH_ENDIAN => DEB_BUILD | DEB_ARCH_ATTR, + DEB_BUILD_MULTIARCH => DEB_BUILD | DEB_MULTIARCH, + DEB_BUILD_GNU_CPU => DEB_BUILD | DEB_GNU_INFO, + DEB_BUILD_GNU_SYSTEM => DEB_BUILD | DEB_GNU_INFO, + DEB_BUILD_GNU_TYPE => DEB_BUILD | DEB_GNU_INFO, + DEB_HOST_ARCH => DEB_HOST, + DEB_HOST_ARCH_ABI => DEB_HOST | DEB_ARCH_INFO, + DEB_HOST_ARCH_LIBC => DEB_HOST | DEB_ARCH_INFO, + DEB_HOST_ARCH_OS => DEB_HOST | DEB_ARCH_INFO, + DEB_HOST_ARCH_CPU => DEB_HOST | DEB_ARCH_INFO, + DEB_HOST_ARCH_BITS => DEB_HOST | DEB_ARCH_ATTR, + DEB_HOST_ARCH_ENDIAN => DEB_HOST | DEB_ARCH_ATTR, + DEB_HOST_MULTIARCH => DEB_HOST | DEB_MULTIARCH, + DEB_HOST_GNU_CPU => DEB_HOST | DEB_GNU_INFO, + DEB_HOST_GNU_SYSTEM => DEB_HOST | DEB_GNU_INFO, + DEB_HOST_GNU_TYPE => DEB_HOST | DEB_GNU_INFO, + DEB_TARGET_ARCH => DEB_TARGET, + DEB_TARGET_ARCH_ABI => DEB_TARGET | DEB_ARCH_INFO, + DEB_TARGET_ARCH_LIBC => DEB_TARGET | DEB_ARCH_INFO, + DEB_TARGET_ARCH_OS => DEB_TARGET | DEB_ARCH_INFO, + DEB_TARGET_ARCH_CPU => DEB_TARGET | DEB_ARCH_INFO, + DEB_TARGET_ARCH_BITS => DEB_TARGET | DEB_ARCH_ATTR, + DEB_TARGET_ARCH_ENDIAN => DEB_TARGET | DEB_ARCH_ATTR, + DEB_TARGET_MULTIARCH => DEB_TARGET | DEB_MULTIARCH, + DEB_TARGET_GNU_CPU => DEB_TARGET | DEB_GNU_INFO, + DEB_TARGET_GNU_SYSTEM => DEB_TARGET | DEB_GNU_INFO, + DEB_TARGET_GNU_TYPE => DEB_TARGET | DEB_GNU_INFO, +); + +my $req_vars = DEB_ALL; +my $req_host_arch = ''; +my $req_host_gnu_type = ''; +my $req_target_arch = ''; +my $req_target_gnu_type = ''; +my $req_eq_arch = ''; +my $req_is_arch = ''; +my $req_match_wildcard = ''; +my $req_match_bits = ''; +my $req_match_endian = ''; +my $req_variable_to_print; +my $action = 'list'; +my $force = 0; + +sub action_needs($) { + my $bits = shift; + return (($req_vars & $bits) == $bits); +} + +@ARGV = normalize_options(args => \@ARGV, delim => '-c'); + +while (@ARGV) { + my $arg = shift; + + if ($arg eq '-a' or $arg eq '--host-arch') { + $req_host_arch = shift; + } elsif ($arg eq '-t' or $arg eq '--host-type') { + $req_host_gnu_type = shift; + } elsif ($arg eq '-A' or $arg eq '--target-arch') { + $req_target_arch = shift; + } elsif ($arg eq '-T' or $arg eq '--target-type') { + $req_target_gnu_type = shift; + } elsif ($arg eq '-W' or $arg eq '--match-wildcard') { + $req_match_wildcard = shift; + } elsif ($arg eq '-B' or $arg eq '--match-bits') { + $req_match_bits = shift; + } elsif ($arg eq '-E' or $arg eq '--match-endian') { + $req_match_endian = shift; + } elsif ($arg eq '-e' or $arg eq '--equal') { + $req_eq_arch = shift; + $req_vars = $arch_vars{DEB_HOST_ARCH}; + $action = 'equal'; + } elsif ($arg eq '-i' or $arg eq '--is') { + $req_is_arch = shift; + $req_vars = $arch_vars{DEB_HOST_ARCH}; + $action = 'is'; + } elsif ($arg eq '-u' or $arg eq '--print-unset') { + $req_vars = DEB_NONE; + $action = 'print-unset'; + } elsif ($arg eq '-l' or $arg eq '--list') { + $action = 'list'; + } elsif ($arg eq '-s' or $arg eq '--print-set') { + $req_vars = DEB_ALL; + $action = 'print-set'; + } elsif ($arg eq '-f' or $arg eq '--force') { + $force=1; + } elsif ($arg eq '-q' or $arg eq '--query') { + my $varname = shift; + error(g_('%s is not a supported variable name'), $varname) + unless (exists $arch_vars{$varname}); + $req_variable_to_print = "$varname"; + $req_vars = $arch_vars{$varname}; + $action = 'query'; + } elsif ($arg eq '-c' or $arg eq '--command') { + $action = 'command'; + last; + } elsif ($arg eq '-L' or $arg eq '--list-known') { + $req_vars = 0; + $action = 'list-known'; + } elsif ($arg eq '-?' or $arg eq '--help') { + usage(); + exit 0; + } elsif ($arg eq '--version') { + version(); + exit 0; + } else { + usageerr(g_("unknown option '%s'"), $arg); + } +} + +my %v; + +# +# Set build variables +# + +$v{DEB_BUILD_ARCH} = get_raw_build_arch() + if (action_needs(DEB_BUILD)); +($v{DEB_BUILD_ARCH_ABI}, $v{DEB_BUILD_ARCH_LIBC}, + $v{DEB_BUILD_ARCH_OS}, $v{DEB_BUILD_ARCH_CPU}) = debarch_to_debtuple($v{DEB_BUILD_ARCH}) + if (action_needs(DEB_BUILD | DEB_ARCH_INFO)); +($v{DEB_BUILD_ARCH_BITS}, $v{DEB_BUILD_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_BUILD_ARCH}) + if (action_needs(DEB_BUILD | DEB_ARCH_ATTR)); + +$v{DEB_BUILD_MULTIARCH} = debarch_to_multiarch($v{DEB_BUILD_ARCH}) + if (action_needs(DEB_BUILD | DEB_MULTIARCH)); + +if (action_needs(DEB_BUILD | DEB_GNU_INFO)) { + $v{DEB_BUILD_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_BUILD_ARCH}); + ($v{DEB_BUILD_GNU_CPU}, $v{DEB_BUILD_GNU_SYSTEM}) = split(/-/, $v{DEB_BUILD_GNU_TYPE}, 2); +} + +# +# Set host variables +# + +# First perform some sanity checks on the host arguments passed. + +($req_host_arch, $req_host_gnu_type) = check_arch_coherency($req_host_arch, $req_host_gnu_type); + +# Proceed to compute the host variables if needed. + +$v{DEB_HOST_ARCH} = $req_host_arch || get_raw_host_arch() + if (action_needs(DEB_HOST)); +($v{DEB_HOST_ARCH_ABI}, $v{DEB_HOST_ARCH_LIBC}, + $v{DEB_HOST_ARCH_OS}, $v{DEB_HOST_ARCH_CPU}) = debarch_to_debtuple($v{DEB_HOST_ARCH}) + if (action_needs(DEB_HOST | DEB_ARCH_INFO)); +($v{DEB_HOST_ARCH_BITS}, $v{DEB_HOST_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_HOST_ARCH}) + if (action_needs(DEB_HOST | DEB_ARCH_ATTR)); + +$v{DEB_HOST_MULTIARCH} = debarch_to_multiarch($v{DEB_HOST_ARCH}) + if (action_needs(DEB_HOST | DEB_MULTIARCH)); + +if (action_needs(DEB_HOST | DEB_GNU_INFO)) { + if ($req_host_gnu_type eq '') { + $v{DEB_HOST_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_HOST_ARCH}); + } else { + $v{DEB_HOST_GNU_TYPE} = $req_host_gnu_type; + } + ($v{DEB_HOST_GNU_CPU}, $v{DEB_HOST_GNU_SYSTEM}) = split(/-/, $v{DEB_HOST_GNU_TYPE}, 2); + + my $host_gnu_type = get_host_gnu_type(); + + warning(g_('specified GNU system type %s does not match CC system ' . + 'type %s, try setting a correct CC environment variable'), + $v{DEB_HOST_GNU_TYPE}, $host_gnu_type) + if ($host_gnu_type ne '') && ($host_gnu_type ne $v{DEB_HOST_GNU_TYPE}); +} + +# +# Set target variables +# + +# First perform some sanity checks on the target arguments passed. + +($req_target_arch, $req_target_gnu_type) = check_arch_coherency($req_target_arch, $req_target_gnu_type); + +# Proceed to compute the target variables if needed. + +$v{DEB_TARGET_ARCH} = $req_target_arch || $req_host_arch || get_raw_host_arch() + if (action_needs(DEB_TARGET)); +($v{DEB_TARGET_ARCH_ABI}, $v{DEB_TARGET_ARCH_LIBC}, + $v{DEB_TARGET_ARCH_OS}, $v{DEB_TARGET_ARCH_CPU}) = debarch_to_debtuple($v{DEB_TARGET_ARCH}) + if (action_needs(DEB_TARGET | DEB_ARCH_INFO)); +($v{DEB_TARGET_ARCH_BITS}, $v{DEB_TARGET_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_TARGET_ARCH}) + if (action_needs(DEB_TARGET | DEB_ARCH_ATTR)); + +$v{DEB_TARGET_MULTIARCH} = debarch_to_multiarch($v{DEB_TARGET_ARCH}) + if (action_needs(DEB_TARGET | DEB_MULTIARCH)); + +if (action_needs(DEB_TARGET | DEB_GNU_INFO)) { + if ($req_target_gnu_type eq '') { + $v{DEB_TARGET_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_TARGET_ARCH}); + } else { + $v{DEB_TARGET_GNU_TYPE} = $req_target_gnu_type; + } + ($v{DEB_TARGET_GNU_CPU}, $v{DEB_TARGET_GNU_SYSTEM}) = split(/-/, $v{DEB_TARGET_GNU_TYPE}, 2); +} + + +for my $k (keys %arch_vars) { + $v{$k} = $ENV{$k} if (length $ENV{$k} && !$force); +} + +if ($action eq 'list') { + foreach my $k (sort keys %arch_vars) { + print "$k=$v{$k}\n"; + } +} elsif ($action eq 'print-set') { + foreach my $k (sort keys %arch_vars) { + print "$k=$v{$k}; "; + } + print 'export ' . join(' ', sort keys %arch_vars) . "\n"; +} elsif ($action eq 'print-unset') { + print 'unset ' . join(' ', sort keys %arch_vars) . "\n"; +} elsif ($action eq 'equal') { + exit !debarch_eq($v{DEB_HOST_ARCH}, $req_eq_arch); +} elsif ($action eq 'is') { + exit !debarch_is($v{DEB_HOST_ARCH}, $req_is_arch); +} elsif ($action eq 'command') { + @ENV{keys %v} = values %v; + exec @ARGV; +} elsif ($action eq 'query') { + print "$v{$req_variable_to_print}\n"; +} elsif ($action eq 'list-known') { + foreach my $arch (get_valid_arches()) { + my ($bits, $endian) = debarch_to_abiattrs($arch); + + next if $req_match_endian and $endian ne $req_match_endian; + next if $req_match_bits and $bits ne $req_match_bits; + next if $req_match_wildcard and not debarch_is($arch, $req_match_wildcard); + + print "$arch\n"; + } +} |