1#!/usr/bin/perl 2# 3# dpkg-buildflags 4# 5# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org> 6# Copyright © 2012-2013 Guillem Jover <guillem@debian.org> 7# 8# This program is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 2 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program. If not, see <https://www.gnu.org/licenses/>. 20 21use strict; 22use warnings; 23 24use Dpkg (); 25use Dpkg::Gettext; 26use Dpkg::ErrorHandling qw(:DEFAULT report REPORT_STATUS); 27use Dpkg::Build::Env; 28use Dpkg::BuildFlags; 29use Dpkg::Vendor qw(get_current_vendor); 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 [<command>]') 45 . "\n\n" . g_( 46'Commands: 47 --get <flag> output the requested flag to stdout. 48 --origin <flag> output the origin of the flag to stdout: 49 value is one of vendor, system, user, env. 50 --status output a synopsis with all parameters affecting the 51 program behaviour, the resulting flags and their origin. 52 --query like --status, but in deb822 format. 53 --query-features <area> 54 output the status of features for the given area. 55 --list output a list of the flags supported by the current vendor. 56 --export=(sh|make|cmdline|configure) 57 output something convenient to import the compilation 58 flags in a shell script, in make, or in a command line. 59 --dump output all compilation flags with their values. 60 --help show this help message. 61 --version show the version. 62'), $Dpkg::PROGNAME; 63} 64 65my ($param, $action); 66my $load_config = 1; 67 68while (@ARGV) { 69 $_ = shift(@ARGV); 70 if (m/^--(get|origin|query-features)$/) { 71 usageerr(g_('two commands specified: --%s and --%s'), $1, $action) 72 if defined($action); 73 $action = $1; 74 $param = shift(@ARGV); 75 usageerr(g_('%s needs a parameter'), $_) unless defined $param; 76 } elsif (m/^--export(?:=(sh|make|cmdline|configure))?$/) { 77 usageerr(g_('two commands specified: --%s and --%s'), 'export', $action) 78 if defined($action); 79 my $type = $1 || 'sh'; 80 # Map legacy aliases. 81 $type = 'cmdline' if $type eq 'configure'; 82 $action = "export-$type"; 83 } elsif (m/^--(list|status|dump|query)$/) { 84 usageerr(g_('two commands specified: --%s and --%s'), $1, $action) 85 if defined($action); 86 $action = $1; 87 $load_config = 0 if $action eq 'list'; 88 } elsif (m/^-(?:\?|-help)$/) { 89 usage(); 90 exit 0; 91 } elsif (m/^--version$/) { 92 version(); 93 exit 0; 94 } else { 95 usageerr(g_("unknown option '%s'"), $_); 96 } 97} 98 99$action //= 'dump'; 100 101my $build_flags = Dpkg::BuildFlags->new(); 102 103$build_flags->load_config() if $load_config; 104 105if ($action eq 'list') { 106 foreach my $flag ($build_flags->list()) { 107 print "$flag\n"; 108 } 109} elsif ($action eq 'get') { 110 exit 1 unless $build_flags->has($param); 111 112 print $build_flags->get($param) . "\n"; 113} elsif ($action eq 'origin') { 114 exit 1 unless $build_flags->has($param); 115 116 print $build_flags->get_origin($param) . "\n"; 117} elsif ($action eq 'query-features') { 118 exit 1 unless $build_flags->has_features($param); 119 120 my %features = $build_flags->get_features($param); 121 my $para_shown = 0; 122 foreach my $feature (sort keys %features) { 123 print $para_shown++ ? "\n" : ''; 124 printf "Feature: %s\n", $feature; 125 printf "Enabled: %s\n", $features{$feature} ? 'yes' : 'no'; 126 } 127} elsif ($action =~ m/^export-(.*)$/) { 128 my $export_type = $1; 129 foreach my $flag ($build_flags->list()) { 130 next unless $flag =~ /^[A-Z]/; # Skip flags starting with lowercase 131 my $value = $build_flags->get($flag); 132 if ($export_type eq 'sh') { 133 $value =~ s/"/\"/g; 134 print "export $flag=\"$value\"\n"; 135 } elsif ($export_type eq 'make') { 136 $value =~ s/\$/\$\$/g; 137 print "export $flag := $value\n"; 138 } elsif ($export_type eq 'cmdline') { 139 print "$flag=\"$value\" "; 140 } 141 } 142} elsif ($action eq 'dump') { 143 foreach my $flag ($build_flags->list()) { 144 my $value = $build_flags->get($flag); 145 print "$flag=$value\n"; 146 } 147} elsif ($action eq 'query') { 148 # First print all environment variables that might have changed the 149 # results (only existing ones, might make sense to add an option to 150 # also show which ones could have set to modify it). 151 printf "Vendor: %s\n", Dpkg::Vendor::get_current_vendor() || 'undefined'; 152 print "Environment:\n"; 153 for my $envvar (Dpkg::Build::Env::list_accessed()) { 154 print " $envvar=$ENV{$envvar}\n" if exists $ENV{$envvar}; 155 } 156 157 # Then the resulting features: 158 foreach my $area (sort $build_flags->get_feature_areas()) { 159 print "\n"; 160 print "Area: $area\n"; 161 print "Features:\n"; 162 my %features = $build_flags->get_features($area); 163 foreach my $feature (sort keys %features) { 164 printf " %s=%s\n", $feature, $features{$feature} ? 'yes' : 'no'; 165 } 166 } 167 168 # Then the resulting values (with their origin): 169 foreach my $flag ($build_flags->list()) { 170 print "\n"; 171 print "Flag: $flag\n"; 172 printf "Value: %s\n", $build_flags->get($flag); 173 my $origin = $build_flags->get_origin($flag); 174 if ($build_flags->is_maintainer_modified($flag)) { 175 $origin .= '+maintainer'; 176 } 177 print "Origin: $origin\n"; 178 } 179} elsif ($action eq 'status') { 180 # Prefix everything with "dpkg-buildflags: status: " to allow easy 181 # extraction from a build log. Thus we use report with a non-translated 182 # type string. 183 184 # First print all environment variables that might have changed the 185 # results (only existing ones, might make sense to add an option to 186 # also show which ones could have set to modify it). 187 my @envvars = Dpkg::Build::Env::list_accessed(); 188 for my $envvar (@envvars) { 189 if (exists $ENV{$envvar}) { 190 printf report(REPORT_STATUS, 'environment variable %s=%s', 191 $envvar, $ENV{$envvar}); 192 } 193 } 194 my $vendor = Dpkg::Vendor::get_current_vendor() || 'undefined'; 195 print report(REPORT_STATUS, "vendor is $vendor"); 196 # Then the resulting features: 197 foreach my $area (sort $build_flags->get_feature_areas()) { 198 my $fs; 199 my %features = $build_flags->get_features($area); 200 foreach my $feature (sort keys %features) { 201 $fs .= sprintf(' %s=%s', $feature, $features{$feature} ? 'yes' : 'no'); 202 } 203 print report(REPORT_STATUS, "$area features:$fs"); 204 } 205 # Then the resulting values (with their origin): 206 foreach my $flag ($build_flags->list()) { 207 my $value = $build_flags->get($flag); 208 my $origin = $build_flags->get_origin($flag); 209 my $maintainer = $build_flags->is_maintainer_modified($flag) ? '+maintainer' : ''; 210 print report(REPORT_STATUS, "$flag [$origin$maintainer]: $value"); 211 } 212} 213