diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/Dpkg/BuildFlags.pm | 599 |
1 files changed, 599 insertions, 0 deletions
diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm new file mode 100644 index 0000000..8aff53e --- /dev/null +++ b/scripts/Dpkg/BuildFlags.pm @@ -0,0 +1,599 @@ +# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2012-2022 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/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::BuildFlags - query build flags + +=head1 DESCRIPTION + +This class is used by dpkg-buildflags and can be used +to query the same information. + +=cut + +package Dpkg::BuildFlags 1.06; + +use strict; +use warnings; + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::BuildEnv; +use Dpkg::ErrorHandling; +use Dpkg::Vendor qw(run_vendor_hook); + +=head1 METHODS + +=over 4 + +=item $bf = Dpkg::BuildFlags->new() + +Create a new Dpkg::BuildFlags object. It will be initialized based +on the value of several configuration files and environment variables. + +If the option B<vendor_defaults> is set to false, then no vendor defaults are +initialized (it defaults to true). + +=cut + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = { + }; + bless $self, $class; + + $opts{vendor_defaults} //= 1; + + if ($opts{vendor_defaults}) { + $self->load_vendor_defaults(); + } else { + $self->_init_vendor_defaults(); + } + return $self; +} + +sub _init_vendor_defaults { + my $self = shift; + + my @flags = qw( + ASFLAGS + ASFLAGS_FOR_BUILD + CPPFLAGS + CPPFLAGS_FOR_BUILD + CFLAGS + CFLAGS_FOR_BUILD + CXXFLAGS + CXXFLAGS_FOR_BUILD + OBJCFLAGS + OBJCFLAGS_FOR_BUILD + OBJCXXFLAGS + OBJCXXFLAGS_FOR_BUILD + DFLAGS + DFLAGS_FOR_BUILD + FFLAGS + FFLAGS_FOR_BUILD + FCFLAGS + FCFLAGS_FOR_BUILD + LDFLAGS + LDFLAGS_FOR_BUILD + ); + + $self->{features} = {}; + $self->{builtins} = {}; + $self->{optvals} = {}; + $self->{flags} = { map { $_ => '' } @flags }; + $self->{origin} = { map { $_ => 'vendor' } @flags }; + $self->{maintainer} = { map { $_ => 0 } @flags }; +} + +=item $bf->load_vendor_defaults() + +Reset the flags stored to the default set provided by the vendor. + +=cut + +sub load_vendor_defaults { + my $self = shift; + + $self->_init_vendor_defaults(); + + # The vendor hook will add the feature areas build flags. + run_vendor_hook('update-buildflags', $self); +} + +=item $bf->load_system_config() + +Update flags from the system configuration. + +=cut + +sub load_system_config { + my $self = shift; + + $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system'); +} + +=item $bf->load_user_config() + +Update flags from the user configuration. + +=cut + +sub load_user_config { + my $self = shift; + + my $confdir = $ENV{XDG_CONFIG_HOME}; + $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME}; + if (length $confdir) { + $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user'); + } +} + +=item $bf->load_environment_config() + +Update flags based on user directives stored in the environment. See +L<dpkg-buildflags(1)> for details. + +=cut + +sub load_environment_config { + my $self = shift; + + foreach my $flag (keys %{$self->{flags}}) { + my $envvar = 'DEB_' . $flag . '_SET'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->set($flag, Dpkg::BuildEnv::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_STRIP'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->strip($flag, Dpkg::BuildEnv::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_APPEND'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->append($flag, Dpkg::BuildEnv::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_PREPEND'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->prepend($flag, Dpkg::BuildEnv::get($envvar), 'env'); + } + } +} + +=item $bf->load_maintainer_config() + +Update flags based on maintainer directives stored in the environment. See +L<dpkg-buildflags(1)> for details. + +=cut + +sub load_maintainer_config { + my $self = shift; + + foreach my $flag (keys %{$self->{flags}}) { + my $envvar = 'DEB_' . $flag . '_MAINT_SET'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->set($flag, Dpkg::BuildEnv::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_STRIP'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->strip($flag, Dpkg::BuildEnv::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_APPEND'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->append($flag, Dpkg::BuildEnv::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_PREPEND'; + if (Dpkg::BuildEnv::has($envvar)) { + $self->prepend($flag, Dpkg::BuildEnv::get($envvar), undef, 1); + } + } +} + + +=item $bf->load_config() + +Call successively load_system_config(), load_user_config(), +load_environment_config() and load_maintainer_config() to update the +default build flags defined by the vendor. + +=cut + +sub load_config { + my $self = shift; + + $self->load_system_config(); + $self->load_user_config(); + $self->load_environment_config(); + $self->load_maintainer_config(); +} + +=item $bf->unset($flag) + +Unset the build flag $flag, so that it will not be known anymore. + +=cut + +sub unset { + my ($self, $flag) = @_; + + delete $self->{flags}->{$flag}; + delete $self->{origin}->{$flag}; + delete $self->{maintainer}->{$flag}; +} + +=item $bf->set($flag, $value, $source, $maint) + +Update the build flag $flag with value $value and record its origin as +$source (if defined). Record it as maintainer modified if $maint is +defined and true. + +=cut + +sub set { + my ($self, $flag, $value, $src, $maint) = @_; + $self->{flags}->{$flag} = $value; + $self->{origin}->{$flag} = $src if defined $src; + $self->{maintainer}->{$flag} = $maint if $maint; +} + +=item $bf->set_feature($area, $feature, $enabled) + +Update the boolean state of whether a specific feature within a known +feature area has been enabled. The only currently known feature areas +are "future", "qa", "sanitize", "optimize", "hardening" and "reproducible". + +=cut + +sub set_feature { + my ($self, $area, $feature, $enabled) = @_; + $self->{features}{$area}{$feature} = $enabled; +} + +=item $bf->get_feature($area, $feature) + +Returns the value for the given feature within a known feature area. +This is relevant for builtin features where the feature has a ternary +state of true, false and undef, and where the latter cannot be retrieved +with use_feature(). + +=cut + +sub get_feature { + my ($self, $area, $feature) = @_; + + return if ! $self->has_features($area); + return $self->{features}{$area}{$feature}; +} + +=item $bf->use_feature($area, $feature) + +Returns true if the given feature within a known feature areas has been +enabled, and false otherwise. +The only currently recognized feature areas are "future", "qa", "sanitize", +"optimize", "hardening" and "reproducible". + +=cut + +sub use_feature { + my ($self, $area, $feature) = @_; + + return 0 if ! $self->has_features($area); + return 0 if ! $self->{features}{$area}{$feature}; + return 1; +} + +=item $bf->set_builtin($area, $feature, $enabled) + +Update the boolean state of whether a specific feature within a known +feature area is handled (even if only in some architectures) as a builtin +default by the compiler. + +=cut + +sub set_builtin { + my ($self, $area, $feature, $enabled) = @_; + $self->{builtins}{$area}{$feature} = $enabled; +} + +=item $bf->get_builtins($area) + +Return, for the given area, a hash with keys as feature names, and values +as booleans indicating whether the feature is handled as a builtin default +by the compiler or not. Only features that might be handled as builtins on +some architectures are returned as part of the hash. Missing features mean +they are currently never handled as builtins by the compiler. + +=cut + +sub get_builtins { + my ($self, $area) = @_; + return if ! exists $self->{builtins}{$area}; + return %{$self->{builtins}{$area}}; +} + +=item $bf->set_option_value($option, $value) + +B<Private> method to set the value of a build option. +Do not use outside of the dpkg project. + +=cut + +sub set_option_value { + my ($self, $option, $value) = @_; + + $self->{optvals}{$option} = $value; +} + +=item $bf->get_option_value($option) + +B<Private> method to get the value of a build option. +Do not use outside of the dpkg project. + +=cut + +sub get_option_value { + my ($self, $option) = @_; + + return $self->{optvals}{$option}; +} + +=item $bf->strip($flag, $value, $source, $maint) + +Update the build flag $flag by stripping the flags listed in $value and +record its origin as $source (if defined). Record it as maintainer modified +if $maint is defined and true. + +=cut + +sub strip { + my ($self, $flag, $value, $src, $maint) = @_; + + my %strip = map { $_ => 1 } split /\s+/, $value; + + $self->{flags}->{$flag} = join q{ }, grep { + ! exists $strip{$_} + } split q{ }, $self->{flags}{$flag}; + $self->{origin}->{$flag} = $src if defined $src; + $self->{maintainer}->{$flag} = $maint if $maint; +} + +=item $bf->append($flag, $value, $source, $maint) + +Append the options listed in $value to the current value of the flag $flag. +Record its origin as $source (if defined). Record it as maintainer modified +if $maint is defined and true. + +=cut + +sub append { + my ($self, $flag, $value, $src, $maint) = @_; + if (length($self->{flags}->{$flag})) { + $self->{flags}->{$flag} .= " $value"; + } else { + $self->{flags}->{$flag} = $value; + } + $self->{origin}->{$flag} = $src if defined $src; + $self->{maintainer}->{$flag} = $maint if $maint; +} + +=item $bf->prepend($flag, $value, $source, $maint) + +Prepend the options listed in $value to the current value of the flag $flag. +Record its origin as $source (if defined). Record it as maintainer modified +if $maint is defined and true. + +=cut + +sub prepend { + my ($self, $flag, $value, $src, $maint) = @_; + if (length($self->{flags}->{$flag})) { + $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag}; + } else { + $self->{flags}->{$flag} = $value; + } + $self->{origin}->{$flag} = $src if defined $src; + $self->{maintainer}->{$flag} = $maint if $maint; +} + + +=item $bf->update_from_conffile($file, $source) + +Update the current build flags based on the configuration directives +contained in $file. See L<dpkg-buildflags(1)> for the format of the directives. + +$source is the origin recorded for any build flag set or modified. + +=cut + +sub update_from_conffile { + my ($self, $file, $src) = @_; + local $_; + + return unless -e $file; + open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file); + while (<$conf_fh>) { + chomp; + next if /^\s*#/; # Skip comments + next if /^\s*$/; # Skip empty lines + if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) { + my ($op, $flag, $value) = ($1, $2, $3); + unless (exists $self->{flags}->{$flag}) { + warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag); + $self->{flags}->{$flag} = ''; + } + if (lc($op) eq 'set') { + $self->set($flag, $value, $src); + } elsif (lc($op) eq 'strip') { + $self->strip($flag, $value, $src); + } elsif (lc($op) eq 'append') { + $self->append($flag, $value, $src); + } elsif (lc($op) eq 'prepend') { + $self->prepend($flag, $value, $src); + } + } else { + warning(g_('line %d of %s is invalid, it has been ignored'), $., $file); + } + } + close($conf_fh); +} + +=item $bf->get($flag) + +Return the value associated to the flag. It might be undef if the +flag doesn't exist. + +=cut + +sub get { + my ($self, $key) = @_; + return $self->{flags}{$key}; +} + +=item $bf->get_feature_areas() + +Return the feature areas (i.e. the area values has_features will return +true for). + +=cut + +sub get_feature_areas { + my $self = shift; + + return keys %{$self->{features}}; +} + +=item $bf->get_features($area) + +Return, for the given area, a hash with keys as feature names, and values +as booleans indicating whether the feature is enabled or not. + +=cut + +sub get_features { + my ($self, $area) = @_; + return %{$self->{features}{$area}}; +} + +=item $bf->get_origin($flag) + +Return the origin associated to the flag. It might be undef if the +flag doesn't exist. + +=cut + +sub get_origin { + my ($self, $key) = @_; + return $self->{origin}{$key}; +} + +=item $bf->is_maintainer_modified($flag) + +Return true if the flag is modified by the maintainer. + +=cut + +sub is_maintainer_modified { + my ($self, $key) = @_; + return $self->{maintainer}{$key}; +} + +=item $bf->has_features($area) + +Returns true if the given area of features is known, and false otherwise. +The only currently recognized feature areas are "future", "qa", "sanitize", +"optimize", "hardening" and "reproducible". + +=cut + +sub has_features { + my ($self, $area) = @_; + return exists $self->{features}{$area}; +} + +=item $bf->has($option) + +Returns a boolean indicating whether the flags exists in the object. + +=cut + +sub has { + my ($self, $key) = @_; + return exists $self->{flags}{$key}; +} + +=item @flags = $bf->list() + +Returns the list of flags stored in the object. + +=cut + +sub list { + my $self = shift; + my @list = sort keys %{$self->{flags}}; + return @list; +} + +=back + +=head1 CHANGES + +=head2 Version 1.06 (dpkg 1.21.15) + +New method: $bf->get_feature(). + +=head2 Version 1.05 (dpkg 1.21.14) + +New option: 'vendor_defaults' in new(). + +New methods: $bf->load_vendor_defaults(), $bf->use_feature(), +$bf->set_builtin(), $bf->get_builtins(). + +=head2 Version 1.04 (dpkg 1.20.0) + +New method: $bf->unset(). + +=head2 Version 1.03 (dpkg 1.16.5) + +New method: $bf->get_feature_areas() to list possible values for +$bf->get_features. + +New method $bf->is_maintainer_modified() and new optional parameter to +$bf->set(), $bf->append(), $bf->prepend(), $bf->strip(). + +=head2 Version 1.02 (dpkg 1.16.2) + +New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature(). + +=head2 Version 1.01 (dpkg 1.16.1) + +New method: $bf->prepend() very similar to append(). Implement support of +the prepend operation everywhere. + +New method: $bf->load_maintainer_config() that update the build flags +based on the package maintainer directives. + +=head2 Version 1.00 (dpkg 1.15.7) + +Mark the module as public. + +=cut + +1; |