File: | dpkg-architecture.pl |
Coverage: | 42.3% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | |||||||
22 | 1 1 1 | 1618 0 14 | use strict; | ||||
23 | 1 1 1 | 2 1 16 | use warnings; | ||||
24 | |||||||
25 | 1 1 1 | 110 1 10 | use Dpkg (); | ||||
26 | 1 1 1 | 117 1 24 | use Dpkg::Gettext; | ||||
27 | 1 1 1 | 120 1 19 | use Dpkg::Getopt; | ||||
28 | 1 1 1 | 115 1 31 | use Dpkg::ErrorHandling; | ||||
29 | 1 1 1 | 130 1 235 | use Dpkg::Arch qw(:getters :mappers debarch_eq debarch_is); | ||||
30 | |||||||
31 | 1 | 26658 | textdomain('dpkg-dev'); | ||||
32 | |||||||
33 | sub version { | ||||||
34 | 0 | 0 | printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; | ||||
35 | |||||||
36 | 0 | 0 | printf g_(' | ||||
37 | This is free software; see the GNU General Public License version 2 or | ||||||
38 | later for copying conditions. There is NO warranty. | ||||||
39 | '); | ||||||
40 | } | ||||||
41 | |||||||
42 | sub usage { | ||||||
43 | 0 | 0 | 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 | --print-format <format> | ||||||
70 | use <format> for --print-set and --print-unset, | ||||||
71 | allowed values: shell (default), make. | ||||||
72 | -f, --force force flag (override variables set in environment).') | ||||||
73 | . "\n", $Dpkg::PROGNAME; | ||||||
74 | } | ||||||
75 | |||||||
76 | sub check_arch_coherency | ||||||
77 | { | ||||||
78 | 2 | 8 | my ($arch, $gnu_type) = @_; | ||||
79 | |||||||
80 | 2 | 3 | if ($arch ne '' && $gnu_type eq '') { | ||||
81 | 0 | 0 | $gnu_type = debarch_to_gnutriplet($arch); | ||||
82 | 0 | 0 | error(g_('unknown Debian architecture %s, you must specify ' . | ||||
83 | 'GNU system type, too'), $arch) | ||||||
84 | unless defined $gnu_type; | ||||||
85 | } | ||||||
86 | |||||||
87 | 2 | 3 | if ($gnu_type ne '' && $arch eq '') { | ||||
88 | 0 | 0 | $arch = gnutriplet_to_debarch($gnu_type); | ||||
89 | 0 | 0 | error(g_('unknown GNU system type %s, you must specify ' . | ||||
90 | 'Debian architecture, too'), $gnu_type) | ||||||
91 | unless defined $arch; | ||||||
92 | } | ||||||
93 | |||||||
94 | 2 | 2 | if ($gnu_type ne '' && $arch ne '') { | ||||
95 | 0 | 0 | my $dfl_gnu_type = debarch_to_gnutriplet($arch); | ||||
96 | 0 | 0 | error(g_('unknown default GNU system type for Debian architecture %s'), | ||||
97 | $arch) | ||||||
98 | unless defined $dfl_gnu_type; | ||||||
99 | 0 | 0 | warning(g_('default GNU system type %s for Debian arch %s does not ' . | ||||
100 | 'match specified GNU system type %s'), $dfl_gnu_type, | ||||||
101 | $arch, $gnu_type) | ||||||
102 | if $dfl_gnu_type ne $gnu_type; | ||||||
103 | } | ||||||
104 | |||||||
105 | 2 | 5 | return ($arch, $gnu_type); | ||||
106 | } | ||||||
107 | |||||||
108 | use constant { | ||||||
109 | 1 | 572 | DEB_NONE => 0, | ||||
110 | |||||||
111 | DEB_BUILD_INFO => 0b00001, | ||||||
112 | DEB_BUILD_ARCH_INFO => 0b00010, | ||||||
113 | DEB_BUILD_ARCH_ATTR => 0b00100, | ||||||
114 | DEB_BUILD_MULTIARCH_INFO => 0b01000, | ||||||
115 | DEB_BUILD_GNU_INFO => 0b10000, | ||||||
116 | DEB_BUILD_ANY => 0b11111, | ||||||
117 | |||||||
118 | DEB_HOST_INFO => 0b0000100000, | ||||||
119 | DEB_HOST_ARCH_INFO => 0b0001000000, | ||||||
120 | DEB_HOST_ARCH_ATTR => 0b0010000000, | ||||||
121 | DEB_HOST_MULTIARCH_INFO => 0b0100000000, | ||||||
122 | DEB_HOST_GNU_INFO => 0b1000000000, | ||||||
123 | DEB_HOST_ANY => 0b1111100000, | ||||||
124 | |||||||
125 | DEB_TARGET_INFO => 0b000010000000000, | ||||||
126 | DEB_TARGET_ARCH_INFO => 0b000100000000000, | ||||||
127 | DEB_TARGET_ARCH_ATTR => 0b001000000000000, | ||||||
128 | DEB_TARGET_MULTIARCH_INFO => 0b010000000000000, | ||||||
129 | DEB_TARGET_GNU_INFO => 0b100000000000000, | ||||||
130 | DEB_TARGET_ANY => 0b111110000000000, | ||||||
131 | |||||||
132 | DEB_ALL => 0b111111111111111, | ||||||
133 | 1 1 | 3 1 | }; | ||||
134 | |||||||
135 | 1 | 2 | my %arch_deps = ( | ||||
136 | DEB_BUILD_ANY+0 => DEB_BUILD_INFO, | ||||||
137 | DEB_HOST_ANY+0 => DEB_HOST_INFO, | ||||||
138 | DEB_TARGET_ANY+0 => DEB_TARGET_INFO, | ||||||
139 | ); | ||||||
140 | |||||||
141 | 1 | 10 | my %arch_vars = ( | ||||
142 | DEB_BUILD_ARCH => DEB_BUILD_INFO, | ||||||
143 | DEB_BUILD_ARCH_ABI => DEB_BUILD_ARCH_INFO, | ||||||
144 | DEB_BUILD_ARCH_LIBC => DEB_BUILD_ARCH_INFO, | ||||||
145 | DEB_BUILD_ARCH_OS => DEB_BUILD_ARCH_INFO, | ||||||
146 | DEB_BUILD_ARCH_CPU => DEB_BUILD_ARCH_INFO, | ||||||
147 | DEB_BUILD_ARCH_BITS => DEB_BUILD_ARCH_ATTR, | ||||||
148 | DEB_BUILD_ARCH_ENDIAN => DEB_BUILD_ARCH_ATTR, | ||||||
149 | DEB_BUILD_MULTIARCH => DEB_BUILD_MULTIARCH_INFO, | ||||||
150 | DEB_BUILD_GNU_CPU => DEB_BUILD_GNU_INFO, | ||||||
151 | DEB_BUILD_GNU_SYSTEM => DEB_BUILD_GNU_INFO, | ||||||
152 | DEB_BUILD_GNU_TYPE => DEB_BUILD_GNU_INFO, | ||||||
153 | DEB_HOST_ARCH => DEB_HOST_INFO, | ||||||
154 | DEB_HOST_ARCH_ABI => DEB_HOST_ARCH_INFO, | ||||||
155 | DEB_HOST_ARCH_LIBC => DEB_HOST_ARCH_INFO, | ||||||
156 | DEB_HOST_ARCH_OS => DEB_HOST_ARCH_INFO, | ||||||
157 | DEB_HOST_ARCH_CPU => DEB_HOST_ARCH_INFO, | ||||||
158 | DEB_HOST_ARCH_BITS => DEB_HOST_ARCH_ATTR, | ||||||
159 | DEB_HOST_ARCH_ENDIAN => DEB_HOST_ARCH_ATTR, | ||||||
160 | DEB_HOST_MULTIARCH => DEB_HOST_MULTIARCH_INFO, | ||||||
161 | DEB_HOST_GNU_CPU => DEB_HOST_GNU_INFO, | ||||||
162 | DEB_HOST_GNU_SYSTEM => DEB_HOST_GNU_INFO, | ||||||
163 | DEB_HOST_GNU_TYPE => DEB_HOST_GNU_INFO, | ||||||
164 | DEB_TARGET_ARCH => DEB_TARGET_INFO, | ||||||
165 | DEB_TARGET_ARCH_ABI => DEB_TARGET_ARCH_INFO, | ||||||
166 | DEB_TARGET_ARCH_LIBC => DEB_TARGET_ARCH_INFO, | ||||||
167 | DEB_TARGET_ARCH_OS => DEB_TARGET_ARCH_INFO, | ||||||
168 | DEB_TARGET_ARCH_CPU => DEB_TARGET_ARCH_INFO, | ||||||
169 | DEB_TARGET_ARCH_BITS => DEB_TARGET_ARCH_ATTR, | ||||||
170 | DEB_TARGET_ARCH_ENDIAN => DEB_TARGET_ARCH_ATTR, | ||||||
171 | DEB_TARGET_MULTIARCH => DEB_TARGET_MULTIARCH_INFO, | ||||||
172 | DEB_TARGET_GNU_CPU => DEB_TARGET_GNU_INFO, | ||||||
173 | DEB_TARGET_GNU_SYSTEM => DEB_TARGET_GNU_INFO, | ||||||
174 | DEB_TARGET_GNU_TYPE => DEB_TARGET_GNU_INFO, | ||||||
175 | ); | ||||||
176 | |||||||
177 | 1 2 | 2 3 | my %known_print_format = map { $_ => 1 } qw(shell make); | ||||
178 | 1 | 1 | my $print_format = 'shell'; | ||||
179 | |||||||
180 | 1 | 1 | my $req_vars = DEB_ALL; | ||||
181 | 1 | 1 | my $req_host_arch = ''; | ||||
182 | 1 | 0 | my $req_host_gnu_type = ''; | ||||
183 | 1 | 1 | my $req_target_arch = ''; | ||||
184 | 1 | 1 | my $req_target_gnu_type = ''; | ||||
185 | 1 | 1 | my $req_eq_arch = ''; | ||||
186 | 1 | 1 | my $req_is_arch = ''; | ||||
187 | 1 | 0 | my $req_match_wildcard = ''; | ||||
188 | 1 | 2 | my $req_match_bits = ''; | ||||
189 | 1 | 0 | my $req_match_endian = ''; | ||||
190 | 1 | 1 | my $req_variable_to_print; | ||||
191 | 1 | 0 | my $action = 'list'; | ||||
192 | 1 | 1 | my $force = 0; | ||||
193 | |||||||
194 | sub action_needs($) { | ||||||
195 | 15 | 13 | my $bits = shift; | ||||
196 | 15 | 46 | return (($req_vars & $bits) == $bits); | ||||
197 | } | ||||||
198 | |||||||
199 | 1 | 2 | @ARGV = normalize_options(args => \@ARGV, delim => '-c'); | ||||
200 | |||||||
201 | 1 | 2 | while (@ARGV) { | ||||
202 | 1 | 1 | my $arg = shift; | ||||
203 | |||||||
204 | 1 | 19 | if ($arg eq '-a' or $arg eq '--host-arch') { | ||||
205 | 0 | 0 | $req_host_arch = shift; | ||||
206 | } elsif ($arg eq '-t' or $arg eq '--host-type') { | ||||||
207 | 0 | 0 | $req_host_gnu_type = shift; | ||||
208 | } elsif ($arg eq '-A' or $arg eq '--target-arch') { | ||||||
209 | 0 | 0 | $req_target_arch = shift; | ||||
210 | } elsif ($arg eq '-T' or $arg eq '--target-type') { | ||||||
211 | 0 | 0 | $req_target_gnu_type = shift; | ||||
212 | } elsif ($arg eq '-W' or $arg eq '--match-wildcard') { | ||||||
213 | 0 | 0 | $req_match_wildcard = shift; | ||||
214 | } elsif ($arg eq '-B' or $arg eq '--match-bits') { | ||||||
215 | 0 | 0 | $req_match_bits = shift; | ||||
216 | } elsif ($arg eq '-E' or $arg eq '--match-endian') { | ||||||
217 | 0 | 0 | $req_match_endian = shift; | ||||
218 | } elsif ($arg eq '-e' or $arg eq '--equal') { | ||||||
219 | 0 | 0 | $req_eq_arch = shift; | ||||
220 | 0 | 0 | $req_vars = $arch_vars{DEB_HOST_ARCH}; | ||||
221 | 0 | 0 | $action = 'equal'; | ||||
222 | } elsif ($arg eq '-i' or $arg eq '--is') { | ||||||
223 | 0 | 0 | $req_is_arch = shift; | ||||
224 | 0 | 0 | $req_vars = $arch_vars{DEB_HOST_ARCH}; | ||||
225 | 0 | 0 | $action = 'is'; | ||||
226 | } elsif ($arg eq '-u' or $arg eq '--print-unset') { | ||||||
227 | 0 | 0 | $req_vars = DEB_NONE; | ||||
228 | 0 | 0 | $action = 'print-unset'; | ||||
229 | } elsif ($arg eq '-l' or $arg eq '--list') { | ||||||
230 | 0 | 0 | $action = 'list'; | ||||
231 | } elsif ($arg eq '-s' or $arg eq '--print-set') { | ||||||
232 | 0 | 0 | $req_vars = DEB_ALL; | ||||
233 | 0 | 0 | $action = 'print-set'; | ||||
234 | } elsif ($arg eq '--print-format') { | ||||||
235 | 0 | 0 | $print_format = shift; | ||||
236 | error(g_('%s is not a supported print format'), $print_format) | ||||||
237 | 0 | 0 | unless exists $known_print_format{$print_format}; | ||||
238 | } elsif ($arg eq '-f' or $arg eq '--force') { | ||||||
239 | 1 | 2 | $force=1; | ||||
240 | } elsif ($arg eq '-q' or $arg eq '--query') { | ||||||
241 | 0 | 0 | my $varname = shift; | ||||
242 | error(g_('%s is not a supported variable name'), $varname) | ||||||
243 | 0 | 0 | unless (exists $arch_vars{$varname}); | ||||
244 | 0 | 0 | $req_variable_to_print = "$varname"; | ||||
245 | 0 | 0 | $req_vars = $arch_vars{$varname}; | ||||
246 | 0 | 0 | $action = 'query'; | ||||
247 | } elsif ($arg eq '-c' or $arg eq '--command') { | ||||||
248 | 0 | 0 | $action = 'command'; | ||||
249 | 0 | 0 | last; | ||||
250 | } elsif ($arg eq '-L' or $arg eq '--list-known') { | ||||||
251 | 0 | 0 | $req_vars = 0; | ||||
252 | 0 | 0 | $action = 'list-known'; | ||||
253 | } elsif ($arg eq '-?' or $arg eq '--help') { | ||||||
254 | 0 | 0 | usage(); | ||||
255 | 0 | 0 | exit 0; | ||||
256 | } elsif ($arg eq '--version') { | ||||||
257 | 0 | 0 | version(); | ||||
258 | 0 | 0 | exit 0; | ||||
259 | } else { | ||||||
260 | 0 | 0 | usageerr(g_("unknown option '%s'"), $arg); | ||||
261 | } | ||||||
262 | } | ||||||
263 | |||||||
264 | # Handle variable dependencies | ||||||
265 | 1 | 1 | foreach my $k (keys %arch_deps) { | ||||
266 | 3 | 6 | if ($req_vars & $k) { | ||||
267 | 3 | 3 | $req_vars |= $arch_deps{$k}; | ||||
268 | } | ||||||
269 | } | ||||||
270 | |||||||
271 | 1 | 1 | my %v; | ||||
272 | |||||||
273 | 1 | 2 | foreach my $k (keys %arch_vars) { | ||||
274 | 33 | 26 | next if not length $ENV{$k} or $force; | ||||
275 | 0 | 0 | $v{$k} = $ENV{$k}; | ||||
276 | 0 | 0 | $req_vars &= ~$arch_vars{$k}; | ||||
277 | } | ||||||
278 | |||||||
279 | # | ||||||
280 | # Set build variables | ||||||
281 | # | ||||||
282 | |||||||
283 | 1 | 2 | $v{DEB_BUILD_ARCH} = get_raw_build_arch() | ||||
284 | if (action_needs(DEB_BUILD_INFO)); | ||||||
285 | ($v{DEB_BUILD_ARCH_ABI}, $v{DEB_BUILD_ARCH_LIBC}, | ||||||
286 | $v{DEB_BUILD_ARCH_OS}, $v{DEB_BUILD_ARCH_CPU}) = debarch_to_debtuple($v{DEB_BUILD_ARCH}) | ||||||
287 | 1 | 10 | if (action_needs(DEB_BUILD_ARCH_INFO)); | ||||
288 | ($v{DEB_BUILD_ARCH_BITS}, $v{DEB_BUILD_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_BUILD_ARCH}) | ||||||
289 | 1 | 2 | if (action_needs(DEB_BUILD_ARCH_ATTR)); | ||||
290 | |||||||
291 | $v{DEB_BUILD_MULTIARCH} = debarch_to_multiarch($v{DEB_BUILD_ARCH}) | ||||||
292 | 1 | 1 | if (action_needs(DEB_BUILD_MULTIARCH_INFO)); | ||||
293 | |||||||
294 | 1 | 1 | if (action_needs(DEB_BUILD_GNU_INFO)) { | ||||
295 | 1 | 2 | $v{DEB_BUILD_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_BUILD_ARCH}); | ||||
296 | 1 | 3 | ($v{DEB_BUILD_GNU_CPU}, $v{DEB_BUILD_GNU_SYSTEM}) = split(/-/, $v{DEB_BUILD_GNU_TYPE}, 2); | ||||
297 | } | ||||||
298 | |||||||
299 | # | ||||||
300 | # Set host variables | ||||||
301 | # | ||||||
302 | |||||||
303 | # First perform some sanity checks on the host arguments passed. | ||||||
304 | |||||||
305 | 1 | 2 | ($req_host_arch, $req_host_gnu_type) = check_arch_coherency($req_host_arch, $req_host_gnu_type); | ||||
306 | |||||||
307 | # Proceed to compute the host variables if needed. | ||||||
308 | |||||||
309 | 1 | 1 | $v{DEB_HOST_ARCH} = $req_host_arch || get_raw_host_arch() | ||||
310 | if (action_needs(DEB_HOST_INFO)); | ||||||
311 | ($v{DEB_HOST_ARCH_ABI}, $v{DEB_HOST_ARCH_LIBC}, | ||||||
312 | $v{DEB_HOST_ARCH_OS}, $v{DEB_HOST_ARCH_CPU}) = debarch_to_debtuple($v{DEB_HOST_ARCH}) | ||||||
313 | 1 | 7 | if (action_needs(DEB_HOST_ARCH_INFO)); | ||||
314 | ($v{DEB_HOST_ARCH_BITS}, $v{DEB_HOST_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_HOST_ARCH}) | ||||||
315 | 1 | 2 | if (action_needs(DEB_HOST_ARCH_ATTR)); | ||||
316 | |||||||
317 | $v{DEB_HOST_MULTIARCH} = debarch_to_multiarch($v{DEB_HOST_ARCH}) | ||||||
318 | 1 | 1 | if (action_needs(DEB_HOST_MULTIARCH_INFO)); | ||||
319 | |||||||
320 | 1 | 14 | if (action_needs(DEB_HOST_GNU_INFO)) { | ||||
321 | 1 | 2 | if ($req_host_gnu_type eq '') { | ||||
322 | 1 | 1 | $v{DEB_HOST_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_HOST_ARCH}); | ||||
323 | } else { | ||||||
324 | 0 | 0 | $v{DEB_HOST_GNU_TYPE} = $req_host_gnu_type; | ||||
325 | } | ||||||
326 | 1 | 4 | ($v{DEB_HOST_GNU_CPU}, $v{DEB_HOST_GNU_SYSTEM}) = split(/-/, $v{DEB_HOST_GNU_TYPE}, 2); | ||||
327 | |||||||
328 | 1 | 1 | my $host_gnu_type = get_host_gnu_type(); | ||||
329 | |||||||
330 | warning(g_('specified GNU system type %s does not match CC system ' . | ||||||
331 | 'type %s, try setting a correct CC environment variable'), | ||||||
332 | $v{DEB_HOST_GNU_TYPE}, $host_gnu_type) | ||||||
333 | 1 | 8 | if ($host_gnu_type ne '') && ($host_gnu_type ne $v{DEB_HOST_GNU_TYPE}); | ||||
334 | } | ||||||
335 | |||||||
336 | # | ||||||
337 | # Set target variables | ||||||
338 | # | ||||||
339 | |||||||
340 | # First perform some sanity checks on the target arguments passed. | ||||||
341 | |||||||
342 | 1 | 2 | ($req_target_arch, $req_target_gnu_type) = check_arch_coherency($req_target_arch, $req_target_gnu_type); | ||||
343 | |||||||
344 | # Proceed to compute the target variables if needed. | ||||||
345 | |||||||
346 | 1 | 1 | $v{DEB_TARGET_ARCH} = $req_target_arch || $v{DEB_HOST_ARCH} || $req_host_arch || get_raw_host_arch() | ||||
347 | if (action_needs(DEB_TARGET_INFO)); | ||||||
348 | ($v{DEB_TARGET_ARCH_ABI}, $v{DEB_TARGET_ARCH_LIBC}, | ||||||
349 | $v{DEB_TARGET_ARCH_OS}, $v{DEB_TARGET_ARCH_CPU}) = debarch_to_debtuple($v{DEB_TARGET_ARCH}) | ||||||
350 | 1 | 1 | if (action_needs(DEB_TARGET_ARCH_INFO)); | ||||
351 | ($v{DEB_TARGET_ARCH_BITS}, $v{DEB_TARGET_ARCH_ENDIAN}) = debarch_to_abiattrs($v{DEB_TARGET_ARCH}) | ||||||
352 | 1 | 1 | if (action_needs(DEB_TARGET_ARCH_ATTR)); | ||||
353 | |||||||
354 | $v{DEB_TARGET_MULTIARCH} = debarch_to_multiarch($v{DEB_TARGET_ARCH}) | ||||||
355 | 1 | 1 | if (action_needs(DEB_TARGET_MULTIARCH_INFO)); | ||||
356 | |||||||
357 | 1 | 2 | if (action_needs(DEB_TARGET_GNU_INFO)) { | ||||
358 | 1 | 1 | if ($req_target_gnu_type eq '') { | ||||
359 | 1 | 1 | $v{DEB_TARGET_GNU_TYPE} = debarch_to_gnutriplet($v{DEB_TARGET_ARCH}); | ||||
360 | } else { | ||||||
361 | 0 | 0 | $v{DEB_TARGET_GNU_TYPE} = $req_target_gnu_type; | ||||
362 | } | ||||||
363 | 1 | 2 | ($v{DEB_TARGET_GNU_CPU}, $v{DEB_TARGET_GNU_SYSTEM}) = split(/-/, $v{DEB_TARGET_GNU_TYPE}, 2); | ||||
364 | } | ||||||
365 | |||||||
366 | |||||||
367 | 1 | 1 | if ($action eq 'list') { | ||||
368 | 1 | 16 | foreach my $k (sort keys %arch_vars) { | ||||
369 | 33 | 24 | print "$k=$v{$k}\n"; | ||||
370 | } | ||||||
371 | } elsif ($action eq 'print-set') { | ||||||
372 | 0 | 0 | if ($print_format eq 'shell') { | ||||
373 | 0 | 0 | foreach my $k (sort keys %arch_vars) { | ||||
374 | 0 | 0 | print "$k=$v{$k}; "; | ||||
375 | } | ||||||
376 | 0 | 0 | print 'export ' . join(' ', sort keys %arch_vars) . "\n"; | ||||
377 | } elsif ($print_format eq 'make') { | ||||||
378 | 0 | 0 | foreach my $k (sort keys %arch_vars) { | ||||
379 | 0 | 0 | print "export $k = $v{$k}\n"; | ||||
380 | } | ||||||
381 | } | ||||||
382 | } elsif ($action eq 'print-unset') { | ||||||
383 | 0 | 0 | if ($print_format eq 'shell') { | ||||
384 | 0 | 0 | print 'unset ' . join(' ', sort keys %arch_vars) . "\n"; | ||||
385 | } elsif ($print_format eq 'make') { | ||||||
386 | 0 | 0 | foreach my $k (sort keys %arch_vars) { | ||||
387 | 0 | 0 | print "undefine $k\n"; | ||||
388 | } | ||||||
389 | } | ||||||
390 | } elsif ($action eq 'equal') { | ||||||
391 | 0 | 0 | exit !debarch_eq($v{DEB_HOST_ARCH}, $req_eq_arch); | ||||
392 | } elsif ($action eq 'is') { | ||||||
393 | 0 | 0 | exit !debarch_is($v{DEB_HOST_ARCH}, $req_is_arch); | ||||
394 | } elsif ($action eq 'command') { | ||||||
395 | 0 | 0 | @ENV{keys %v} = values %v; | ||||
396 | ## no critic (TestingAndDebugging::ProhibitNoWarnings) | ||||||
397 | 1 1 1 | 3 6 765 | no warnings qw(exec); | ||||
398 | 0 | 0 | exec @ARGV or syserr(g_('unable to execute %s'), "@ARGV"); | ||||
399 | } elsif ($action eq 'query') { | ||||||
400 | 0 | 0 | print "$v{$req_variable_to_print}\n"; | ||||
401 | } elsif ($action eq 'list-known') { | ||||||
402 | 0 | 0 | foreach my $arch (get_valid_arches()) { | ||||
403 | 0 | 0 | my ($bits, $endian) = debarch_to_abiattrs($arch); | ||||
404 | |||||||
405 | 0 | 0 | next if $req_match_endian and $endian ne $req_match_endian; | ||||
406 | 0 | 0 | next if $req_match_bits and $bits ne $req_match_bits; | ||||
407 | 0 | 0 | next if $req_match_wildcard and not debarch_is($arch, $req_match_wildcard); | ||||
408 | |||||||
409 | 0 | 0 | print "$arch\n"; | ||||
410 | } | ||||||
411 | } |