Adding upstream version 1.21.22.upstream/1.21.22upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

7 files changed, 1652 insertions, 0 deletions

diff --git a/scripts/Dpkg/Build/Info.pm b/scripts/Dpkg/Build/Info.pm
new file mode 100644
index 0000000..d789a36
--- /dev/null
+++ b/scripts/Dpkg/Build/Info.pm
@@ -0,0 +1,97 @@
+# Copyright © 2016-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/>.
+
+package Dpkg::Build::Info;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.02';
+our @EXPORT_OK = qw(
+    get_build_env_whitelist
+    get_build_env_allowed
+);
+
+use Exporter qw(import);
+
+use Dpkg::BuildInfo;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::Build::Info - handle build information
+
+=head1 DESCRIPTION
+
+The Dpkg::Build::Info module provides functions to handle the build
+information.
+
+This module is deprecated, use Dpkg::BuildInfo instead.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @envvars = get_build_env_allowed()
+
+Get an array with the allowed list of environment variables that can affect
+the build, but are still not privacy revealing.
+
+This is a deprecated alias for Dpkg::BuildInfo::get_build_env_allowed().
+
+=cut
+
+sub get_build_env_allowed {
+    #warnings::warnif('deprecated',
+    #    'Dpkg::Build::Info::get_build_env_allowed() is deprecated, ' .
+    #    'use Dpkg::BuildInfo::get_build_env_allowed() instead');
+    return Dpkg::BuildInfo::get_build_env_allowed();
+}
+
+=item @envvars = get_build_env_whitelist()
+
+This is a deprecated alias for Dpkg::BuildInfo::get_build_env_allowed().
+
+=cut
+
+sub get_build_env_whitelist {
+    warnings::warnif('deprecated',
+        'Dpkg::Build::Info::get_build_env_whitelist() is deprecated, ' .
+        'use Dpkg::BuildInfo::get_build_env_allowed() instead');
+    return Dpkg::BuildInfo::get_build_env_allowed();
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.02 (dpkg 1.21.14)
+
+Deprecate module: replaced by Dpkg::BuildInfo.
+
+=head2 Version 1.01 (dpkg 1.20.1)
+
+New function: get_build_env_allowed().
+
+Deprecated function: get_build_env_whitelist().
+
+=head2 Version 1.00 (dpkg 1.18.14)
+
+Mark the module as public.
+
+=cut
+
+1;
diff --git a/scripts/Dpkg/BuildEnv.pm b/scripts/Dpkg/BuildEnv.pm
new file mode 100644
index 0000000..1b6295b
--- /dev/null
+++ b/scripts/Dpkg/BuildEnv.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::BuildEnv;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+my %env_modified = ();
+my %env_accessed = ();
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildEnv - track build environment
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildEnv 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/BuildFlags.pm b/scripts/Dpkg/BuildFlags.pm
new file mode 100644
index 0000000..5975bb0
--- /dev/null
+++ b/scripts/Dpkg/BuildFlags.pm
@@ -0,0 +1,612 @@
+# 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/>.
+
+package Dpkg::BuildFlags;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.06';
+
+use Dpkg ();
+use Dpkg::Gettext;
+use Dpkg::BuildEnv;
+use Dpkg::ErrorHandling;
+use Dpkg::Vendor qw(run_vendor_hook);
+
+=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.
+
+=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;
+
+    $self->{features} = {};
+    $self->{builtins} = {};
+    $self->{optvals} = {};
+    $self->{flags} = {
+	ASFLAGS => '',
+	CPPFLAGS => '',
+	CFLAGS   => '',
+	CXXFLAGS => '',
+	OBJCFLAGS   => '',
+	OBJCXXFLAGS => '',
+	GCJFLAGS => '',
+	DFLAGS   => '',
+	FFLAGS   => '',
+	FCFLAGS  => '',
+	LDFLAGS  => '',
+    };
+    $self->{origin} = {
+	ASFLAGS => 'vendor',
+	CPPFLAGS => 'vendor',
+	CFLAGS   => 'vendor',
+	CXXFLAGS => 'vendor',
+	OBJCFLAGS   => 'vendor',
+	OBJCXXFLAGS => 'vendor',
+	GCJFLAGS => 'vendor',
+	DFLAGS   => 'vendor',
+	FFLAGS   => 'vendor',
+	FCFLAGS  => 'vendor',
+	LDFLAGS  => 'vendor',
+    };
+    $self->{maintainer} = {
+	ASFLAGS => 0,
+	CPPFLAGS => 0,
+	CFLAGS   => 0,
+	CXXFLAGS => 0,
+	OBJCFLAGS   => 0,
+	OBJCXXFLAGS => 0,
+	GCJFLAGS => 0,
+	DFLAGS   => 0,
+	FFLAGS   => 0,
+	FCFLAGS  => 0,
+	LDFLAGS  => 0,
+    };
+}
+
+=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
+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
+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 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;
diff --git a/scripts/Dpkg/BuildInfo.pm b/scripts/Dpkg/BuildInfo.pm
new file mode 100644
index 0000000..7be6bc7
--- /dev/null
+++ b/scripts/Dpkg/BuildInfo.pm
@@ -0,0 +1,154 @@
+# Copyright © 2016-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/>.
+
+package Dpkg::BuildInfo;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.00';
+our @EXPORT_OK = qw(
+    get_build_env_allowed
+);
+
+use Exporter qw(import);
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildInfo - handle build information
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildInfo module provides functions to handle the build
+information.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item @envvars = get_build_env_allowed()
+
+Get an array with the allowed list of environment variables that can affect
+the build, but are still not privacy revealing.
+
+=cut
+
+my @env_allowed = (
+    # Toolchain.
+    qw(
+        CC
+        CPP
+        CXX
+        OBJC
+        OBJCXX
+        PC
+        FC
+        M2C
+        AS
+        LD
+        AR
+        RANLIB
+        MAKE
+        AWK
+        LEX
+        YACC
+    ),
+    # Toolchain flags.
+    qw(
+        ASFLAGS
+        CFLAGS
+        CPPFLAGS
+        CXXFLAGS
+        OBJCFLAGS
+        OBJCXXFLAGS
+        GCJFLAGS
+        DFLAGS
+        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_allowed {
+    return @env_allowed;
+}
+
+=back
+
+=head1 CHANGES
+
+=head2 Version 1.00 (dpkg 1.21.14)
+
+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..62a84ea
--- /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::BuildEnv;
+
+=encoding utf8
+
+=head1 NAME
+
+Dpkg::BuildOptions - parse and update build options
+
+=head1 DESCRIPTION
+
+This class 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::BuildEnv::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 =~ /^(terse|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::BuildEnv::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..df3ec48
--- /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::BuildEnv;
+
+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::BuildEnv::has('DEB_BUILD_PROFILES')) {
+        @build_profiles = split ' ', Dpkg::BuildEnv::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::BuildEnv::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;
diff --git a/scripts/Dpkg/BuildTypes.pm b/scripts/Dpkg/BuildTypes.pm
new file mode 100644
index 0000000..9f20d0d
--- /dev/null
+++ b/scripts/Dpkg/BuildTypes.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::BuildTypes;
+
+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::BuildTypes - track build types
+
+=head1 DESCRIPTION
+
+The Dpkg::BuildTypes 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;