summaryrefslogtreecommitdiffstats
path: root/scripts/dpkg-architecture.pl
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-06 00:45:20 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-06 00:45:20 +0000
commit9a08cbfcc1ef900a04580f35afe2a4592d7d6030 (patch)
tree004cc7027bca2f2c0bcb5806527c8e0c48df2d6e /scripts/dpkg-architecture.pl
parentInitial commit. (diff)
downloaddpkg-9a08cbfcc1ef900a04580f35afe2a4592d7d6030.tar.xz
dpkg-9a08cbfcc1ef900a04580f35afe2a4592d7d6030.zip
Adding upstream version 1.19.8.upstream/1.19.8upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'scripts/dpkg-architecture.pl')
-rwxr-xr-xscripts/dpkg-architecture.pl360
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";
+ }
+}