1# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org> 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <https://www.gnu.org/licenses/>. 15 16package Dpkg::BuildFlags; 17 18use strict; 19use warnings; 20 21our $VERSION = '1.03'; 22 23use Dpkg (); 24use Dpkg::Gettext; 25use Dpkg::Build::Env; 26use Dpkg::ErrorHandling; 27use Dpkg::Vendor qw(run_vendor_hook); 28 29=encoding utf8 30 31=head1 NAME 32 33Dpkg::BuildFlags - query build flags 34 35=head1 DESCRIPTION 36 37The Dpkg::BuildFlags object is used by dpkg-buildflags and can be used 38to query the same information. 39 40=head1 METHODS 41 42=over 4 43 44=item $bf = Dpkg::BuildFlags->new() 45 46Create a new Dpkg::BuildFlags object. It will be initialized based 47on the value of several configuration files and environment variables. 48 49=cut 50 51sub new { 52 my ($this, %opts) = @_; 53 my $class = ref($this) || $this; 54 55 my $self = { 56 }; 57 bless $self, $class; 58 $self->load_vendor_defaults(); 59 return $self; 60} 61 62=item $bf->load_vendor_defaults() 63 64Reset the flags stored to the default set provided by the vendor. 65 66=cut 67 68sub load_vendor_defaults { 69 my $self = shift; 70 71 $self->{options} = {}; 72 $self->{source} = {}; 73 $self->{features} = {}; 74 $self->{flags} = { 75 CPPFLAGS => '', 76 CFLAGS => '', 77 CXXFLAGS => '', 78 OBJCFLAGS => '', 79 OBJCXXFLAGS => '', 80 GCJFLAGS => '', 81 FFLAGS => '', 82 FCFLAGS => '', 83 LDFLAGS => '', 84 }; 85 $self->{origin} = { 86 CPPFLAGS => 'vendor', 87 CFLAGS => 'vendor', 88 CXXFLAGS => 'vendor', 89 OBJCFLAGS => 'vendor', 90 OBJCXXFLAGS => 'vendor', 91 GCJFLAGS => 'vendor', 92 FFLAGS => 'vendor', 93 FCFLAGS => 'vendor', 94 LDFLAGS => 'vendor', 95 }; 96 $self->{maintainer} = { 97 CPPFLAGS => 0, 98 CFLAGS => 0, 99 CXXFLAGS => 0, 100 OBJCFLAGS => 0, 101 OBJCXXFLAGS => 0, 102 GCJFLAGS => 0, 103 FFLAGS => 0, 104 FCFLAGS => 0, 105 LDFLAGS => 0, 106 }; 107 # The vendor hook will add the feature areas build flags. 108 run_vendor_hook('update-buildflags', $self); 109} 110 111=item $bf->load_system_config() 112 113Update flags from the system configuration. 114 115=cut 116 117sub load_system_config { 118 my $self = shift; 119 120 $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system'); 121} 122 123=item $bf->load_user_config() 124 125Update flags from the user configuration. 126 127=cut 128 129sub load_user_config { 130 my $self = shift; 131 132 my $confdir = $ENV{XDG_CONFIG_HOME}; 133 $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME}; 134 if (length $confdir) { 135 $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user'); 136 } 137} 138 139=item $bf->load_environment_config() 140 141Update flags based on user directives stored in the environment. See 142dpkg-buildflags(1) for details. 143 144=cut 145 146sub load_environment_config { 147 my $self = shift; 148 149 foreach my $flag (keys %{$self->{flags}}) { 150 my $envvar = 'DEB_' . $flag . '_SET'; 151 if (Dpkg::Build::Env::has($envvar)) { 152 $self->set($flag, Dpkg::Build::Env::get($envvar), 'env'); 153 } 154 $envvar = 'DEB_' . $flag . '_STRIP'; 155 if (Dpkg::Build::Env::has($envvar)) { 156 $self->strip($flag, Dpkg::Build::Env::get($envvar), 'env'); 157 } 158 $envvar = 'DEB_' . $flag . '_APPEND'; 159 if (Dpkg::Build::Env::has($envvar)) { 160 $self->append($flag, Dpkg::Build::Env::get($envvar), 'env'); 161 } 162 $envvar = 'DEB_' . $flag . '_PREPEND'; 163 if (Dpkg::Build::Env::has($envvar)) { 164 $self->prepend($flag, Dpkg::Build::Env::get($envvar), 'env'); 165 } 166 } 167} 168 169=item $bf->load_maintainer_config() 170 171Update flags based on maintainer directives stored in the environment. See 172dpkg-buildflags(1) for details. 173 174=cut 175 176sub load_maintainer_config { 177 my $self = shift; 178 179 foreach my $flag (keys %{$self->{flags}}) { 180 my $envvar = 'DEB_' . $flag . '_MAINT_SET'; 181 if (Dpkg::Build::Env::has($envvar)) { 182 $self->set($flag, Dpkg::Build::Env::get($envvar), undef, 1); 183 } 184 $envvar = 'DEB_' . $flag . '_MAINT_STRIP'; 185 if (Dpkg::Build::Env::has($envvar)) { 186 $self->strip($flag, Dpkg::Build::Env::get($envvar), undef, 1); 187 } 188 $envvar = 'DEB_' . $flag . '_MAINT_APPEND'; 189 if (Dpkg::Build::Env::has($envvar)) { 190 $self->append($flag, Dpkg::Build::Env::get($envvar), undef, 1); 191 } 192 $envvar = 'DEB_' . $flag . '_MAINT_PREPEND'; 193 if (Dpkg::Build::Env::has($envvar)) { 194 $self->prepend($flag, Dpkg::Build::Env::get($envvar), undef, 1); 195 } 196 } 197} 198 199 200=item $bf->load_config() 201 202Call successively load_system_config(), load_user_config(), 203load_environment_config() and load_maintainer_config() to update the 204default build flags defined by the vendor. 205 206=cut 207 208sub load_config { 209 my $self = shift; 210 211 $self->load_system_config(); 212 $self->load_user_config(); 213 $self->load_environment_config(); 214 $self->load_maintainer_config(); 215} 216 217=item $bf->set($flag, $value, $source, $maint) 218 219Update the build flag $flag with value $value and record its origin as 220$source (if defined). Record it as maintainer modified if $maint is 221defined and true. 222 223=cut 224 225sub set { 226 my ($self, $flag, $value, $src, $maint) = @_; 227 $self->{flags}->{$flag} = $value; 228 $self->{origin}->{$flag} = $src if defined $src; 229 $self->{maintainer}->{$flag} = $maint if $maint; 230} 231 232=item $bf->set_feature($area, $feature, $enabled) 233 234Update the boolean state of whether a specific feature within a known 235feature area has been enabled. The only currently known feature areas 236are "future", "qa", "sanitize", "hardening" and "reproducible". 237 238=cut 239 240sub set_feature { 241 my ($self, $area, $feature, $enabled) = @_; 242 $self->{features}{$area}{$feature} = $enabled; 243} 244 245=item $bf->strip($flag, $value, $source, $maint) 246 247Update the build flag $flag by stripping the flags listed in $value and 248record its origin as $source (if defined). Record it as maintainer modified 249if $maint is defined and true. 250 251=cut 252 253sub strip { 254 my ($self, $flag, $value, $src, $maint) = @_; 255 foreach my $tostrip (split(/\s+/, $value)) { 256 next unless length $tostrip; 257 $self->{flags}->{$flag} =~ s/(^|\s+)\Q$tostrip\E(\s+|$)/ /g; 258 } 259 $self->{flags}->{$flag} =~ s/^\s+//g; 260 $self->{flags}->{$flag} =~ s/\s+$//g; 261 $self->{origin}->{$flag} = $src if defined $src; 262 $self->{maintainer}->{$flag} = $maint if $maint; 263} 264 265=item $bf->append($flag, $value, $source, $maint) 266 267Append the options listed in $value to the current value of the flag $flag. 268Record its origin as $source (if defined). Record it as maintainer modified 269if $maint is defined and true. 270 271=cut 272 273sub append { 274 my ($self, $flag, $value, $src, $maint) = @_; 275 if (length($self->{flags}->{$flag})) { 276 $self->{flags}->{$flag} .= " $value"; 277 } else { 278 $self->{flags}->{$flag} = $value; 279 } 280 $self->{origin}->{$flag} = $src if defined $src; 281 $self->{maintainer}->{$flag} = $maint if $maint; 282} 283 284=item $bf->prepend($flag, $value, $source, $maint) 285 286Prepend the options listed in $value to the current value of the flag $flag. 287Record its origin as $source (if defined). Record it as maintainer modified 288if $maint is defined and true. 289 290=cut 291 292sub prepend { 293 my ($self, $flag, $value, $src, $maint) = @_; 294 if (length($self->{flags}->{$flag})) { 295 $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag}; 296 } else { 297 $self->{flags}->{$flag} = $value; 298 } 299 $self->{origin}->{$flag} = $src if defined $src; 300 $self->{maintainer}->{$flag} = $maint if $maint; 301} 302 303 304=item $bf->update_from_conffile($file, $source) 305 306Update the current build flags based on the configuration directives 307contained in $file. See dpkg-buildflags(1) for the format of the directives. 308 309$source is the origin recorded for any build flag set or modified. 310 311=cut 312 313sub update_from_conffile { 314 my ($self, $file, $src) = @_; 315 local $_; 316 317 return unless -e $file; 318 open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file); 319 while (<$conf_fh>) { 320 chomp; 321 next if /^\s*#/; # Skip comments 322 next if /^\s*$/; # Skip empty lines 323 if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) { 324 my ($op, $flag, $value) = ($1, $2, $3); 325 unless (exists $self->{flags}->{$flag}) { 326 warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag); 327 $self->{flags}->{$flag} = ''; 328 } 329 if (lc($op) eq 'set') { 330 $self->set($flag, $value, $src); 331 } elsif (lc($op) eq 'strip') { 332 $self->strip($flag, $value, $src); 333 } elsif (lc($op) eq 'append') { 334 $self->append($flag, $value, $src); 335 } elsif (lc($op) eq 'prepend') { 336 $self->prepend($flag, $value, $src); 337 } 338 } else { 339 warning(g_('line %d of %s is invalid, it has been ignored'), $., $file); 340 } 341 } 342 close($conf_fh); 343} 344 345=item $bf->get($flag) 346 347Return the value associated to the flag. It might be undef if the 348flag doesn't exist. 349 350=cut 351 352sub get { 353 my ($self, $key) = @_; 354 return $self->{flags}{$key}; 355} 356 357=item $bf->get_feature_areas() 358 359Return the feature areas (i.e. the area values has_features will return 360true for). 361 362=cut 363 364sub get_feature_areas { 365 my $self = shift; 366 367 return keys %{$self->{features}}; 368} 369 370=item $bf->get_features($area) 371 372Return, for the given area, a hash with keys as feature names, and values 373as booleans indicating whether the feature is enabled or not. 374 375=cut 376 377sub get_features { 378 my ($self, $area) = @_; 379 return %{$self->{features}{$area}}; 380} 381 382=item $bf->get_origin($flag) 383 384Return the origin associated to the flag. It might be undef if the 385flag doesn't exist. 386 387=cut 388 389sub get_origin { 390 my ($self, $key) = @_; 391 return $self->{origin}{$key}; 392} 393 394=item $bf->is_maintainer_modified($flag) 395 396Return true if the flag is modified by the maintainer. 397 398=cut 399 400sub is_maintainer_modified { 401 my ($self, $key) = @_; 402 return $self->{maintainer}{$key}; 403} 404 405=item $bf->has_features($area) 406 407Returns true if the given area of features is known, and false otherwise. 408The only currently recognized feature areas are "future", "qa", "sanitize", 409"hardening" and "reproducible". 410 411=cut 412 413sub has_features { 414 my ($self, $area) = @_; 415 return exists $self->{features}{$area}; 416} 417 418=item $bf->has($option) 419 420Returns a boolean indicating whether the flags exists in the object. 421 422=cut 423 424sub has { 425 my ($self, $key) = @_; 426 return exists $self->{flags}{$key}; 427} 428 429=item @flags = $bf->list() 430 431Returns the list of flags stored in the object. 432 433=cut 434 435sub list { 436 my $self = shift; 437 my @list = sort keys %{$self->{flags}}; 438 return @list; 439} 440 441=back 442 443=head1 CHANGES 444 445=head2 Version 1.03 (dpkg 1.16.5) 446 447New method: $bf->get_feature_areas() to list possible values for 448$bf->get_features. 449 450New method $bf->is_maintainer_modified() and new optional parameter to 451$bf->set(), $bf->append(), $bf->prepend(), $bf->strip(). 452 453=head2 Version 1.02 (dpkg 1.16.2) 454 455New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature(). 456 457=head2 Version 1.01 (dpkg 1.16.1) 458 459New method: $bf->prepend() very similar to append(). Implement support of 460the prepend operation everywhere. 461 462New method: $bf->load_maintainer_config() that update the build flags 463based on the package maintainer directives. 464 465=head2 Version 1.00 (dpkg 1.15.7) 466 467Mark the module as public. 468 469=cut 470 4711; 472