diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/Dpkg/Build/Env.pm | 113 | ||||
| -rw-r--r-- | scripts/Dpkg/Build/Info.pm | 94 | ||||
| -rw-r--r-- | scripts/Dpkg/Build/Types.pm | 284 | ||||
| -rw-r--r-- | scripts/Dpkg/BuildFlags.pm | 471 | ||||
| -rw-r--r-- | scripts/Dpkg/BuildOptions.pm | 246 | ||||
| -rw-r--r-- | scripts/Dpkg/BuildProfiles.pm | 146 |
6 files changed, 1354 insertions, 0 deletions
diff --git a/scripts/Dpkg/Build/Env.pm b/scripts/Dpkg/Build/Env.pm new file mode 100644 index 0000000..856d185 --- /dev/null +++ b/scripts/Dpkg/Build/Env.pm @@ -0,0 +1,113 @@ +# Copyright © 2012 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/>. + +package Dpkg::Build::Env; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +my %env_modified = (); +my %env_accessed = (); + +=encoding utf8 + +=head1 NAME + +Dpkg::Build::Env - track build environment + +=head1 DESCRIPTION + +The Dpkg::Build::Env module is used by dpkg-buildflags to track the build +environment variables being used and modified. + +=head1 FUNCTIONS + +=over 4 + +=item set($varname, $value) + +Update the build environment variable $varname with value $value. Record +it as being accessed and modified. + +=cut + +sub set { + my ($varname, $value) = @_; + $env_modified{$varname} = 1; + $env_accessed{$varname} = 1; + $ENV{$varname} = $value; +} + +=item get($varname) + +Get the build environment variable $varname value. Record it as being +accessed. + +=cut + +sub get { + my $varname = shift; + $env_accessed{$varname} = 1; + return $ENV{$varname}; +} + +=item has($varname) + +Return a boolean indicating whether the environment variable exists. +Record it as being accessed. + +=cut + +sub has { + my $varname = shift; + $env_accessed{$varname} = 1; + return exists $ENV{$varname}; +} + +=item @list = list_accessed() + +Returns a list of all environment variables that have been accessed. + +=cut + +sub list_accessed { + my @list = sort keys %env_accessed; + return @list; +} + +=item @list = list_modified() + +Returns a list of all environment variables that have been modified. + +=cut + +sub list_modified { + my @list = sort keys %env_modified; + return @list; +} + +=back + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Build/Info.pm b/scripts/Dpkg/Build/Info.pm new file mode 100644 index 0000000..4935f0f --- /dev/null +++ b/scripts/Dpkg/Build/Info.pm @@ -0,0 +1,94 @@ +# Copyright © 2016 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/>. + +package Dpkg::Build::Info; + +use strict; +use warnings; + +our $VERSION = '1.00'; +our @EXPORT_OK = qw( + get_build_env_whitelist +); + +use Exporter qw(import); + +=encoding utf8 + +=head1 NAME + +Dpkg::Build::Info - handle build information + +=head1 DESCRIPTION + +The Dpkg::Build::Info module provides functions to handle the build +information. + +=head1 FUNCTIONS + +=over 4 + +=item @envvars = get_build_env_whitelist() + +Get an array with the whitelist of environment variables that can affect +the build, but are still not privacy revealing. + +=cut + +my @env_whitelist = ( + # Toolchain. + qw(CC CPP CXX OBJC OBJCXX PC FC M2C AS LD AR RANLIB MAKE AWK LEX YACC), + # Toolchain flags. + qw(CFLAGS CPPFLAGS CXXFLAGS OBJCFLAGS OBJCXXFLAGS GCJFLAGS FFLAGS + LDFLAGS ARFLAGS MAKEFLAGS), + # Dynamic linker, see ld(1). + qw(LD_LIBRARY_PATH), + # Locale, see locale(1). + qw(LANG LC_ALL LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY + LC_MESSAGES LC_PAPER LC_NAME LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT + LC_IDENTIFICATION), + # Build flags, see dpkg-buildpackage(1). + qw(DEB_BUILD_OPTIONS DEB_BUILD_PROFILES), + # DEB_flag_{SET,STRIP,APPEND,PREPEND} will be recorded after being merged + # with system config and user config. + # See deb-vendor(1). + qw(DEB_VENDOR), + # See dpkg(1). + qw(DPKG_ROOT DPKG_ADMINDIR), + # See dpkg-architecture(1). + qw(DPKG_DATADIR), + # See Dpkg::Vendor(3). + qw(DPKG_ORIGINS_DIR), + # See dpkg-gensymbols(1). + qw(DPKG_GENSYMBOLS_CHECK_LEVEL), + # See <https://reproducible-builds.org/specs/source-date-epoch>. + qw(SOURCE_DATE_EPOCH), +); + +sub get_build_env_whitelist { + return @env_whitelist; +} + +=back + +=head1 CHANGES + +=head2 Version 1.00 (dpkg 1.18.14) + +Mark the module as public. + +=cut + +1; diff --git a/scripts/Dpkg/Build/Types.pm b/scripts/Dpkg/Build/Types.pm new file mode 100644 index 0000000..9fd0344 --- /dev/null +++ b/scripts/Dpkg/Build/Types.pm @@ -0,0 +1,284 @@ +# Copyright © 2007 Frank Lichtenheld <djpig@debian.org> +# Copyright © 2010, 2013-2016 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/>. + +package Dpkg::Build::Types; + +use strict; +use warnings; + +our $VERSION = '0.02'; +our @EXPORT = qw( + BUILD_DEFAULT + BUILD_SOURCE + BUILD_ARCH_DEP + BUILD_ARCH_INDEP + BUILD_BINARY + BUILD_FULL + build_has_any + build_has_all + build_has_none + build_is + set_build_type + set_build_type_from_options + set_build_type_from_targets + get_build_options_from_type +); + +use Exporter qw(import); + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; + +=encoding utf8 + +=head1 NAME + +Dpkg::Build::Types - track build types + +=head1 DESCRIPTION + +The Dpkg::Build::Types module is used by various tools to track and decide +what artifacts need to be built. + +The build types are bit constants that are exported by default. Multiple +types can be ORed. + +=head1 CONSTANTS + +=over 4 + +=item BUILD_DEFAULT + +This build is the default. + +=item BUILD_SOURCE + +This build includes source artifacts. + +=item BUILD_ARCH_DEP + +This build includes architecture dependent binary artifacts. + +=item BUILD_ARCH_INDEP + +This build includes architecture independent binary artifacts. + +=item BUILD_BINARY + +This build includes binary artifacts. + +=item BUILD_FULL + +This build includes source and binary artifacts. + +=cut + +# Simple types. +use constant { + BUILD_DEFAULT => 1, + BUILD_SOURCE => 2, + BUILD_ARCH_DEP => 4, + BUILD_ARCH_INDEP => 8, +}; + +# Composed types. +use constant BUILD_BINARY => BUILD_ARCH_DEP | BUILD_ARCH_INDEP; +use constant BUILD_FULL => BUILD_BINARY | BUILD_SOURCE; + +my $current_type = BUILD_FULL | BUILD_DEFAULT; +my $current_option = undef; + +my @build_types = qw(full source binary any all); +my %build_types = ( + full => BUILD_FULL, + source => BUILD_SOURCE, + binary => BUILD_BINARY, + any => BUILD_ARCH_DEP, + all => BUILD_ARCH_INDEP, +); +my %build_targets = ( + 'clean' => BUILD_SOURCE, + 'build' => BUILD_BINARY, + 'build-arch' => BUILD_ARCH_DEP, + 'build-indep' => BUILD_ARCH_INDEP, + 'binary' => BUILD_BINARY, + 'binary-arch' => BUILD_ARCH_DEP, + 'binary-indep' => BUILD_ARCH_INDEP, +); + +=back + +=head1 FUNCTIONS + +=over 4 + +=item build_has_any($bits) + +Return a boolean indicating whether the current build type has any of the +specified $bits. + +=cut + +sub build_has_any +{ + my ($bits) = @_; + + return $current_type & $bits; +} + +=item build_has_all($bits) + +Return a boolean indicating whether the current build type has all the +specified $bits. + +=cut + +sub build_has_all +{ + my ($bits) = @_; + + return ($current_type & $bits) == $bits; +} + +=item build_has_none($bits) + +Return a boolean indicating whether the current build type has none of the +specified $bits. + +=cut + +sub build_has_none +{ + my ($bits) = @_; + + return !($current_type & $bits); +} + +=item build_is($bits) + +Return a boolean indicating whether the current build type is the specified +set of $bits. + +=cut + +sub build_is +{ + my ($bits) = @_; + + return $current_type == $bits; +} + +=item set_build_type($build_type, $build_option, %opts) + +Set the current build type to $build_type, which was specified via the +$build_option command-line option. + +The function will check and abort on incompatible build type assignments, +this behavior can be disabled by using the boolean option "nocheck". + +=cut + +sub set_build_type +{ + my ($build_type, $build_option, %opts) = @_; + + usageerr(g_('cannot combine %s and %s'), $current_option, $build_option) + if not $opts{nocheck} and + build_has_none(BUILD_DEFAULT) and $current_type != $build_type; + + $current_type = $build_type; + $current_option = $build_option; +} + +=item set_build_type_from_options($build_types, $build_option, %opts) + +Set the current build type from a list of comma-separated build type +components. + +The function will check and abort on incompatible build type assignments, +this behavior can be disabled by using the boolean option "nocheck". + +=cut + +sub set_build_type_from_options +{ + my ($build_parts, $build_option, %opts) = @_; + + my $build_type = 0; + foreach my $type (split /,/, $build_parts) { + usageerr(g_('unknown build type %s'), $type) + unless exists $build_types{$type}; + $build_type |= $build_types{$type}; + } + + set_build_type($build_type, $build_option, %opts); +} + +=item set_build_type_from_targets($build_targets, $build_option, %opts) + +Set the current build type from a list of comma-separated build target +components. + +The function will check and abort on incompatible build type assignments, +this behavior can be disabled by using the boolean option "nocheck". + +=cut + +sub set_build_type_from_targets +{ + my ($build_targets, $build_option, %opts) = @_; + + my $build_type = 0; + foreach my $target (split /,/, $build_targets) { + $build_type |= $build_targets{$target} // BUILD_BINARY; + } + + set_build_type($build_type, $build_option, %opts); +} + +=item get_build_options_from_type() + +Get the current build type as a set of comma-separated string options. + +=cut + +sub get_build_options_from_type +{ + my $local_type = $current_type; + + my @parts; + foreach my $type (@build_types) { + my $part_bits = $build_types{$type}; + if (($local_type & $part_bits) == $part_bits) { + push @parts, $type; + $local_type &= ~$part_bits; + } + } + + return join ',', @parts; +} + +=back + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm new file mode 100644 index 0000000..a8fd458 --- /dev/null +++ b/scripts/Dpkg/BuildFlags.pm @@ -0,0 +1,471 @@ +# Copyright © 2010-2011 Raphaël Hertzog <hertzog@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/>. + +package Dpkg::BuildFlags; + +use strict; +use warnings; + +our $VERSION = '1.03'; + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::Build::Env; +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 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. + +=cut + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = { + }; + bless $self, $class; + $self->load_vendor_defaults(); + return $self; +} + +=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->{options} = {}; + $self->{source} = {}; + $self->{features} = {}; + $self->{flags} = { + CPPFLAGS => '', + CFLAGS => '', + CXXFLAGS => '', + OBJCFLAGS => '', + OBJCXXFLAGS => '', + GCJFLAGS => '', + FFLAGS => '', + FCFLAGS => '', + LDFLAGS => '', + }; + $self->{origin} = { + CPPFLAGS => 'vendor', + CFLAGS => 'vendor', + CXXFLAGS => 'vendor', + OBJCFLAGS => 'vendor', + OBJCXXFLAGS => 'vendor', + GCJFLAGS => 'vendor', + FFLAGS => 'vendor', + FCFLAGS => 'vendor', + LDFLAGS => 'vendor', + }; + $self->{maintainer} = { + CPPFLAGS => 0, + CFLAGS => 0, + CXXFLAGS => 0, + OBJCFLAGS => 0, + OBJCXXFLAGS => 0, + GCJFLAGS => 0, + FFLAGS => 0, + FCFLAGS => 0, + LDFLAGS => 0, + }; + # 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 +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::Build::Env::has($envvar)) { + $self->set($flag, Dpkg::Build::Env::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_STRIP'; + if (Dpkg::Build::Env::has($envvar)) { + $self->strip($flag, Dpkg::Build::Env::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_APPEND'; + if (Dpkg::Build::Env::has($envvar)) { + $self->append($flag, Dpkg::Build::Env::get($envvar), 'env'); + } + $envvar = 'DEB_' . $flag . '_PREPEND'; + if (Dpkg::Build::Env::has($envvar)) { + $self->prepend($flag, Dpkg::Build::Env::get($envvar), 'env'); + } + } +} + +=item $bf->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 = shift; + + foreach my $flag (keys %{$self->{flags}}) { + my $envvar = 'DEB_' . $flag . '_MAINT_SET'; + if (Dpkg::Build::Env::has($envvar)) { + $self->set($flag, Dpkg::Build::Env::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_STRIP'; + if (Dpkg::Build::Env::has($envvar)) { + $self->strip($flag, Dpkg::Build::Env::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_APPEND'; + if (Dpkg::Build::Env::has($envvar)) { + $self->append($flag, Dpkg::Build::Env::get($envvar), undef, 1); + } + $envvar = 'DEB_' . $flag . '_MAINT_PREPEND'; + if (Dpkg::Build::Env::has($envvar)) { + $self->prepend($flag, Dpkg::Build::Env::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->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", "hardening" and "reproducible". + +=cut + +sub set_feature { + my ($self, $area, $feature, $enabled) = @_; + $self->{features}{$area}{$feature} = $enabled; +} + +=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) = @_; + foreach my $tostrip (split(/\s+/, $value)) { + next unless length $tostrip; + $self->{flags}->{$flag} =~ s/(^|\s+)\Q$tostrip\E(\s+|$)/ /g; + } + $self->{flags}->{$flag} =~ s/^\s+//g; + $self->{flags}->{$flag} =~ s/\s+$//g; + $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 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", +"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.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; diff --git a/scripts/Dpkg/BuildOptions.pm b/scripts/Dpkg/BuildOptions.pm new file mode 100644 index 0000000..263381b --- /dev/null +++ b/scripts/Dpkg/BuildOptions.pm @@ -0,0 +1,246 @@ +# Copyright © 2007 Frank Lichtenheld <djpig@debian.org> +# Copyright © 2008, 2012-2017 Guillem Jover <guillem@debian.org> +# Copyright © 2010 Raphaël Hertzog <hertzog@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/>. + +package Dpkg::BuildOptions; + +use strict; +use warnings; + +our $VERSION = '1.02'; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Build::Env; + +=encoding utf8 + +=head1 NAME + +Dpkg::BuildOptions - parse and update build options + +=head1 DESCRIPTION + +The Dpkg::BuildOptions object can be used to manipulate options stored +in environment variables like DEB_BUILD_OPTIONS and +DEB_BUILD_MAINT_OPTIONS. + +=head1 METHODS + +=over 4 + +=item $bo = Dpkg::BuildOptions->new(%opts) + +Create a new Dpkg::BuildOptions object. It will be initialized based +on the value of the environment variable named $opts{envvar} (or +DEB_BUILD_OPTIONS if that option is not set). + +=cut + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = { + options => {}, + source => {}, + envvar => $opts{envvar} // 'DEB_BUILD_OPTIONS', + }; + bless $self, $class; + $self->merge(Dpkg::Build::Env::get($self->{envvar}), $self->{envvar}); + return $self; +} + +=item $bo->reset() + +Reset the object to not have any option (it's empty). + +=cut + +sub reset { + my $self = shift; + $self->{options} = {}; + $self->{source} = {}; +} + +=item $bo->merge($content, $source) + +Merge the options set in $content and record that they come from the +source $source. $source is mainly used in warning messages currently +to indicate where invalid options have been detected. + +$content is a space separated list of options with optional assigned +values like "nocheck parallel=2". + +=cut + +sub merge { + my ($self, $content, $source) = @_; + return 0 unless defined $content; + my $count = 0; + foreach (split(/\s+/, $content)) { + unless (/^([a-z][a-z0-9_-]*)(?:=(\S*))?$/) { + warning(g_('invalid flag in %s: %s'), $source, $_); + next; + } + $count += $self->set($1, $2, $source); + } + return $count; +} + +=item $bo->set($option, $value, [$source]) + +Store the given option in the object with the given value. It's legitimate +for a value to be undefined if the option is a simple boolean (its +presence means true, its absence means false). The $source is optional +and indicates where the option comes from. + +The known options have their values checked for sanity. Options without +values have their value removed and options with invalid values are +discarded. + +=cut + +sub set { + my ($self, $key, $value, $source) = @_; + + # Sanity checks + if ($key =~ /^(noopt|nostrip|nocheck)$/ && defined($value)) { + $value = undef; + } elsif ($key eq 'parallel') { + $value //= ''; + return 0 if $value !~ /^\d*$/; + } + + $self->{options}{$key} = $value; + $self->{source}{$key} = $source; + + return 1; +} + +=item $bo->get($option) + +Return the value associated to the option. It might be undef even if the +option exists. You might want to check with $bo->has($option) to verify if +the option is stored in the object. + +=cut + +sub get { + my ($self, $key) = @_; + return $self->{options}{$key}; +} + +=item $bo->has($option) + +Returns a boolean indicating whether the option is stored in the object. + +=cut + +sub has { + my ($self, $key) = @_; + return exists $self->{options}{$key}; +} + +=item $bo->parse_features($option, $use_feature) + +Parse the $option values, as a set of known features to enable or disable, +as specified in the $use_feature hash reference. + +Each feature is prefixed with a ‘B<+>’ or a ‘B<->’ character as a marker +to enable or disable it. The special feature “B<all>” can be used to act +on all known features. + +Unknown or malformed features will emit warnings. + +=cut + +sub parse_features { + my ($self, $option, $use_feature) = @_; + + foreach my $feature (split(/,/, $self->get($option) // '')) { + $feature = lc $feature; + if ($feature =~ s/^([+-])//) { + my $value = ($1 eq '+') ? 1 : 0; + if ($feature eq 'all') { + $use_feature->{$_} = $value foreach keys %{$use_feature}; + } else { + if (exists $use_feature->{$feature}) { + $use_feature->{$feature} = $value; + } else { + warning(g_('unknown %s feature in %s variable: %s'), + $option, $self->{envvar}, $feature); + } + } + } else { + warning(g_('incorrect value in %s option of %s variable: %s'), + $option, $self->{envvar}, $feature); + } + } +} + +=item $string = $bo->output($fh) + +Return a string representation of the build options suitable to be +assigned to an environment variable. Can optionally output that string to +the given filehandle. + +=cut + +sub output { + my ($self, $fh) = @_; + my $o = $self->{options}; + my $res = join(' ', map { defined($o->{$_}) ? $_ . '=' . $o->{$_} : $_ } sort keys %$o); + print { $fh } $res if defined $fh; + return $res; +} + +=item $bo->export([$var]) + +Export the build options to the given environment variable. If omitted, +the environment variable defined at creation time is assumed. The value +set to the variable is also returned. + +=cut + +sub export { + my ($self, $var) = @_; + $var //= $self->{envvar}; + my $content = $self->output(); + Dpkg::Build::Env::set($var, $content); + return $content; +} + +=back + +=head1 CHANGES + +=head2 Version 1.02 (dpkg 1.18.19) + +New method: $bo->parse_features(). + +=head2 Version 1.01 (dpkg 1.16.1) + +Enable to use another environment variable instead of DEB_BUILD_OPTIONS. +Thus add support for the "envvar" option at creation time. + +=head2 Version 1.00 (dpkg 1.15.6) + +Mark the module as public. + +=cut + +1; diff --git a/scripts/Dpkg/BuildProfiles.pm b/scripts/Dpkg/BuildProfiles.pm new file mode 100644 index 0000000..8684077 --- /dev/null +++ b/scripts/Dpkg/BuildProfiles.pm @@ -0,0 +1,146 @@ +# Copyright © 2013 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/>. + +package Dpkg::BuildProfiles; + +use strict; +use warnings; + +our $VERSION = '1.00'; +our @EXPORT_OK = qw( + get_build_profiles + set_build_profiles + parse_build_profiles + evaluate_restriction_formula +); + +use Exporter qw(import); +use List::Util qw(any); + +use Dpkg::Build::Env; + +my $cache_profiles; +my @build_profiles; + +=encoding utf8 + +=head1 NAME + +Dpkg::BuildProfiles - handle build profiles + +=head1 DESCRIPTION + +The Dpkg::BuildProfiles module provides functions to handle the build +profiles. + +=head1 FUNCTIONS + +=over 4 + +=item @profiles = get_build_profiles() + +Get an array with the currently active build profiles, taken from +the environment variable B<DEB_BUILD_PROFILES>. + +=cut + +sub get_build_profiles { + return @build_profiles if $cache_profiles; + + if (Dpkg::Build::Env::has('DEB_BUILD_PROFILES')) { + @build_profiles = split ' ', Dpkg::Build::Env::get('DEB_BUILD_PROFILES'); + } + $cache_profiles = 1; + + return @build_profiles; +} + +=item set_build_profiles(@profiles) + +Set C<@profiles> as the current active build profiles, by setting +the environment variable B<DEB_BUILD_PROFILES>. + +=cut + +sub set_build_profiles { + my (@profiles) = @_; + + $cache_profiles = 1; + @build_profiles = @profiles; + Dpkg::Build::Env::set('DEB_BUILD_PROFILES', join ' ', @profiles); +} + +=item @profiles = parse_build_profiles($string) + +Parses a build profiles specification, into an array of array references. + +=cut + +sub parse_build_profiles { + my $string = shift; + + $string =~ s/^\s*<\s*(.*)\s*>\s*$/$1/; + + return map { [ split ' ' ] } split /\s*>\s+<\s*/, $string; +} + +=item evaluate_restriction_formula(\@formula, \@profiles) + +Evaluate whether a restriction formula of the form "<foo bar> <baz>", given as +a nested array, is true or false, given the array of enabled build profiles. + +=cut + +sub evaluate_restriction_formula { + my ($formula, $profiles) = @_; + + # Restriction formulas are in disjunctive normal form: + # (foo AND bar) OR (blub AND bla) + foreach my $restrlist (@{$formula}) { + my $seen_profile = 1; + + foreach my $restriction (@$restrlist) { + next if $restriction !~ m/^(!)?(.+)/; + + my $negated = defined $1 && $1 eq '!'; + my $profile = $2; + my $found = any { $_ eq $profile } @{$profiles}; + + # If a negative set profile is encountered, stop processing. + # If a positive unset profile is encountered, stop processing. + if ($found == $negated) { + $seen_profile = 0; + last; + } + } + + # This conjunction evaluated to true so we don't have to evaluate + # the others. + return 1 if $seen_profile; + } + return 0; +} + +=back + +=head1 CHANGES + +=head2 Version 1.00 (dpkg 1.17.17) + +Mark the module as public. + +=cut + +1; |