| Current File : //proc/thread-self/root/usr/share/perl5/Dpkg/BuildFlags.pm |
# 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;