<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright Â© 2010-2011 RaphaÃ«l Hertzog &lt;hertzog@debian.org&gt;
#
# 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 &lt;https://www.gnu.org/licenses/&gt;.

package Dpkg::BuildFlags;

use strict;
use warnings;

our $VERSION = '1.03';

use Dpkg ();
use Dpkg::Gettext;
use Dpkg::BuildEnv;
use Dpkg::BuildOptions;
use Dpkg::ErrorHandling;
use Dpkg::Vendor qw(run_vendor_hook);

=encoding utf8

=head1 NAME

Dpkg::BuildFlags - query build flags

=head1 DESCRIPTION

The Dpkg::BuildFlags object is used by dpkg-buildflags and can be used
to query the same information.

=head1 FUNCTIONS

=over 4

=item my $bf = Dpkg::BuildFlags-&gt;new()

Create a new Dpkg::BuildFlags object. It will be initialized based
on the value of several configuration files and environment variables.

=cut

sub new {
    my ($this, %opts) = @_;
    my $class = ref($this) || $this;

    my $self = {
    };
    bless $self, $class;
    $self-&gt;load_vendor_defaults();
    return $self;
}

=item $bf-&gt;load_vendor_defaults()

Reset the flags stored to the default set provided by the vendor.

=cut

sub load_vendor_defaults {
    my ($self) = @_;
    $self-&gt;{options} = {};
    $self-&gt;{source} = {};
    $self-&gt;{features} = {};
    my $build_opts = Dpkg::BuildOptions-&gt;new();
    $self-&gt;{build_options} = $build_opts;
    my $default_flags = $build_opts-&gt;has('noopt') ? '-g -O0' : '-g -O2';
    $self-&gt;{flags} = {
	CPPFLAGS =&gt; '',
	CFLAGS   =&gt; $default_flags,
	CXXFLAGS =&gt; $default_flags,
	GCJFLAGS =&gt; $default_flags,
	FFLAGS   =&gt; $default_flags,
	LDFLAGS  =&gt; '',
    };
    $self-&gt;{origin} = {
	CPPFLAGS =&gt; 'vendor',
	CFLAGS   =&gt; 'vendor',
	CXXFLAGS =&gt; 'vendor',
	GCJFLAGS =&gt; 'vendor',
	FFLAGS   =&gt; 'vendor',
	LDFLAGS  =&gt; 'vendor',
    };
    $self-&gt;{maintainer} = {
	CPPFLAGS =&gt; 0,
	CFLAGS   =&gt; 0,
	CXXFLAGS =&gt; 0,
	GCJFLAGS =&gt; 0,
	FFLAGS   =&gt; 0,
	LDFLAGS  =&gt; 0,
    };
    # The Debian vendor hook will add hardening build flags
    run_vendor_hook('update-buildflags', $self);
}

=item $bf-&gt;load_system_config()

Update flags from the system configuration.

=cut

sub load_system_config {
    my ($self) = @_;
    $self-&gt;update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system');
}

=item $bf-&gt;load_user_config()

Update flags from the user configuration.

=cut

sub load_user_config {
    my ($self) = @_;
    my $confdir = $ENV{XDG_CONFIG_HOME};
    $confdir ||= $ENV{HOME} . '/.config' if defined $ENV{HOME};
    if (defined $confdir) {
        $self-&gt;update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
    }
}

=item $bf-&gt;load_environment_config()

Update flags based on user directives stored in the environment. See
dpkg-buildflags(1) for details.

=cut

sub load_environment_config {
    my ($self) = @_;
    foreach my $flag (keys %{$self-&gt;{flags}}) {
	my $envvar = 'DEB_' . $flag . '_SET';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;set($flag, Dpkg::BuildEnv::get($envvar), 'env');
	}
	$envvar = 'DEB_' . $flag . '_STRIP';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;strip($flag, Dpkg::BuildEnv::get($envvar), 'env');
	}
	$envvar = 'DEB_' . $flag . '_APPEND';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;append($flag, Dpkg::BuildEnv::get($envvar), 'env');
	}
	$envvar = 'DEB_' . $flag . '_PREPEND';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;prepend($flag, Dpkg::BuildEnv::get($envvar), 'env');
	}
    }
}

=item $bf-&gt;load_maintainer_config()

Update flags based on maintainer directives stored in the environment. See
dpkg-buildflags(1) for details.

=cut

sub load_maintainer_config {
    my ($self) = @_;
    foreach my $flag (keys %{$self-&gt;{flags}}) {
	my $envvar = 'DEB_' . $flag . '_MAINT_SET';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;set($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
	}
	$envvar = 'DEB_' . $flag . '_MAINT_STRIP';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;strip($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
	}
	$envvar = 'DEB_' . $flag . '_MAINT_APPEND';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;append($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
	}
	$envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
	if (Dpkg::BuildEnv::has($envvar)) {
	    $self-&gt;prepend($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
	}
    }
}


=item $bf-&gt;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) = @_;
    $self-&gt;load_system_config();
    $self-&gt;load_user_config();
    $self-&gt;load_environment_config();
    $self-&gt;load_maintainer_config();
}

=item $bf-&gt;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-&gt;{flags}-&gt;{$flag} = $value;
    $self-&gt;{origin}-&gt;{$flag} = $src if defined $src;
    $self-&gt;{maintainer}-&gt;{$flag} = $maint if $maint;
}

=item $bf-&gt;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 area is
"hardening".

=cut

sub set_feature {
    my ($self, $area, $feature, $enabled) = @_;
    $self-&gt;{features}{$area}{$feature} = $enabled;
}

=item $bf-&gt;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) = @_;
    foreach my $tostrip (split(/\s+/, $value)) {
	next unless length $tostrip;
	$self-&gt;{flags}-&gt;{$flag} =~ s/(^|\s+)\Q$tostrip\E(\s+|$)/ /g;
    }
    $self-&gt;{flags}-&gt;{$flag} =~ s/^\s+//g;
    $self-&gt;{flags}-&gt;{$flag} =~ s/\s+$//g;
    $self-&gt;{origin}-&gt;{$flag} = $src if defined $src;
    $self-&gt;{maintainer}-&gt;{$flag} = $maint if $maint;
}

=item $bf-&gt;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-&gt;{flags}-&gt;{$flag})) {
        $self-&gt;{flags}-&gt;{$flag} .= " $value";
    } else {
        $self-&gt;{flags}-&gt;{$flag} = $value;
    }
    $self-&gt;{origin}-&gt;{$flag} = $src if defined $src;
    $self-&gt;{maintainer}-&gt;{$flag} = $maint if $maint;
}

=item $bf-&gt;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-&gt;{flags}-&gt;{$flag})) {
        $self-&gt;{flags}-&gt;{$flag} = "$value " . $self-&gt;{flags}-&gt;{$flag};
    } else {
        $self-&gt;{flags}-&gt;{$flag} = $value;
    }
    $self-&gt;{origin}-&gt;{$flag} = $src if defined $src;
    $self-&gt;{maintainer}-&gt;{$flag} = $maint if $maint;
}


=item $bf-&gt;update_from_conffile($file, $source)

Update the current build flags based on the configuration directives
contained in $file. See 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) = @_;
    return unless -e $file;
    open(my $conf_fh, '&lt;', $file) or syserr(_g('cannot read %s'), $file);
    while (&lt;$conf_fh&gt;) {
        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-&gt;{flags}-&gt;{$flag}) {
                warning(_g('line %d of %s mentions unknown flag %s'), $., $file, $flag);
                $self-&gt;{flags}-&gt;{$flag} = '';
            }
            if (lc($op) eq 'set') {
                $self-&gt;set($flag, $value, $src);
            } elsif (lc($op) eq 'strip') {
                $self-&gt;strip($flag, $value, $src);
            } elsif (lc($op) eq 'append') {
                $self-&gt;append($flag, $value, $src);
            } elsif (lc($op) eq 'prepend') {
                $self-&gt;prepend($flag, $value, $src);
            }
        } else {
            warning(_g('line %d of %s is invalid, it has been ignored'), $., $file);
        }
    }
    close($conf_fh);
}

=item $bf-&gt;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-&gt;{flags}{$key};
}

=item $bf-&gt;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) = @_;
    return keys %{$self-&gt;{features}};
}

=item $bf-&gt;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-&gt;{features}{$area}};
}

=item $bf-&gt;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-&gt;{origin}{$key};
}

=item $bf-&gt;is_maintainer_modified($flag)

Return true if the flag is modified by the maintainer.

=cut

sub is_maintainer_modified {
    my ($self, $key) = @_;
    return $self-&gt;{maintainer}{$key};
}

=item $bf-&gt;has_features($area)

Returns true if the given area of features is known, and false otherwise.
The only currently recognized area is "hardening".

=cut

sub has_features {
    my ($self, $area) = @_;
    return exists $self-&gt;{features}{$area};
}

=item $bf-&gt;has($option)

Returns a boolean indicating whether the flags exists in the object.

=cut

sub has {
    my ($self, $key) = @_;
    return exists $self-&gt;{flags}{$key};
}

=item my @flags = $bf-&gt;list()

Returns the list of flags stored in the object.

=cut

sub list {
    my ($self) = @_;
    my @list = sort keys %{$self-&gt;{flags}};
    return @list;
}

=back

=head1 CHANGES

=head2 Version 1.01

New method: $bf-&gt;prepend() very similar to append(). Implement support of
the prepend operation everywhere.

New method: $bf-&gt;load_maintainer_config() that update the build flags
based on the package maintainer directives.

=head2 Version 1.02

New methods: $bf-&gt;get_features(), $bf-&gt;has_features(), $bf-&gt;set_feature().

=head2 Version 1.03

New method: $bf-&gt;get_feature_areas() to list possible values for
$bf-&gt;get_features.

New method $bf-&gt;is_maintainer_modified() and new optional parameter to
$bf-&gt;set(), $bf-&gt;append(), $bf-&gt;prepend(), $bf-&gt;strip().

=head1 AUTHOR

RaphaÃ«l Hertzog &lt;hertzog@debian.org&gt;

=cut

1;
</pre></body></html>