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