summaryrefslogtreecommitdiffstats
path: root/lib/Debian/Debhelper
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Debian/Debhelper')
-rw-r--r--lib/Debian/Debhelper/Buildsystem.pm605
-rw-r--r--lib/Debian/Debhelper/Buildsystem/ant.pm52
-rw-r--r--lib/Debian/Debhelper/Buildsystem/autoconf.pm98
-rw-r--r--lib/Debian/Debhelper/Buildsystem/cmake.pm202
-rw-r--r--lib/Debian/Debhelper/Buildsystem/makefile.pm204
-rw-r--r--lib/Debian/Debhelper/Buildsystem/meson.pm158
-rw-r--r--lib/Debian/Debhelper/Buildsystem/ninja.pm90
-rw-r--r--lib/Debian/Debhelper/Buildsystem/perl_build.pm97
-rw-r--r--lib/Debian/Debhelper/Buildsystem/perl_makemaker.pm104
-rw-r--r--lib/Debian/Debhelper/Buildsystem/python_distutils.pm214
-rw-r--r--lib/Debian/Debhelper/Buildsystem/qmake.pm103
-rw-r--r--lib/Debian/Debhelper/Buildsystem/qmake_qt4.pm15
-rw-r--r--lib/Debian/Debhelper/DH/AddonAPI.pm228
-rw-r--r--lib/Debian/Debhelper/DH/SequenceState.pm31
-rw-r--r--lib/Debian/Debhelper/Dh_Buildsystems.pm319
-rw-r--r--lib/Debian/Debhelper/Dh_Getopt.pm332
-rw-r--r--lib/Debian/Debhelper/Dh_Lib.pm3111
-rw-r--r--lib/Debian/Debhelper/Sequence.pm131
-rw-r--r--lib/Debian/Debhelper/Sequence/build_stamp.pm10
-rw-r--r--lib/Debian/Debhelper/Sequence/dwz.pm14
-rw-r--r--lib/Debian/Debhelper/Sequence/elf_tools.pm14
-rw-r--r--lib/Debian/Debhelper/Sequence/installinitramfs.pm14
-rw-r--r--lib/Debian/Debhelper/Sequence/installsysusers.pm9
-rw-r--r--lib/Debian/Debhelper/Sequence/root_sequence.pm120
-rw-r--r--lib/Debian/Debhelper/Sequence/single_binary.pm34
-rw-r--r--lib/Debian/Debhelper/Sequence/systemd.pm19
-rw-r--r--lib/Debian/Debhelper/SequencerUtil.pm888
27 files changed, 7216 insertions, 0 deletions
diff --git a/lib/Debian/Debhelper/Buildsystem.pm b/lib/Debian/Debhelper/Buildsystem.pm
new file mode 100644
index 0000000..795f3d3
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem.pm
@@ -0,0 +1,605 @@
+# Defines debhelper build system class interface and implementation
+# of common functionality.
+#
+# Copyright: © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem;
+
+use strict;
+use warnings;
+use Cwd ();
+use File::Spec;
+use Debian::Debhelper::Dh_Lib;
+
+# Build system name. Defaults to the last component of the class
+# name. Do not override this method unless you know what you are
+# doing.
+sub NAME {
+ my ($this) = @_;
+ my $class = ref($this);
+ my $target_name;
+ if ($class) {
+ # Do not assume that the target buildsystem has been provided.
+ # NAME could be called during an error in the constructor.
+ if ($this->IS_GENERATOR_BUILD_SYSTEM and $this->get_targetbuildsystem) {
+ $target_name = $this->get_targetbuildsystem->NAME;
+ }
+ } else {
+ $class = $this;
+ }
+ if ($class =~ m/^.+::([^:]+)$/) {
+ my $name = $1;
+ return "${name}+${target_name}" if defined($target_name);
+ return $name;
+ }
+ else {
+ error("Invalid build system class name: $class");
+ }
+}
+
+# Description of the build system to be shown to the users.
+sub DESCRIPTION {
+ error("class lacking a DESCRIPTION");
+}
+
+# Default build directory. Can be overridden in the derived
+# class if really needed.
+sub DEFAULT_BUILD_DIRECTORY {
+ "obj-" . dpkg_architecture_value("DEB_HOST_GNU_TYPE");
+}
+
+# Return 1 if the build system generator
+sub IS_GENERATOR_BUILD_SYSTEM {
+ return 0;
+}
+
+# Generator build-systems only
+# The name of the supported target systems. The first one is
+# assumed to be the default if DEFAULT_TARGET_BUILD_SYSTEM is
+# not overridden.
+sub SUPPORTED_TARGET_BUILD_SYSTEMS {
+ error("class lacking SUPPORTED_TARGET_BUILD_SYSTEMS");
+}
+
+# Generator build-systems only
+# Name of default target build system if target is unspecified
+# (e.g. --buildsystem=cmake instead of cmake+makefile).
+sub DEFAULT_TARGET_BUILD_SYSTEM {
+ my ($this) = @_;
+ my @targets = $this->SUPPORTED_TARGET_BUILD_SYSTEMS;
+ # Assume they are listed in order.
+ return $targets[0];
+}
+
+# For regular build systems, the same as DESCRIPTION
+# For generator based build systems, the DESCRIPTION of the generator build
+# system + the target build system. Do not override this method unless you
+# know what you are doing.
+sub FULL_DESCRIPTION {
+ my ($this) = @_;
+ my $description = $this->DESCRIPTION;
+ return $description if not exists($this->{'targetbuildsystem'});
+ my $target_build_system = $this->{'targetbuildsystem'};
+ return $description if not defined($target_build_system);
+ my $target_desc = $target_build_system->FULL_DESCRIPTION;
+ return "${description} combined with ${target_desc}";
+}
+
+# Constructs a new build system object. Named parameters:
+# - sourcedir- specifies source directory (relative to the current (top)
+# directory) where the sources to be built live. If not
+# specified or empty, defaults to the current directory.
+# - builddir - specifies build directory to use. Path is relative to the
+# current (top) directory. If undef or empty,
+# DEFAULT_BUILD_DIRECTORY directory will be used.
+# - parallel - max number of parallel processes to be spawned for building
+# sources (-1 = unlimited; 1 = no parallel)
+# - targetbuildsystem - The target build system for generator based build
+# systems. Only set for generator build systems.
+# Derived class can override the constructor to initialize common object
+# parameters. Do NOT use constructor to execute commands or otherwise
+# configure/setup build environment. There is absolutely no guarantee the
+# constructed object will be used to build something. Use pre_building_step(),
+# $build_step() or post_building_step() methods for this.
+sub new {
+ my ($class, %opts)=@_;
+
+ my $this = bless({ sourcedir => '.',
+ builddir => undef,
+ parallel => undef,
+ cwd => Cwd::getcwd() }, $class);
+
+ # Setup the target buildsystem early, so e.g. _set_builddir also
+ # applies to the target build system. Useful if the generator
+ # and target does not agree on (e.g.) the default build dir.
+ my $target_bs_name;
+ if (exists $opts{targetbuildsystem}) {
+ $target_bs_name = $opts{targetbuildsystem};
+ }
+
+ $target_bs_name //= $this->DEFAULT_TARGET_BUILD_SYSTEM if $this->IS_GENERATOR_BUILD_SYSTEM;
+
+ if (defined($target_bs_name)) {
+ my %target_opts = %opts;
+ # Let the target know it is used as a target build system.
+ # E.g. the makefile has special cases based on whether it is
+ # the main or a target build system.
+ delete($target_opts{'targetbuildsystem'});
+ $target_opts{'_is_targetbuildsystem'} = 1;
+ my $target_system =_create_buildsystem_instance($target_bs_name, 1, %target_opts);
+ $this->set_targetbuildsystem($target_system);
+ }
+
+ $this->{'_is_targetbuildsystem'} = $opts{'_is_targetbuildsystem'}
+ if exists($opts{'_is_targetbuildsystem'});
+
+ if (exists $opts{sourcedir}) {
+ # Get relative sourcedir abs_path (without symlinks)
+ my $abspath = Cwd::abs_path($opts{sourcedir});
+ if (! -d $abspath || $abspath !~ /^\Q$this->{cwd}\E/) {
+ error("invalid or non-existing path to the source directory: ".$opts{sourcedir});
+ }
+ $this->{sourcedir} = File::Spec->abs2rel($abspath, $this->{cwd});
+ }
+ if (exists $opts{builddir}) {
+ $this->_set_builddir($opts{builddir});
+ }
+ if (defined $opts{parallel}) {
+ $this->{parallel} = $opts{parallel};
+ }
+
+ return $this;
+}
+
+# Private method to set a build directory. If undef, use default.
+# Do $this->{builddir} = undef or pass $this->get_sourcedir() to
+# unset the build directory.
+sub _set_builddir {
+ my $this=shift;
+ my $builddir=shift || $this->DEFAULT_BUILD_DIRECTORY;
+
+ if (defined $builddir) {
+ $builddir = $this->canonpath($builddir); # Canonicalize
+
+ # Sanitize $builddir
+ if ($builddir =~ m#^\.\./#) {
+ # We can't handle those as relative. Make them absolute
+ $builddir = File::Spec->catdir($this->{cwd}, $builddir);
+ }
+ elsif ($builddir =~ /\Q$this->{cwd}\E/) {
+ $builddir = File::Spec->abs2rel($builddir, $this->{cwd});
+ }
+
+ # If build directory ends up the same as source directory, drop it
+ if ($builddir eq $this->get_sourcedir()) {
+ $builddir = undef;
+ }
+ }
+ $this->{builddir} = $builddir;
+ # Use get as guard because this method is (also) called from the
+ # constructor before the target build system is setup.
+ if ($this->get_targetbuildsystem) {
+ $this->get_targetbuildsystem->{builddir} = $builddir;
+ };
+ return $builddir;
+}
+
+sub set_targetbuildsystem {
+ my ($this, $target_system) = @_;
+ my $ok = 0;
+ my $target_bs_name = $target_system->NAME;
+ if (not $this->IS_GENERATOR_BUILD_SYSTEM) {
+ my $name = $this->NAME;
+ error("Cannot set a target build system: Buildsystem ${name} is not a generator build system");
+ }
+ for my $supported_bs_name ($this->SUPPORTED_TARGET_BUILD_SYSTEMS) {
+ if ($supported_bs_name eq $target_bs_name) {
+ $ok = 1;
+ last;
+ }
+ }
+ if (not $ok) {
+ my $name = $this->NAME;
+ error("Buildsystem ${name} does not support ${target_bs_name} as target build system.");
+ }
+ $this->{'targetbuildsystem'} = $target_system
+}
+
+sub _is_targetbuildsystem {
+ my ($this) = @_;
+ return 0 if not exists($this->{'_is_targetbuildsystem'});
+ return $this->{'_is_targetbuildsystem'};
+}
+
+# Returns the target build system if it is provided
+sub get_targetbuildsystem {
+ my $this = shift;
+ return if not exists($this->{'targetbuildsystem'});
+ return $this->{'targetbuildsystem'};
+}
+
+# This instance method is called to check if the build system is able
+# to build a source package. It will be called during the build
+# system auto-selection process, inside the root directory of the debian
+# source package. The current build step is passed as an argument.
+# Return 0 if the source is not buildable, or a positive integer
+# otherwise.
+#
+# Generally, it is enough to look for invariant unique build system
+# files shipped with clean source to determine if the source might
+# be buildable or not. However, if the build system is derived from
+# another other auto-buildable build system, this method
+# may also check if the source has already been built with this build
+# system partially by looking for temporary files or other common
+# results the build system produces during the build process. The
+# latter checks must be unique to the current build system and must
+# be very unlikely to be true for either its parent or other build
+# systems. If it is determined that the source has already built
+# partially with this build system, the value returned must be
+# greater than the one of the SUPER call.
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step)=@_;
+ return 0;
+}
+
+# Derived class can call this method in its constructor
+# to enforce in source building even if the user requested otherwise.
+sub enforce_in_source_building {
+ my $this=shift;
+ if ($this->get_builddir()) {
+ $this->{warn_insource} = 1;
+ $this->{builddir} = undef;
+ }
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->enforce_in_source_building(@_);
+ # Only warn in one build system.
+ delete($this->{warn_insource});
+ }
+}
+
+# Derived class can call this method in its constructor to *prefer*
+# out of source building. Unless build directory has already been
+# specified building will proceed in the DEFAULT_BUILD_DIRECTORY or
+# the one specified in the 'builddir' named parameter (which may
+# match the source directory). Typically you should pass @_ from
+# the constructor to this call.
+sub prefer_out_of_source_building {
+ my $this=shift;
+ my %args=@_;
+ if (!defined $this->get_builddir()) {
+ if (!$this->_set_builddir($args{builddir}) && !$args{builddir}) {
+ # If we are here, DEFAULT_BUILD_DIRECTORY matches
+ # the source directory, building might fail.
+ error("default build directory is the same as the source directory." .
+ " Please specify a custom build directory");
+ }
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->prefer_out_of_source_building(@_);
+ }
+ }
+}
+
+# Enhanced version of File::Spec::canonpath. It collapses ..
+# too so it may return invalid path if symlinks are involved.
+# On the other hand, it does not need for the path to exist.
+sub canonpath {
+ my ($this, $path)=@_;
+ my @canon;
+ my $back=0;
+ foreach my $comp (split(m%/+%, $path)) {
+ if ($comp eq '.') {
+ next;
+ }
+ elsif ($comp eq '..') {
+ if (@canon > 0) { pop @canon; } else { $back++; }
+ }
+ else {
+ push @canon, $comp;
+ }
+ }
+ return (@canon + $back > 0) ? join('/', ('..')x$back, @canon) : '.';
+}
+
+# Given both $path and $base are relative to the $root, converts and
+# returns path of $path being relative to the $base. If either $path or
+# $base is absolute, returns another $path (converted to) absolute.
+sub _rel2rel {
+ my ($this, $path, $base, $root)=@_;
+ $root = $this->{cwd} unless defined $root;
+
+ if (File::Spec->file_name_is_absolute($path)) {
+ return $path;
+ }
+ elsif (File::Spec->file_name_is_absolute($base)) {
+ return File::Spec->rel2abs($path, $root);
+ }
+ else {
+ return File::Spec->abs2rel(
+ File::Spec->rel2abs($path, $root),
+ File::Spec->rel2abs($base, $root)
+ );
+ }
+}
+
+# Get path to the source directory
+# (relative to the current (top) directory)
+sub get_sourcedir {
+ my $this=shift;
+ return $this->{sourcedir};
+}
+
+# Convert path relative to the source directory to the path relative
+# to the current (top) directory.
+sub get_sourcepath {
+ my ($this, $path)=@_;
+ return File::Spec->catfile($this->get_sourcedir(), $path);
+}
+
+# Get path to the build directory if it was specified
+# (relative to the current (top) directory). undef if the same
+# as the source directory.
+sub get_builddir {
+ my $this=shift;
+ return $this->{builddir};
+}
+
+# Convert path that is relative to the build directory to the path
+# that is relative to the current (top) directory.
+# If $path is not specified, always returns build directory path
+# relative to the current (top) directory regardless if builddir was
+# specified or not.
+sub get_buildpath {
+ my ($this, $path)=@_;
+ my $builddir = $this->get_builddir() || $this->get_sourcedir();
+ if (defined $path) {
+ return File::Spec->catfile($builddir, $path);
+ }
+ return $builddir;
+}
+
+# When given a relative path to the source directory, converts it
+# to the path that is relative to the build directory. If $path is
+# not given, returns a path to the source directory that is relative
+# to the build directory.
+sub get_source_rel2builddir {
+ my $this=shift;
+ my $path=shift;
+
+ my $dir = '.';
+ if ($this->get_builddir()) {
+ $dir = $this->_rel2rel($this->get_sourcedir(), $this->get_builddir());
+ }
+ if (defined $path) {
+ return File::Spec->catfile($dir, $path);
+ }
+ return $dir;
+}
+
+sub get_parallel {
+ my $this=shift;
+ return $this->{parallel};
+}
+
+# This parallel support for the given step
+sub disable_parallel {
+ my ($this) = @_;
+ $this->{parallel} = 1;
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->disable_parallel;
+ }
+}
+
+# When given a relative path to the build directory, converts it
+# to the path that is relative to the source directory. If $path is
+# not given, returns a path to the build directory that is relative
+# to the source directory.
+sub get_build_rel2sourcedir {
+ my $this=shift;
+ my $path=shift;
+
+ my $dir = '.';
+ if ($this->get_builddir()) {
+ $dir = $this->_rel2rel($this->get_builddir(), $this->get_sourcedir());
+ }
+ if (defined $path) {
+ return File::Spec->catfile($dir, $path);
+ }
+ return $dir;
+}
+
+# Creates a build directory.
+sub mkdir_builddir {
+ my $this=shift;
+ if ($this->get_builddir()) {
+ mkdirs($this->get_builddir());
+ }
+}
+
+sub check_auto_buildable_clean_oos_buildir {
+ my $this = shift;
+ my ($step) = @_;
+ # This only applies to clean
+ return 0 if $step ne 'clean';
+ my $builddir = $this->get_builddir;
+ # If there is no builddir, then this rule does not apply.
+ return 0 if not defined($builddir) or not -d $builddir;
+ return 1;
+}
+
+sub _generic_doit_in_dir {
+ my ($this, $dir, $sub, @args) = @_;
+ my %args;
+ if (ref($args[0])) {
+ %args = %{shift(@args)};
+ }
+ $args{chdir} = $dir;
+ return $sub->(\%args, @args);
+}
+
+# Changes working directory to the source directory (if needed),
+# calls print_and_doit(@_) and changes working directory back to the
+# top directory.
+sub doit_in_sourcedir {
+ my ($this, @args) = @_;
+ $this->_generic_doit_in_dir($this->get_sourcedir, \&print_and_doit, @args);
+ return 1;
+}
+
+# Changes working directory to the source directory (if needed),
+# calls print_and_doit(@_) and changes working directory back to the
+# top directory. Errors are ignored.
+sub doit_in_sourcedir_noerror {
+ my ($this, @args) = @_;
+ return $this->_generic_doit_in_dir($this->get_sourcedir, \&print_and_doit_noerror, @args);
+}
+
+# Changes working directory to the build directory (if needed),
+# calls print_and_doit(@_) and changes working directory back to the
+# top directory.
+sub doit_in_builddir {
+ my ($this, @args) = @_;
+ $this->_generic_doit_in_dir($this->get_buildpath, \&print_and_doit, @args);
+ return 1;
+}
+
+# Changes working directory to the build directory (if needed),
+# calls print_and_doit(@_) and changes working directory back to the
+# top directory. Errors are ignored.
+sub doit_in_builddir_noerror {
+ my ($this, @args) = @_;
+ return $this->_generic_doit_in_dir($this->get_buildpath, \&print_and_doit_noerror, @args);
+}
+
+# In case of out of source tree building, whole build directory
+# gets wiped (if it exists) and 1 is returned. If build directory
+# had 2 or more levels, empty parent directories are also deleted.
+# If build directory does not exist, nothing is done and 0 is returned.
+sub rmdir_builddir {
+ my $this=shift;
+ my $only_empty=shift;
+ if ($this->get_builddir()) {
+ my $buildpath = $this->get_buildpath();
+ if (-d $buildpath) {
+ my @dir = File::Spec->splitdir($this->get_build_rel2sourcedir());
+ my $peek;
+ if (not $only_empty) {
+ doit("rm", "-rf", $buildpath);
+ pop @dir;
+ }
+ # If build directory is relative and had 2 or more levels, delete
+ # empty parent directories until the source or top directory level.
+ if (not File::Spec->file_name_is_absolute($buildpath)) {
+ while (($peek=pop @dir) && $peek ne '.' && $peek ne '..') {
+ my $dir = $this->get_sourcepath(File::Spec->catdir(@dir, $peek));
+ doit("rmdir", "--ignore-fail-on-non-empty", $dir);
+ last if -d $dir;
+ }
+ }
+ }
+ return 1;
+ }
+ return 0;
+}
+
+# Instance method that is called before performing any step (see below).
+# Action name is passed as an argument. Derived classes overriding this
+# method should also call SUPER implementation of it.
+sub pre_building_step {
+ my $this=shift;
+ my ($step)=@_;
+
+ # Warn if in source building was enforced but build directory was
+ # specified. See enforce_in_source_building().
+ if ($this->{warn_insource}) {
+ warning("warning: " . $this->NAME() .
+ " does not support building out of source tree. In source building enforced.");
+ delete $this->{warn_insource};
+ }
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->pre_building_step(@_);
+ }
+}
+
+# Instance method that is called after performing any step (see below).
+# Action name is passed as an argument. Derived classes overriding this
+# method should also call SUPER implementation of it.
+sub post_building_step {
+ my $this=shift;
+ my ($step)=@_;
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->post_building_step(@_);
+ }
+}
+
+# The instance methods below provide support for configuring,
+# building, testing, install and cleaning source packages.
+# In case of failure, the method may just error() out.
+#
+# These methods should be overridden by derived classes to
+# implement build system specific steps needed to build the
+# source. Arbitrary number of custom step arguments might be
+# passed. Default implementations do nothing.
+#
+# Note: For generator build systems, the default is to
+# delegate the step to the target build system for all
+# steps except configure.
+sub configure {
+ my $this=shift;
+}
+
+sub build {
+ my $this=shift;
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->build(@_);
+ }
+}
+
+sub test {
+ my $this=shift;
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->test(@_);
+ }
+}
+
+# destdir parameter specifies where to install files.
+sub install {
+ my $this=shift;
+ my ($destdir) = @_;
+
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->install(@_);
+ }
+}
+
+sub clean {
+ my $this=shift;
+
+ if ($this->IS_GENERATOR_BUILD_SYSTEM) {
+ $this->get_targetbuildsystem->clean(@_);
+ }
+}
+
+
+sub _create_buildsystem_instance {
+ my ($full_name, $required, %bsopts) = @_;
+ my @parts = split(m{[+]}, $full_name, 2);
+ my $name = $parts[0];
+ my $module = "Debian::Debhelper::Buildsystem::$name";
+ if (@parts > 1) {
+ if (exists($bsopts{'targetbuildsystem'})) {
+ error("Conflicting target buildsystem for ${name} (load as ${full_name}, but target configured in bsopts)");
+ }
+ $bsopts{'targetbuildsystem'} = $parts[1];
+ }
+
+ eval "use $module";
+ if ($@) {
+ return if not $required;
+ error("unable to load build system class '$name': $@");
+ }
+ return $module->new(%bsopts);
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/ant.pm b/lib/Debian/Debhelper/Buildsystem/ant.pm
new file mode 100644
index 0000000..49aaf1e
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/ant.pm
@@ -0,0 +1,52 @@
+# A debhelper build system class for handling Ant based projects.
+#
+# Copyright: © 2009 Joey Hess
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::ant;
+
+use strict;
+use warnings;
+use parent qw(Debian::Debhelper::Buildsystem);
+
+sub DESCRIPTION {
+ "Ant (build.xml)"
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ return (-e $this->get_sourcepath("build.xml")) ? 1 : 0;
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->enforce_in_source_building();
+ return $this;
+}
+
+sub build {
+ my $this=shift;
+ my $d_ant_prop = $this->get_sourcepath('debian/ant.properties');
+ my @args;
+ if ( -f $d_ant_prop ) {
+ push(@args, '-propertyfile', $d_ant_prop);
+ }
+
+ # Set the username to improve the reproducibility
+ push(@args, "-Duser.name", "debian");
+
+ $this->doit_in_sourcedir("ant", @args, @_);
+}
+
+sub clean {
+ my $this=shift;
+ my $d_ant_prop = $this->get_sourcepath('debian/ant.properties');
+ my @args;
+ if ( -f $d_ant_prop ) {
+ push(@args, '-propertyfile', $d_ant_prop);
+ }
+ $this->doit_in_sourcedir("ant", @args, "clean", @_);
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/autoconf.pm b/lib/Debian/Debhelper/Buildsystem/autoconf.pm
new file mode 100644
index 0000000..8752ea1
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/autoconf.pm
@@ -0,0 +1,98 @@
+# A debhelper build system class for handling Autoconf based projects
+#
+# Copyright: © 2008 Joey Hess
+# © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::autoconf;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(%dh dpkg_architecture_value get_buildoption sourcepackage compat);
+use parent qw(Debian::Debhelper::Buildsystem::makefile);
+
+sub DESCRIPTION {
+ "GNU Autoconf (configure)"
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step)=@_;
+
+ return 0 unless -f $this->get_sourcepath("configure") &&
+ -x _;
+
+ # Handle configure explicitly; inherit the rest
+ return 1 if $step eq "configure";
+ return $this->SUPER::check_auto_buildable(@_);
+}
+
+sub configure {
+ my $this=shift;
+
+ # Standard set of options for configure.
+ my @opts;
+ push @opts, "--build=" . dpkg_architecture_value("DEB_BUILD_GNU_TYPE");
+ push @opts, "--prefix=/usr";
+ push @opts, "--includedir=\${prefix}/include";
+ push @opts, "--mandir=\${prefix}/share/man";
+ push @opts, "--infodir=\${prefix}/share/info";
+ push @opts, "--sysconfdir=/etc";
+ push @opts, "--localstatedir=/var";
+ # We pass --disable/enable-* options that might be unknown, so we
+ # should not emit warnings.
+ push @opts, "--disable-option-checking";
+ if ($dh{QUIET}) {
+ push @opts, "--enable-silent-rules";
+ } else {
+ push @opts, "--disable-silent-rules";
+ }
+ my $multiarch=dpkg_architecture_value("DEB_HOST_MULTIARCH");
+ if (! compat(8)) {
+ if (defined $multiarch) {
+ push @opts, "--libdir=\${prefix}/lib/$multiarch";
+ push(@opts, "--libexecdir=\${prefix}/lib/$multiarch") if compat(11);
+ }
+ else {
+ push(@opts, "--libexecdir=\${prefix}/lib") if compat(11);
+ }
+ }
+ else {
+ push @opts, "--libexecdir=\${prefix}/lib/" . sourcepackage();
+ }
+ push @opts, "--runstatedir=/run" if not compat(10);
+ push @opts, "--disable-maintainer-mode";
+ push @opts, "--disable-dependency-tracking";
+ # Provide --host only if different from --build, as recommended in
+ # autotools-dev README.Debian: When provided (even if equal)
+ # autoconf 2.52+ switches to cross-compiling mode.
+ if (dpkg_architecture_value("DEB_BUILD_GNU_TYPE")
+ ne dpkg_architecture_value("DEB_HOST_GNU_TYPE")) {
+ push @opts, "--host=" . dpkg_architecture_value("DEB_HOST_GNU_TYPE");
+ }
+
+ $this->mkdir_builddir();
+ eval {
+ $this->doit_in_builddir($this->get_source_rel2builddir("configure"), @opts, @_);
+ };
+ if ($@) {
+ if (-e $this->get_buildpath("config.log")) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'config.log');
+ }
+ die $@;
+ }
+}
+
+sub test {
+ my $this=shift;
+
+ my $parallel = $this->get_parallel();
+ my @autotest;
+ push @autotest, "-j$parallel";
+ push @autotest, "--verbose" if not get_buildoption("terse");
+ $this->make_first_existing_target(['test', 'check'],
+ "TESTSUITEFLAGS=@autotest",
+ "VERBOSE=1", @_);
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/cmake.pm b/lib/Debian/Debhelper/Buildsystem/cmake.pm
new file mode 100644
index 0000000..c4a2ad9
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/cmake.pm
@@ -0,0 +1,202 @@
+# A debhelper build system class for handling CMake based projects.
+# It prefers out of source tree building.
+#
+# Copyright: © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::cmake;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(%dh compat dpkg_architecture_value error is_cross_compiling get_buildoption print_and_doit);
+use parent qw(Debian::Debhelper::Buildsystem);
+
+my @STANDARD_CMAKE_FLAGS = qw(
+ -DCMAKE_INSTALL_PREFIX=/usr
+ -DCMAKE_BUILD_TYPE=None
+ -DCMAKE_INSTALL_SYSCONFDIR=/etc
+ -DCMAKE_INSTALL_LOCALSTATEDIR=/var
+ -DCMAKE_EXPORT_NO_PACKAGE_REGISTRY=ON
+ -DCMAKE_FIND_USE_PACKAGE_REGISTRY=OFF
+ -DCMAKE_FIND_PACKAGE_NO_PACKAGE_REGISTRY=ON
+ -DFETCHCONTENT_FULLY_DISCONNECTED=ON
+);
+
+my %DEB_HOST2CMAKE_SYSTEM = (
+ 'linux' => 'Linux',
+ 'kfreebsd' => 'kFreeBSD',
+ 'hurd' => 'GNU',
+);
+
+my %GNU_CPU2SYSTEM_PROCESSOR = (
+ 'arm' => 'armv7l',
+ 'mips64el' => 'mips64',
+ 'powerpc64le' => 'ppc64le',
+);
+
+my %TARGET_BUILD_SYSTEM2CMAKE_GENERATOR = (
+ 'makefile' => 'Unix Makefiles',
+ 'ninja' => 'Ninja',
+);
+
+sub DESCRIPTION {
+ "CMake (CMakeLists.txt)"
+}
+
+sub IS_GENERATOR_BUILD_SYSTEM {
+ return 1;
+}
+
+sub SUPPORTED_TARGET_BUILD_SYSTEMS {
+ return qw(makefile ninja);
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step)=@_;
+ if (-e $this->get_sourcepath("CMakeLists.txt")) {
+ my $ret = ($step eq "configure" && 1) ||
+ $this->get_targetbuildsystem->check_auto_buildable(@_);
+ if ($this->check_auto_buildable_clean_oos_buildir(@_)) {
+ # Assume that the package can be cleaned (i.e. the build directory can
+ # be removed) as long as it is built out-of-source tree and can be
+ # configured.
+ $ret++ if not $ret;
+ }
+ # Existence of CMakeCache.txt indicates cmake has already
+ # been used by a prior build step, so should be used
+ # instead of the parent makefile class.
+ $ret++ if ($ret && -e $this->get_buildpath("CMakeCache.txt"));
+ return $ret;
+ }
+ return 0;
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->prefer_out_of_source_building(@_);
+ return $this;
+}
+
+sub configure {
+ my $this=shift;
+ # Standard set of cmake flags
+ my @flags = @STANDARD_CMAKE_FLAGS;
+ my $backend = $this->get_targetbuildsystem->NAME;
+
+ push(@flags, '-DCMAKE_INSTALL_RUNSTATEDIR=/run') if not compat(10);
+ # Speed up installation phase a bit.
+ push(@flags, "-DCMAKE_SKIP_INSTALL_ALL_DEPENDENCY=ON") if not compat(12);
+ # Reproducibility #962474 / #1004939
+ push(@flags, '-DCMAKE_BUILD_RPATH_USE_ORIGIN=ON') if not compat(13);
+ if (exists($TARGET_BUILD_SYSTEM2CMAKE_GENERATOR{$backend})) {
+ my $generator = $TARGET_BUILD_SYSTEM2CMAKE_GENERATOR{$backend};
+ push(@flags, "-G${generator}");
+ }
+ if (not $dh{QUIET}) {
+ push(@flags, "-DCMAKE_VERBOSE_MAKEFILE=ON");
+ }
+
+ if ($ENV{CC}) {
+ push @flags, "-DCMAKE_C_COMPILER=" . $ENV{CC};
+ }
+ if ($ENV{CXX}) {
+ push @flags, "-DCMAKE_CXX_COMPILER=" . $ENV{CXX};
+ }
+ if (is_cross_compiling()) {
+ my $deb_host = dpkg_architecture_value("DEB_HOST_ARCH_OS");
+ if (my $cmake_system = $DEB_HOST2CMAKE_SYSTEM{$deb_host}) {
+ push(@flags, "-DCMAKE_SYSTEM_NAME=${cmake_system}");
+ } else {
+ error("Cannot cross-compile - CMAKE_SYSTEM_NAME not known for ${deb_host}");
+ }
+ my $gnu_cpu = dpkg_architecture_value("DEB_HOST_GNU_CPU");
+ if (exists($GNU_CPU2SYSTEM_PROCESSOR{$gnu_cpu})) {
+ push @flags, "-DCMAKE_SYSTEM_PROCESSOR=" . $GNU_CPU2SYSTEM_PROCESSOR{$gnu_cpu};
+ } else {
+ push @flags, "-DCMAKE_SYSTEM_PROCESSOR=${gnu_cpu}";
+ }
+ if (not $ENV{CC}) {
+ push @flags, "-DCMAKE_C_COMPILER=" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-gcc";
+ }
+ if (not $ENV{CXX}) {
+ push @flags, "-DCMAKE_CXX_COMPILER=" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-g++";
+ }
+ push(@flags, "-DPKG_CONFIG_EXECUTABLE=/usr/bin/" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-pkg-config");
+ push(@flags, "-DPKGCONFIG_EXECUTABLE=/usr/bin/" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-pkg-config");
+ push(@flags, "-DQMAKE_EXECUTABLE=/usr/bin/" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-qmake");
+ }
+ push(@flags, "-DCMAKE_INSTALL_LIBDIR=lib/" . dpkg_architecture_value("DEB_HOST_MULTIARCH"));
+
+ # CMake doesn't respect CPPFLAGS, see #653916.
+ if ($ENV{CPPFLAGS} && ! compat(8)) {
+ $ENV{CFLAGS} .= ' ' . $ENV{CPPFLAGS};
+ $ENV{CXXFLAGS} .= ' ' . $ENV{CPPFLAGS};
+ }
+
+ $this->mkdir_builddir();
+ eval {
+ $this->doit_in_builddir("cmake", @flags, @_, $this->get_source_rel2builddir());
+ };
+ if (my $err = $@) {
+ if (-e $this->get_buildpath("CMakeCache.txt")) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'CMakeCache.txt');
+ }
+ if (-e $this->get_buildpath('CMakeFiles/CMakeOutput.log')) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'CMakeFiles/CMakeOutput.log');
+ }
+ if (-e $this->get_buildpath('CMakeFiles/CMakeError.log')) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'CMakeFiles/CMakeError.log');
+ }
+ die $err;
+ }
+}
+
+sub build {
+ my $this=shift;
+ my $target = $this->get_targetbuildsystem;
+ if ($target->NAME eq 'makefile') {
+ # Add VERBOSE=1 for #973029 when not asked to be quiet/terse.
+ push(@_, "VERBOSE=1") if not $dh{QUIET};
+ }
+ return $this->SUPER::build(@_);
+}
+
+sub test {
+ my $this=shift;
+ my $target = $this->get_targetbuildsystem;
+ $ENV{CTEST_OUTPUT_ON_FAILURE} = 1;
+ if ($target->NAME eq 'makefile') {
+ # Unlike make, CTest does not have "unlimited parallel" setting (-j implies
+ # -j1). So in order to simulate unlimited parallel, allow to fork a huge
+ # number of threads instead.
+ my $parallel = ($this->get_parallel() > 0) ? $this->get_parallel() : 999;
+ unshift(@_, "ARGS+=-j$parallel");
+ unshift(@_, "ARGS+=--verbose") if not get_buildoption("terse");
+ }
+ return $this->SUPER::test(@_);
+}
+
+sub install {
+ my $this = shift;
+ my $target = $this->get_targetbuildsystem;
+
+ if (compat(13)) {
+ $target->install(@_);
+ } else {
+ # In compat 14 `cmake --install` is preferred to `make install`,
+ # see https://bugs.debian.org/1020732
+ my $destdir = shift;
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ 'DESTDIR' => $destdir,
+ }
+ );
+ print_and_doit(\%options, 'cmake', '--install', $this->get_buildpath, @_);
+ }
+ return 1;
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/makefile.pm b/lib/Debian/Debhelper/Buildsystem/makefile.pm
new file mode 100644
index 0000000..856a6dd
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/makefile.pm
@@ -0,0 +1,204 @@
+# A debhelper build system class for handling simple Makefile based projects.
+#
+# Copyright: © 2008 Joey Hess
+# © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::makefile;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(dpkg_architecture_value escape_shell clean_jobserver_makeflags is_cross_compiling compat
+ should_use_root gain_root_cmd error);
+use parent qw(Debian::Debhelper::Buildsystem);
+
+my %DEB_DEFAULT_TOOLS = (
+ 'CC' => 'gcc',
+ 'CXX' => 'g++',
+ 'PKG_CONFIG' => 'pkg-config',
+);
+
+# make makes things difficult by not providing a simple way to test
+# whether a Makefile target exists. Using -n and checking for a nonzero
+# exit status is not good enough, because even with -n, make will
+# run commands needed to eg, generate include files -- and those commands
+# could fail even though the target exists -- and we should let the target
+# run and propagate any failure.
+#
+# Using -n and checking for at least one line of output is better.
+# That will indicate make either wants to run one command, or
+# has output a "nothing to be done" message if the target exists but is a
+# noop.
+#
+# However, that heuristic is also not good enough, because a Makefile
+# could run code that outputs something, even though the -n is asking
+# it not to run anything. (Again, done for includes.) To detect this false
+# positive, there is unfortunately only one approach left: To
+# look for the error message printed by make when a target does not exist.
+#
+# This could break if make's output changes. It would only break a minority
+# of packages where this latter test is needed. The best way to avoid that
+# problem would be to fix make to have this simple and highly useful
+# missing feature.
+#
+# A final option would be to use -p and parse the output data base.
+# It's more practical for dh to use that method, since it operates on
+# only special debian/rules files, and not arbitrary Makefiles which
+# can be arbitrarily complicated, use implicit targets, and so on.
+sub exists_make_target {
+ my $this=shift;
+ my $target=shift;
+
+ my @opts=("-s", "-n", "--no-print-directory");
+ my $buildpath = $this->get_buildpath();
+ unshift @opts, "-C", $buildpath if $buildpath ne ".";
+
+ my $pid = open(MAKE, "-|");
+ defined($pid) || error("fork failed: $!");
+ if (! $pid) {
+ open(STDERR, ">&STDOUT");
+ $ENV{LC_ALL}='C';
+ exec($this->{makecmd}, @opts, $target, @_);
+ exit(1);
+ }
+
+ local $/=undef;
+ my $output=<MAKE>;
+ chomp $output;
+ close MAKE;
+
+ return defined $output
+ && length $output
+ && $output !~ /\*\*\* No rule to make target (`|')\Q$target\E'/;
+}
+
+sub do_make {
+ my $this=shift;
+
+ # Avoid possible warnings about unavailable jobserver,
+ # and force make to start a new jobserver.
+ clean_jobserver_makeflags();
+
+ # Note that this will override any -j settings in MAKEFLAGS.
+ my $parallel = $this->get_parallel();
+ if ($parallel == 0 or $parallel > 1) {
+ # We have to use the empty string for "unlimited"
+ $parallel = '' if $parallel == 0;
+ unshift(@_, "-j${parallel}");
+ } else {
+ unshift(@_, '-j1');
+ }
+
+ my @root_cmd;
+ if (exists($this->{_run_make_as_root}) and $this->{_run_make_as_root}) {
+ @root_cmd = gain_root_cmd();
+ }
+ $this->doit_in_builddir(@root_cmd, $this->{makecmd}, @_);
+}
+
+sub make_first_existing_target {
+ my $this=shift;
+ my $targets=shift;
+
+ foreach my $target (@$targets) {
+ if ($this->exists_make_target($target, @_)) {
+ $this->do_make($target, @_);
+ return $target;
+ }
+ }
+ return undef;
+}
+
+sub DESCRIPTION {
+ "simple Makefile"
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->{makecmd} = (exists $ENV{MAKE}) ? $ENV{MAKE} : "make";
+ return $this;
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step) = @_;
+
+ if (-e $this->get_buildpath("Makefile") ||
+ -e $this->get_buildpath("makefile") ||
+ -e $this->get_buildpath("GNUmakefile"))
+ {
+ # This is always called in the source directory, but generally
+ # Makefiles are created (or live) in the build directory.
+ return 1;
+ } elsif ($this->check_auto_buildable_clean_oos_buildir(@_)
+ and $this->check_auto_buildable('configure')) {
+ # Assume that the package can be cleaned (i.e. the build directory can
+ # be removed) as long as it is built out-of-source tree and can be
+ # configured. This is useful for derivative buildsystems which
+ # generate Makefiles.
+ return 1;
+ }
+ return 0;
+}
+
+sub _should_inject_cross_build_tools {
+ my ($this) = @_;
+ return ref($this) eq 'Debian::Debhelper::Buildsystem::makefile';
+}
+
+
+sub build {
+ my $this=shift;
+ if (not $this->_is_targetbuildsystem
+ and is_cross_compiling()
+ and $this->_should_inject_cross_build_tools) {
+ # Only inject build tools variables during cross-compile when
+ # makefile is the explicit *main* build system.
+ for my $var (sort(keys(%DEB_DEFAULT_TOOLS))) {
+ my $tool = $DEB_DEFAULT_TOOLS{$var};
+ if ($ENV{$var}) {
+ unshift @_, $var . "=" . $ENV{$var};
+ } else {
+ unshift @_, $var . "=" . dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-" . $tool;
+ }
+ }
+ }
+ if (ref($this) eq 'Debian::Debhelper::Buildsystem::makefile' and not compat(10)) {
+ unshift @_, "INSTALL=install --strip-program=true";
+ }
+ $this->do_make(@_);
+}
+
+sub test {
+ my $this=shift;
+ $this->make_first_existing_target(['test', 'check'], @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+ if (ref($this) eq 'Debian::Debhelper::Buildsystem::makefile' and not compat(10)) {
+ unshift @_, "INSTALL=install --strip-program=true";
+ }
+ if ( -f $this->get_buildpath('libtool')) {
+ $this->disable_parallel();
+ }
+
+ if (should_use_root('debhelper/upstream-make-install') and $< != 0) {
+ $this->{_run_make_as_root} = 1;
+ }
+
+ $this->make_first_existing_target(['install'],
+ "DESTDIR=$destdir",
+ "AM_UPDATE_INFO_DIR=no", @_);
+}
+
+sub clean {
+ my $this=shift;
+ if (!$this->rmdir_builddir()) {
+ $this->make_first_existing_target(['distclean', 'realclean', 'clean'], @_);
+ }
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/meson.pm b/lib/Debian/Debhelper/Buildsystem/meson.pm
new file mode 100644
index 0000000..3cd447d
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/meson.pm
@@ -0,0 +1,158 @@
+# A debhelper build system class for handling Meson based projects.
+#
+# Copyright: © 2017 Michael Biebl
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::meson;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat dpkg_architecture_value is_cross_compiling doit warning error generated_file);
+use parent qw(Debian::Debhelper::Buildsystem);
+
+sub DESCRIPTION {
+ "Meson (meson.build)"
+}
+
+sub IS_GENERATOR_BUILD_SYSTEM {
+ return 1;
+}
+
+sub SUPPORTED_TARGET_BUILD_SYSTEMS {
+ return qw(ninja);
+}
+
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step)=@_;
+
+ return 0 unless -e $this->get_sourcepath("meson.build");
+
+ # Handle configure explicitly; inherit the rest
+ return 1 if $step eq "configure";
+ my $ret = $this->get_targetbuildsystem->check_auto_buildable(@_);
+ if ($ret == 0 and $this->check_auto_buildable_clean_oos_buildir(@_)) {
+ # Assume that the package can be cleaned (i.e. the build directory can
+ # be removed) as long as it is built out-of-source tree and can be
+ # configured.
+ $ret++;
+ }
+ return $ret;
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->prefer_out_of_source_building(@_);
+ return $this;
+}
+
+sub configure {
+ my $this=shift;
+
+ # Standard set of options for meson.
+ my @opts = (
+ '--wrap-mode=nodownload',
+ );
+ push @opts, "--buildtype=plain";
+ push @opts, "--prefix=/usr";
+ push @opts, "--sysconfdir=/etc";
+ push @opts, "--localstatedir=/var";
+ my $multiarch=dpkg_architecture_value("DEB_HOST_MULTIARCH");
+ push @opts, "--libdir=lib/$multiarch";
+ push(@opts, "--libexecdir=lib/$multiarch") if compat(11);
+
+ if (is_cross_compiling()) {
+ # http://mesonbuild.com/Cross-compilation.html
+ my $cross_file = $ENV{'DH_MESON_CROSS_FILE'};
+ if (not $cross_file) {
+ my $debcrossgen = '/usr/share/meson/debcrossgen';
+ if (not -x $debcrossgen) {
+ warning("Missing debcrossgen (${debcrossgen}) cannot generate a meson cross file and non was provided");
+ error("Cannot cross-compile: Please use meson (>= 0.42.1) or provide a cross file via DH_MESON_CROSS_FILE");
+ }
+ my $filename = generated_file('_source', 'meson-cross-file.conf');
+ my %options = (
+ stdout => '/dev/null',
+ update_env => { LC_ALL => 'C.UTF-8'},
+ );
+ doit(\%options, $debcrossgen, "-o${filename}");
+ $cross_file = $filename;
+ }
+ if ($cross_file !~ m{^/}) {
+ # Make the file name absolute as meson will be called from the build dir.
+ require Cwd;
+ $cross_file =~ s{^\./}{};
+ $cross_file = Cwd::getcwd() . "/${cross_file}";
+ }
+ push(@opts, '--cross-file', $cross_file);
+ }
+
+ $this->mkdir_builddir();
+ eval {
+ my %options = (
+ update_env => { LC_ALL => 'C.UTF-8'},
+ );
+ $this->doit_in_builddir(\%options, "meson", "setup", $this->get_source_rel2builddir(), @opts, @_);
+ };
+ if ($@) {
+ if (-e $this->get_buildpath("meson-logs/meson-log.txt")) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'meson-logs/meson-log.txt');
+ }
+ die $@;
+ }
+}
+
+sub test {
+ my $this = shift;
+ my $target = $this->get_targetbuildsystem;
+
+ eval {
+ if (compat(12) or $target->NAME ne 'ninja') {
+ $target->test(@_);
+ } else {
+ # In compat 13 with meson+ninja, we prefer using "meson test"
+ # over "ninja test"
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ }
+ );
+ if ($this->get_parallel() > 0) {
+ $options{update_env}{MESON_TESTTHREADS} = $this->get_parallel();
+ }
+ $this->doit_in_builddir(\%options, 'meson', 'test', @_);
+ }
+ };
+ if (my $err = $@) {
+ if (-e $this->get_buildpath("meson-logs/testlog.txt")) {
+ $this->doit_in_builddir('tail', '-v', '-n', '+0', 'meson-logs/testlog.txt');
+ }
+ die $err;
+ }
+ return 1;
+}
+
+sub install {
+ my ($this, $destdir, @args) = @_;
+ my $target = $this->get_targetbuildsystem;
+
+ if (compat(13) or $target->NAME ne 'ninja') {
+ $target->install($destdir, @args);
+ } else {
+ # In compat 14 with meson+ninja, we prefer using "meson install"
+ # over "ninja install"
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ }
+ );
+ $this->doit_in_builddir(\%options, 'meson', 'install', '--destdir', $destdir, @args);
+ }
+ return 1;
+}
+
+
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/ninja.pm b/lib/Debian/Debhelper/Buildsystem/ninja.pm
new file mode 100644
index 0000000..c08ff16
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/ninja.pm
@@ -0,0 +1,90 @@
+# A debhelper build system class for handling ninja based projects.
+#
+# Copyright: © 2017 Michael Biebl
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::ninja;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(%dh dpkg_architecture_value);
+use parent qw(Debian::Debhelper::Buildsystem);
+
+sub DESCRIPTION {
+ "Ninja (build.ninja)"
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->{buildcmd} = "ninja";
+ return $this;
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step) = @_;
+
+ if (-e $this->get_buildpath("build.ninja"))
+ {
+ # This is always called in the source directory, but generally
+ # Ninja files are created (or live) in the build directory.
+ return 1;
+ }
+ return 0;
+}
+
+sub build {
+ my $this=shift;
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ }
+ );
+ if (!$dh{QUIET}) {
+ unshift @_, "-v";
+ }
+ if ($this->get_parallel() > 0) {
+ unshift @_, "-j" . $this->get_parallel();
+ }
+ $this->doit_in_builddir(\%options, $this->{buildcmd}, @_);
+}
+
+sub test {
+ my $this=shift;
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ }
+ );
+ if ($this->get_parallel() > 0) {
+ $options{update_env}{MESON_TESTTHREADS} = $this->get_parallel();
+ }
+ $this->doit_in_builddir(\%options, $this->{buildcmd}, "test", @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ 'DESTDIR' => $destdir,
+ }
+ );
+ $this->doit_in_builddir(\%options, $this->{buildcmd}, "install", @_);
+}
+
+sub clean {
+ my $this=shift;
+ if (!$this->rmdir_builddir()) {
+ my %options = (
+ update_env => {
+ 'LC_ALL' => 'C.UTF-8',
+ }
+ );
+ $this->doit_in_builddir(\%options, $this->{buildcmd}, "clean", @_);
+ }
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/perl_build.pm b/lib/Debian/Debhelper/Buildsystem/perl_build.pm
new file mode 100644
index 0000000..8752905
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/perl_build.pm
@@ -0,0 +1,97 @@
+# A build system class for handling Perl Build based projects.
+#
+# Copyright: © 2008-2009 Joey Hess
+# © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::perl_build;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat is_cross_compiling perl_cross_incdir warning);
+use parent qw(Debian::Debhelper::Buildsystem);
+use Config;
+
+sub DESCRIPTION {
+ "Perl Module::Build (Build.PL)"
+}
+
+sub check_auto_buildable {
+ my ($this, $step) = @_;
+
+ # Handles everything
+ my $ret = -e $this->get_sourcepath("Build.PL");
+ if ($step ne "configure") {
+ $ret &&= -e $this->get_sourcepath("Build");
+ }
+ return $ret ? 1 : 0;
+}
+
+sub do_perl {
+ my $this=shift;
+ my %options;
+ if (is_cross_compiling()) {
+ my $cross_incdir = perl_cross_incdir();
+ if (defined $cross_incdir) {
+ my $perl5lib = $cross_incdir;
+ $perl5lib .= $Config{path_sep} . $ENV{PERL5LIB}
+ if defined $ENV{PERL5LIB};
+ $options{update_env} = { PERL5LIB => $perl5lib };
+ } else {
+ warning("cross Config.pm does not exist (missing build dependency on perl-xs-dev?)");
+ }
+ }
+ $this->doit_in_sourcedir(\%options, $^X, @_);
+}
+
+sub new {
+ my $class=shift;
+ my $this= $class->SUPER::new(@_);
+ $this->enforce_in_source_building();
+ return $this;
+}
+
+sub configure {
+ my $this=shift;
+ my (@flags, @perl_flags);
+ $ENV{PERL_MM_USE_DEFAULT}=1;
+ if ($ENV{CFLAGS} && ! compat(8)) {
+ push @flags, "--config", "optimize=$ENV{CFLAGS} $ENV{CPPFLAGS}";
+ }
+ if ($ENV{LDFLAGS} && ! compat(8)) {
+ my $ld = $Config{ld};
+ if (is_cross_compiling()) {
+ my $incdir = perl_cross_incdir();
+ $ld = qx/perl -I$incdir -MConfig -e 'print \$Config{ld}'/
+ if defined $incdir;
+ }
+ push @flags, "--config", "ld=$ld $ENV{CFLAGS} $ENV{LDFLAGS}";
+ }
+ push(@perl_flags, '-I.') if compat(10);
+ $this->do_perl(@perl_flags, "Build.PL", "--installdirs", "vendor", @flags, @_);
+}
+
+sub build {
+ my $this=shift;
+ $this->do_perl("Build", @_);
+}
+
+sub test {
+ my $this=shift;
+ $this->do_perl("Build", "test", "--verbose", 1, @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+ $this->do_perl("Build", "install", "--destdir", "$destdir", "--create_packlist", 0, @_);
+}
+
+sub clean {
+ my $this=shift;
+ if (-e $this->get_sourcepath("Build")) {
+ $this->do_perl("Build", "realclean", "--allow_mb_mismatch", 1, @_);
+ }
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/perl_makemaker.pm b/lib/Debian/Debhelper/Buildsystem/perl_makemaker.pm
new file mode 100644
index 0000000..881f1ec
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/perl_makemaker.pm
@@ -0,0 +1,104 @@
+# A debhelper build system class for handling Perl MakeMaker based projects.
+#
+# Copyright: © 2008-2009 Joey Hess
+# © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::perl_makemaker;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat is_cross_compiling perl_cross_incdir warning);
+use parent qw(Debian::Debhelper::Buildsystem::makefile);
+use Config;
+
+sub DESCRIPTION {
+ "Perl ExtUtils::MakeMaker (Makefile.PL)"
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my ($step)=@_;
+
+ # Handles everything if Makefile.PL exists. Otherwise - next class.
+ if (-e $this->get_sourcepath("Makefile.PL")) {
+ if ($step eq "configure") {
+ return 1;
+ }
+ else {
+ return $this->SUPER::check_auto_buildable(@_);
+ }
+ }
+ return 0;
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ $this->enforce_in_source_building();
+ return $this;
+}
+
+sub configure {
+ my $this=shift;
+ my (@flags, @perl_flags);
+ # If set to a true value then MakeMaker's prompt function will
+ # # always return the default without waiting for user input.
+ $ENV{PERL_MM_USE_DEFAULT}=1;
+ # This prevents Module::Install from interactive behavior.
+ $ENV{PERL_AUTOINSTALL}="--skipdeps";
+
+ if ($ENV{CFLAGS} && ! compat(8)) {
+ push @flags, "OPTIMIZE=$ENV{CFLAGS} $ENV{CPPFLAGS}";
+ }
+ my $cross_flag;
+ if (is_cross_compiling()) {
+ my $incdir = perl_cross_incdir();
+ if (defined $incdir) {
+ $cross_flag = "-I$incdir";
+ } else {
+ warning("cross Config.pm does not exist (missing build dependency on perl-xs-dev?)");
+ }
+ }
+ if ($ENV{LDFLAGS} && ! compat(8)) {
+ my $ld = $Config{ld};
+ $ld = qx/perl $cross_flag -MConfig -e 'print \$Config{ld}'/
+ if is_cross_compiling() and defined $cross_flag;
+ push @flags, "LD=$ld $ENV{CFLAGS} $ENV{LDFLAGS}";
+ }
+
+ push(@perl_flags, '-I.') if compat(10);
+
+ push @perl_flags, $cross_flag
+ if is_cross_compiling() and defined $cross_flag;
+
+ $this->doit_in_sourcedir($^X, @perl_flags, "Makefile.PL", "INSTALLDIRS=vendor",
+ # if perl_build is not tested first, need to pass packlist
+ # option to handle fallthrough case
+ (compat(7) ? "create_packlist=0" : ()),
+ @flags, @_);
+}
+
+sub test {
+ my $this=shift;
+ # Make tests verbose
+ $this->SUPER::test("TEST_VERBOSE=1", @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+
+ # Special case for Makefile.PL that uses
+ # Module::Build::Compat. PREFIX should not be passed
+ # for those; it already installs into /usr by default.
+ my $makefile=$this->get_sourcepath("Makefile");
+ if (system(qq{grep -q "generated automatically by MakeMaker" $makefile}) != 0) {
+ $this->SUPER::install($destdir, @_);
+ }
+ else {
+ $this->SUPER::install($destdir, "PREFIX=/usr", @_);
+ }
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/python_distutils.pm b/lib/Debian/Debhelper/Buildsystem/python_distutils.pm
new file mode 100644
index 0000000..e5fe7ed
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/python_distutils.pm
@@ -0,0 +1,214 @@
+# A debhelper build system class for building Python Distutils based
+# projects. It prefers out of source tree building.
+#
+# Copyright: © 2008 Joey Hess
+# © 2008-2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::python_distutils;
+
+use strict;
+use warnings;
+use Cwd ();
+use Debian::Debhelper::Dh_Lib qw(error deprecated_functionality);
+use parent qw(Debian::Debhelper::Buildsystem);
+
+sub DESCRIPTION {
+ "Python Distutils (setup.py) [DEPRECATED]"
+}
+
+sub DEFAULT_BUILD_DIRECTORY {
+ my $this=shift;
+ return $this->canonpath($this->get_sourcepath("build"));
+}
+
+sub new {
+ my $class=shift;
+ my $this=$class->SUPER::new(@_);
+ # Out of source tree building is preferred.
+ $this->prefer_out_of_source_building(@_);
+ return $this;
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ return -e $this->get_sourcepath("setup.py") ? 1 : 0;
+}
+
+sub not_our_cfg {
+ my $this=shift;
+ my $ret;
+ if (open(my $cfg, '<', $this->get_buildpath(".pydistutils.cfg"))) {
+ $ret = not "# Created by dh_auto\n" eq <$cfg>;
+ close $cfg;
+ }
+ return $ret;
+}
+
+sub create_cfg {
+ my $this=shift;
+ if (open(my $cfg, ">", $this->get_buildpath(".pydistutils.cfg"))) {
+ print $cfg "# Created by dh_auto", "\n";
+ print $cfg "[build]\nbuild-base=", $this->get_build_rel2sourcedir(), "\n";
+ close $cfg;
+ return 1;
+ }
+ return 0;
+}
+
+sub pre_building_step {
+ my $this=shift;
+ my $step=shift;
+
+ deprecated_functionality('Please use the third-party "pybuild" build system instead of python-distutils',
+ 12);
+
+ return unless grep /$step/, qw(build install clean);
+
+ if ($this->get_buildpath() ne $this->DEFAULT_BUILD_DIRECTORY()) {
+ # --build-base can only be passed to the build command. However,
+ # it is always read from the config file (really weird design).
+ # Therefore create such a cfg config file.
+ # See http://bugs.python.org/issue818201
+ # http://bugs.python.org/issue1011113
+ not $this->not_our_cfg() or
+ error("cannot set custom build directory: .pydistutils.cfg is in use");
+ $this->mkdir_builddir();
+ $this->create_cfg() or
+ error("cannot set custom build directory: unwritable .pydistutils.cfg");
+ # Distutils reads $HOME/.pydistutils.cfg
+ $ENV{HOME} = Cwd::abs_path($this->get_buildpath());
+ }
+
+ $this->SUPER::pre_building_step($step);
+}
+
+sub dbg_build_needed {
+ my $this=shift;
+ my $act=shift;
+
+ # Return a list of python-dbg package which are listed
+ # in the build-dependencies. This is kinda ugly, but building
+ # dbg extensions without checking if they're supposed to be
+ # built may result in various FTBFS if the package is not
+ # built in a clean chroot.
+
+ my @dbg;
+ open (my $fd, '<', 'debian/control') ||
+ error("cannot read debian/control: $!\n");
+ foreach my $builddeps (join('', <$fd>) =~
+ /^Build-Depends[^:]*:.*\n(?:^[^\w\n].*\n)*/gmi) {
+ while ($builddeps =~ /(python[^, ]*-dbg)/g) {
+ push @dbg, $1;
+ }
+ }
+
+ close($fd);
+ return @dbg;
+
+}
+
+sub setup_py {
+ my $this=shift;
+ my $act=shift;
+
+ # We need to run setup.py with the default python last
+ # as distutils/setuptools modifies the shebang lines of scripts.
+ # This ensures that #!/usr/bin/python is installed last and
+ # not pythonX.Y
+ # Take into account that the default Python must not be in
+ # the requested Python versions.
+ # Then, run setup.py with each available python, to build
+ # extensions for each.
+
+ my $python_default = `pyversions -d`;
+ if ($? == -1) {
+ error("failed to run pyversions")
+ }
+ my $ecode = $? >> 8;
+ if ($ecode != 0) {
+ error("pyversions -d failed [$ecode]")
+ }
+ $python_default =~ s/^\s+//;
+ $python_default =~ s/\s+$//;
+ my @python_requested = split ' ', `pyversions -r`;
+ if ($? == -1) {
+ error("failed to run pyversions")
+ }
+ $ecode = $? >> 8;
+ if ($ecode != 0) {
+ error("pyversions -r failed [$ecode]")
+ }
+ if (grep /^\Q$python_default\E/, @python_requested) {
+ @python_requested = (
+ grep(!/^\Q$python_default\E/, @python_requested),
+ "python",
+ );
+ }
+
+ my @python_dbg;
+ my @dbg_build_needed = $this->dbg_build_needed();
+ foreach my $python (map { $_."-dbg" } @python_requested) {
+ if (grep /^(python-all-dbg|\Q$python\E)/, @dbg_build_needed) {
+ push @python_dbg, $python;
+ }
+ elsif (($python eq "python-dbg")
+ and (grep /^\Q$python_default\E/, @dbg_build_needed)) {
+ push @python_dbg, $python_default."-dbg";
+ }
+ }
+
+ foreach my $python (@python_dbg, @python_requested) {
+ if (-x "/usr/bin/".$python) {
+ # To allow backports of debhelper we don't pass
+ # --install-layout=deb to 'setup.py install` for
+ # those Python versions where the option is
+ # ignored by distutils/setuptools.
+ if ( $act eq "install" and not
+ ( ($python =~ /^python(?:-dbg)?$/
+ and $python_default =~ /^python2\.[2345]$/)
+ or $python =~ /^python2\.[2345](?:-dbg)?$/ )) {
+ $this->doit_in_sourcedir($python, "setup.py",
+ $act, @_, "--install-layout=deb");
+ }
+ else {
+ $this->doit_in_sourcedir($python, "setup.py",
+ $act, @_);
+ }
+ }
+ }
+}
+
+sub build {
+ my $this=shift;
+ $this->setup_py("build",
+ "--force",
+ @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+ $this->setup_py("install",
+ "--force",
+ "--root=$destdir",
+ "--no-compile",
+ "-O0",
+ @_);
+}
+
+sub clean {
+ my $this=shift;
+ $this->setup_py("clean", "-a", @_);
+
+ # Config file will remain if it was created by us
+ if (!$this->not_our_cfg()) {
+ unlink($this->get_buildpath(".pydistutils.cfg"));
+ $this->rmdir_builddir(1); # only if empty
+ }
+ # The setup.py might import files, leading to python creating pyc
+ # files.
+ $this->doit_in_sourcedir('find', '.', '-name', '*.pyc', '-exec', 'rm', '{}', '+');
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/qmake.pm b/lib/Debian/Debhelper/Buildsystem/qmake.pm
new file mode 100644
index 0000000..18b896d
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/qmake.pm
@@ -0,0 +1,103 @@
+# A debhelper build system class for Qt projects
+# (based on the makefile class).
+#
+# Copyright: © 2010 Kelvin Modderman
+# License: GPL-2+
+
+package Debian::Debhelper::Buildsystem::qmake;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(dpkg_architecture_value error is_cross_compiling);
+use parent qw(Debian::Debhelper::Buildsystem::makefile);
+
+my %OS_MKSPEC_MAPPING = (
+ 'linux' => 'linux-g++',
+ 'kfreebsd' => 'gnukfreebsd-g++',
+ 'hurd' => 'hurd-g++',
+);
+
+sub DESCRIPTION {
+ "qmake (*.pro)";
+}
+
+sub check_auto_buildable {
+ my $this=shift;
+ my @projects=glob($this->get_sourcepath('*.pro'));
+ my $ret=0;
+
+ if (@projects > 0) {
+ $ret=1;
+ # Existence of a Makefile generated by qmake indicates qmake
+ # class has already been used by a prior build step, so should
+ # be used instead of the parent makefile class.
+ my $mf=$this->get_buildpath("Makefile");
+ if (-e $mf) {
+ $ret = $this->SUPER::check_auto_buildable(@_);
+ open(my $fh, '<', $mf)
+ or error("unable to open Makefile: $mf");
+ while(<$fh>) {
+ if (m/^# Generated by qmake/i) {
+ $ret++;
+ last;
+ }
+ }
+ close($fh);
+ }
+ }
+
+ return $ret;
+}
+
+sub configure {
+ my $this=shift;
+ my @options;
+ my @flags;
+
+ push @options, '-makefile';
+ if (is_cross_compiling()) {
+ my $host_os = dpkg_architecture_value("DEB_HOST_ARCH_OS");
+
+ if (defined(my $spec = $OS_MKSPEC_MAPPING{$host_os})) {
+ push(@options, "-spec", $spec);
+ } else {
+ error("Cannot cross-compile: Missing entry for HOST OS ${host_os} for qmake's -spec option");
+ }
+ }
+
+ if ($ENV{CFLAGS}) {
+ push @flags, "QMAKE_CFLAGS_RELEASE=$ENV{CFLAGS} $ENV{CPPFLAGS}";
+ push @flags, "QMAKE_CFLAGS_DEBUG=$ENV{CFLAGS} $ENV{CPPFLAGS}";
+ }
+ if ($ENV{CXXFLAGS}) {
+ push @flags, "QMAKE_CXXFLAGS_RELEASE=$ENV{CXXFLAGS} $ENV{CPPFLAGS}";
+ push @flags, "QMAKE_CXXFLAGS_DEBUG=$ENV{CXXFLAGS} $ENV{CPPFLAGS}";
+ }
+ if ($ENV{LDFLAGS}) {
+ push @flags, "QMAKE_LFLAGS_RELEASE=$ENV{LDFLAGS}";
+ push @flags, "QMAKE_LFLAGS_DEBUG=$ENV{LDFLAGS}";
+ }
+ push @flags, "QMAKE_STRIP=:";
+ push @flags, "PREFIX=/usr";
+
+ $this->mkdir_builddir();
+ $this->doit_in_builddir($this->_qmake(), @options, @flags, @_);
+}
+
+sub install {
+ my $this=shift;
+ my $destdir=shift;
+
+ # qmake generated Makefiles use INSTALL_ROOT in install target
+ # where one would expect DESTDIR to be used.
+ $this->SUPER::install($destdir, "INSTALL_ROOT=$destdir", @_);
+}
+
+sub _qmake {
+ if (is_cross_compiling()) {
+ return dpkg_architecture_value("DEB_HOST_GNU_TYPE") . "-qmake";
+ }
+ return 'qmake';
+}
+
+1
diff --git a/lib/Debian/Debhelper/Buildsystem/qmake_qt4.pm b/lib/Debian/Debhelper/Buildsystem/qmake_qt4.pm
new file mode 100644
index 0000000..60d9084
--- /dev/null
+++ b/lib/Debian/Debhelper/Buildsystem/qmake_qt4.pm
@@ -0,0 +1,15 @@
+package Debian::Debhelper::Buildsystem::qmake_qt4;
+
+use strict;
+use warnings;
+use parent qw(Debian::Debhelper::Buildsystem::qmake);
+
+sub DESCRIPTION {
+ "qmake for QT 4 (*.pro)";
+}
+
+sub _qmake {
+ return 'qmake-qt4';
+}
+
+1
diff --git a/lib/Debian/Debhelper/DH/AddonAPI.pm b/lib/Debian/Debhelper/DH/AddonAPI.pm
new file mode 100644
index 0000000..44082a9
--- /dev/null
+++ b/lib/Debian/Debhelper/DH/AddonAPI.pm
@@ -0,0 +1,228 @@
+# Defines dh sequence state variables
+#
+# License: GPL-2+
+
+package Debian::Debhelper::DH::AddonAPI;
+use strict;
+use warnings;
+
+use Debian::Debhelper::Dh_Lib qw(warning error);
+use Debian::Debhelper::Sequence;
+use Debian::Debhelper::SequencerUtil;
+use Debian::Debhelper::DH::SequenceState;
+
+
+our ($DH_INTERNAL_ADDON_TYPE, $DH_INTERNAL_ADDON_NAME);
+
+sub _add_sequence {
+ my @args = @_;
+ my $seq = Debian::Debhelper::Sequence->new(@args);
+ my $name = $seq->name;
+ $Debian::Debhelper::DH::SequenceState::sequences{$name} = $seq;
+ if ($seq->allowed_subsequences eq SEQUENCE_ARCH_INDEP_SUBSEQUENCES) {
+ for my $subseq ((SEQUENCE_TYPE_ARCH_ONLY, SEQUENCE_TYPE_INDEP_ONLY)) {
+ my $subname = "${name}-${subseq}";
+ $Debian::Debhelper::DH::SequenceState::sequences{$subname} = $seq;
+ }
+ }
+ return;
+}
+
+sub _skip_cmd_if_deb_build_options_contains {
+ my ($command, $flag) = @_;
+ push(@{$Debian::Debhelper::DH::SequenceState::commands_skippable_via_deb_build_options{$command}}, $flag);
+ return;
+}
+
+sub _assert_not_conditional_sequence_addon {
+ my ($feature) = @_;
+ return if $DH_INTERNAL_ADDON_TYPE eq 'both';
+ warning("The add-on ${DH_INTERNAL_ADDON_NAME} relies on a feature (${feature}) (possibly indirectly), which is "
+ . 'not supported for conditional debhelper sequence add-ons.');
+ warning("Hint: You may have to move the build-dependency for dh-sequence-${DH_INTERNAL_ADDON_NAME} to "
+ . 'Build-Depends to avoid this error assuming it is possible to use the sequence unconditionally.');
+ error("${feature} is not supported for conditional dh sequence add-ons.\n");
+}
+
+sub _filter_sequences_for_conditional_add_ons {
+ my @sequences = @_;
+ # If it is unconditional, then there is no issues.
+ return @sequences if $DH_INTERNAL_ADDON_TYPE eq 'both' or not @sequences;
+ for my $seq (@sequences) {
+ # Typically, if you add a command to a sequence, then you will in fact add it to two. E.g.
+ # Adding dh_foo after dh_installdocs will affect both install-arch AND install-indep. We want
+ # this to "just work(tm)" with a conditional add-on to avoid too much hassle (i.e. only affect
+ # the relevant sequence). At the same time, we must abort if a sequence like "clean" is
+ # affected.
+ #
+ # We solve the above by checking if the sequence has an -arch + an -indep variant and then
+ # insert the command only for that sequence variant.
+
+ if ($seq->allowed_subsequences ne SEQUENCE_ARCH_INDEP_SUBSEQUENCES) {
+ my $sequence_name = $seq->name;
+ warning("The add-on ${DH_INTERNAL_ADDON_NAME} attempted to modify the sequence ${sequence_name} (possibly "
+ . "indirectly) but the add-on is conditional for \"*-${DH_INTERNAL_ADDON_TYPE}\" targets");
+ warning("Hint: You may have to move the build-dependency for dh-sequence-${DH_INTERNAL_ADDON_NAME} to "
+ . 'Build-Depends to avoid this error assuming it is possible to use the sequence unconditionally.');
+ error("The add-on ${DH_INTERNAL_ADDON_NAME} cannot be use conditionally for \"*-${DH_INTERNAL_ADDON_TYPE}\""
+ . " targets\n");
+ }
+ }
+ return @sequences;
+}
+
+sub _register_cmd_added_by_addon {
+ my ($cmd) = @_;
+ my $existing = $Debian::Debhelper::DH::SequenceState::commands_added_by_addon{$cmd};
+ if ($existing) {
+ if ($existing->{'addon-type'} ne $DH_INTERNAL_ADDON_TYPE) {
+ my $old_addon_name = $existing->{'addon-name'};
+ my $old_addon_type = $existing->{'addon-type'};
+ # Technically, "both" could be made compatible with "indep" OR "arch" (but not both at the same time).
+ # Implement if it turns out to be relevant.
+ warning("Both dh sequence add-ons ${DH_INTERNAL_ADDON_NAME} and ${old_addon_name} have attempted to add "
+ . "the command $cmd (possibly indirectly).");
+ warning("However, the two add-ons do not have compatible constraints (${DH_INTERNAL_ADDON_TYPE} vs. "
+ . "${old_addon_type}).");
+ warning("Hint: You may have to move the build-dependency for dh-sequence-<X> to "
+ . ' the same build-dependency field to avoid this error assuming it is possible.');
+ error("Multiple sequences have conflicting requests for $cmd.\n");
+ }
+ return;
+ }
+
+ $Debian::Debhelper::DH::SequenceState::commands_added_by_addon{$cmd} = {
+ 'addon-name' => $DH_INTERNAL_ADDON_NAME,
+ 'addon-type' => $DH_INTERNAL_ADDON_TYPE,
+ };
+ return;
+}
+
+sub _sequences_containing_cmd {
+ my ($cmd) = @_;
+ my @sequences;
+ foreach my $sequence_name (keys(%Debian::Debhelper::DH::SequenceState::sequences)) {
+ my $seq = $Debian::Debhelper::DH::SequenceState::sequences{$sequence_name};
+ for my $scmd (@{$seq->{'_cmds'}}) {
+ if ($scmd->{'command'} eq $cmd) {
+ push(@sequences, $seq);
+ last;
+ }
+ }
+ }
+ return @sequences;
+}
+
+sub _seq_cmd {
+ my ($cmd_name) = @_;
+ return {
+ 'command' => $cmd_name,
+ 'command-options' => [],
+ 'sequence-limitation' => $DH_INTERNAL_ADDON_TYPE,
+ };
+}
+
+# sequence addon interface
+sub _insert {
+ my ($offset, $existing, $new) = @_;
+ my @affected_sequences = _sequences_containing_cmd($existing);
+ @affected_sequences = _filter_sequences_for_conditional_add_ons(@affected_sequences);
+ return if not @affected_sequences;
+ _register_cmd_added_by_addon($new);
+ for my $seq (@affected_sequences) {
+ $seq->_insert($offset, $existing, _seq_cmd($new));
+ }
+ return 1;
+}
+sub insert_before {
+ return _insert(-1, @_);
+}
+sub insert_after {
+ return _insert(1, @_);
+}
+sub remove_command {
+ my ($command) = @_;
+ # Implement if actually needed (I *think* it basically means to transform dh_foo to dh_foo -a/-i)
+ _assert_not_conditional_sequence_addon('remove_command');
+ my @affected_sequences = _sequences_containing_cmd($command);
+ @affected_sequences = _filter_sequences_for_conditional_add_ons(@affected_sequences);
+ return 1 if not @affected_sequences;
+ for my $seq (@affected_sequences) {
+ $seq->remove_command($command);
+ }
+ return 1;
+}
+sub add_command {
+ my ($command, $sequence) = @_;
+ _assert_not_conditional_sequence_addon('add_command');
+ _register_cmd_added_by_addon($command);
+ if (not exists($Debian::Debhelper::DH::SequenceState::sequences{$sequence})) {
+ _add_sequence($sequence, SEQUENCE_NO_SUBSEQUENCES, _seq_cmd($command));
+ } else {
+ my $seq = $Debian::Debhelper::DH::SequenceState::sequences{$sequence};
+ _filter_sequences_for_conditional_add_ons($seq);
+ $seq->add_command_at_start(_seq_cmd($command))
+ }
+ return 1;
+}
+sub add_command_at_end {
+ my ($command, $sequence) = @_;
+ _assert_not_conditional_sequence_addon('add_command');
+ _register_cmd_added_by_addon($command);
+ if (not exists($Debian::Debhelper::DH::SequenceState::sequences{$sequence})) {
+ _add_sequence($sequence, SEQUENCE_NO_SUBSEQUENCES, _seq_cmd($command));
+ } else {
+ my $seq = $Debian::Debhelper::DH::SequenceState::sequences{$sequence};
+ _filter_sequences_for_conditional_add_ons($seq);
+ $seq->add_command_at_end(_seq_cmd($command))
+ }
+ return 1;
+}
+
+sub add_command_options {
+ my $command=shift;
+ # Implement if actually needed (Complicated as dh_foo becomes dh_foo -a && dh_foo -i <extra_options>
+ # and that implies smarter deduplication logic)
+ _assert_not_conditional_sequence_addon('add_command_options');
+ push(@{$Debian::Debhelper::DH::SequenceState::command_opts{$command}}, @_);
+ return 1;
+}
+
+sub remove_command_options {
+ my ($command, @cmd_options) = @_;
+ # Implement if actually needed (Complicated as dh_foo <extra_options> becomes
+ # dh_foo -a <extra_options> && dh_foo -i and that implies smarter deduplication logic)
+ _assert_not_conditional_sequence_addon('remove_command_options');
+ if (@cmd_options) {
+ # Remove only specified options
+ if (my $opts = $Debian::Debhelper::DH::SequenceState::command_opts{$command}) {
+ foreach my $opt (@cmd_options) {
+ $opts = [ grep { $_ ne $opt } @$opts ];
+ }
+ $Debian::Debhelper::DH::SequenceState::command_opts{$command} = $opts;
+ }
+ }
+ else {
+ # Clear all additional options
+ delete($Debian::Debhelper::DH::SequenceState::command_opts{$command});
+ }
+ return 1;
+}
+
+sub declare_command_obsolete {
+ my ($error_compat, $command) = @_;
+ if (not defined($command) and defined($error_compat)) {
+ # Backwards compat - originally this only accepted one command.
+ $command = $error_compat;
+ $error_compat = 13;
+ }
+ if ($error_compat < 13) {
+ error("Minimum error compat is 13 (got ${error_compat} for command: ${command})");
+ }
+ _assert_not_conditional_sequence_addon('declare_command_obsolete');
+ $Debian::Debhelper::DH::SequenceState::obsolete_command{$command} = [$DH_INTERNAL_ADDON_NAME, $error_compat];
+ return 1;
+}
+
+
+1;
diff --git a/lib/Debian/Debhelper/DH/SequenceState.pm b/lib/Debian/Debhelper/DH/SequenceState.pm
new file mode 100644
index 0000000..b029e01
--- /dev/null
+++ b/lib/Debian/Debhelper/DH/SequenceState.pm
@@ -0,0 +1,31 @@
+# Defines dh sequence state variables
+#
+# License: GPL-2+
+
+package Debian::Debhelper::DH::SequenceState;
+use strict;
+use warnings;
+
+our (
+ # Definitions of sequences.
+ %sequences,
+ # Additional command options
+ %command_opts,
+ # Track commands added by (which) addons
+ %commands_added_by_addon,
+ # Removed commands
+ %obsolete_command,
+ # Commands that can be skipped due to DEB_BUILD_OPTIONS=X flags
+ %commands_skippable_via_deb_build_options,
+ # Options passed that should be passed on to underlying helpers (in order)
+ @options,
+ # Options passed by name (to assist can_skip with which options are used)
+ %seen_options,
+ # Whether there were sequences of options that inhibit certain optimizations
+ # * $unoptimizable_option_bundle => can skip iff cli-options hint is present and empty
+ # * $unoptimizable_user_option => We can never skip anything (non-option seen)
+ $unoptimizable_option_bundle,
+ $unoptimizable_user_option,
+);
+
+1;
diff --git a/lib/Debian/Debhelper/Dh_Buildsystems.pm b/lib/Debian/Debhelper/Dh_Buildsystems.pm
new file mode 100644
index 0000000..9918969
--- /dev/null
+++ b/lib/Debian/Debhelper/Dh_Buildsystems.pm
@@ -0,0 +1,319 @@
+# A module for loading and managing debhelper build system classes.
+# This module is intended to be used by all dh_auto_* programs.
+#
+# Copyright: © 2009 Modestas Vainius
+# License: GPL-2+
+
+package Debian::Debhelper::Dh_Buildsystems;
+
+use strict;
+use warnings;
+use Debian::Debhelper::Buildsystem;
+use Debian::Debhelper::Dh_Lib;
+use File::Spec;
+
+use Exporter qw(import);
+our @EXPORT=qw(&buildsystems_init &buildsystems_do &load_buildsystem &load_all_buildsystems);
+
+use constant BUILD_STEPS => qw(configure build test install clean);
+
+# Historical order must be kept for backwards compatibility. New
+# build systems MUST be added to the END of the list.
+our @BUILDSYSTEMS = (
+ "autoconf",
+ (! compat(7) ? "perl_build" : ()),
+ "perl_makemaker",
+ "makefile",
+ "python_distutils",
+ (compat(7) ? "perl_build" : ()),
+ "cmake+makefile",
+ "cmake+ninja",
+ "ant",
+ "qmake",
+ "qmake_qt4",
+ "meson+ninja",
+ "ninja",
+);
+
+our @THIRD_PARTY_BUILDSYSTEMS = (
+ 'maven',
+ 'gradle',
+ 'mkcmake',
+ 'bmake',
+ 'golang',
+);
+
+# Visible for dh_assistant's sake; not API for external tools!
+our $opt_buildsys;
+my $opt_sourcedir;
+my $opt_builddir;
+my $opt_list;
+my $opt_parallel;
+
+*create_buildsystem_instance = \&Debian::Debhelper::Buildsystem::_create_buildsystem_instance;
+
+sub _insert_cmd_opts {
+ my (%bsopts) = @_;
+ if (!exists $bsopts{builddir} && defined $opt_builddir) {
+ $bsopts{builddir} = ($opt_builddir eq "") ? undef : $opt_builddir;
+ }
+ if (!exists $bsopts{sourcedir} && defined $opt_sourcedir) {
+ $bsopts{sourcedir} = ($opt_sourcedir eq "") ? undef : $opt_sourcedir;
+ }
+ if (!exists $bsopts{parallel}) {
+ $bsopts{parallel} = $opt_parallel;
+ }
+ return %bsopts;
+}
+
+# Autoselect a build system from the list of instances
+sub autoselect_buildsystem {
+ my $step=shift;
+ my $selected;
+ my $selected_level = 0;
+
+ foreach my $inst (@_) {
+ # Only more specific build system can be considered beyond
+ # the currently selected one.
+ if (defined($selected)) {
+ my $ok = $inst->isa(ref($selected)) ? 1 : 0;
+ if (not $ok and $inst->IS_GENERATOR_BUILD_SYSTEM) {
+ $ok = 1 if $inst->get_targetbuildsystem->NAME eq $selected->NAME;
+ }
+ next if not $ok;
+ }
+
+ # If the build system says it is auto-buildable at the current
+ # step and it can provide more specific information about its
+ # status than its parent (if any), auto-select it.
+ my $level = $inst->check_auto_buildable($step);
+ if ($level > $selected_level) {
+ $selected = $inst;
+ $selected_level = $level;
+ }
+ }
+ return $selected;
+}
+
+# Similar to create_buildsystem_instance(), but it attempts to autoselect
+# a build system if none was specified. In case autoselection fails or an
+# explicit “none” is requested, undef is returned.
+sub load_buildsystem {
+ my $system=shift;
+ my $step=shift;
+ my %opts = _insert_cmd_opts(@_);
+ my $system_options;
+ if (defined($system) && ref($system) eq 'HASH') {
+ $system_options = $system;
+ $system = $system_options->{'system'};
+ }
+ if (defined $system) {
+ return undef if $system eq 'none';
+ my $inst = create_buildsystem_instance($system, 1, %opts);
+ return $inst;
+ }
+ else {
+ # Try to determine build system automatically
+ my @buildsystems;
+ foreach $system (@BUILDSYSTEMS) {
+ push @buildsystems, create_buildsystem_instance($system, 1, %opts);
+ }
+ if (!$system_options || $system_options->{'enable-thirdparty'}) {
+ foreach $system (@THIRD_PARTY_BUILDSYSTEMS) {
+ push @buildsystems, create_buildsystem_instance($system, 0, %opts);
+ }
+ }
+ return autoselect_buildsystem($step, @buildsystems);
+ }
+}
+
+sub load_all_buildsystems {
+ my $incs=shift || \@INC;
+ my %opts = _insert_cmd_opts(@_);
+ my (%buildsystems, %genbuildsystems, @buildsystems);
+
+ foreach my $inc (@$incs) {
+ my $path = File::Spec->catdir($inc, "Debian/Debhelper/Buildsystem");
+ if (-d $path) {
+ foreach my $module_path (glob "$path/*.pm") {
+ my $name = basename($module_path);
+ $name =~ s/\.pm$//;
+ next if exists $buildsystems{$name} or exists $genbuildsystems{$name};
+ my $system = create_buildsystem_instance($name, 1, %opts);
+ if ($system->IS_GENERATOR_BUILD_SYSTEM) {
+ $genbuildsystems{$name} = 1;
+ for my $target_name ($system->SUPPORTED_TARGET_BUILD_SYSTEMS) {
+ my $full_name = "${name}+${target_name}";
+ my $full_system = create_buildsystem_instance($name, 1, %opts,
+ 'targetbuildsystem' => $target_name);
+ $buildsystems{$full_name} = $full_system;
+ }
+ } else {
+ $buildsystems{$name} = $system;
+ }
+ }
+ }
+ }
+
+ # Standard debhelper build systems first
+ foreach my $name (@BUILDSYSTEMS) {
+ error("standard debhelper build system '$name' could not be found/loaded")
+ if not exists $buildsystems{$name};
+ push @buildsystems, $buildsystems{$name};
+ delete $buildsystems{$name};
+ }
+
+ foreach my $name (@THIRD_PARTY_BUILDSYSTEMS) {
+ next if not exists $buildsystems{$name};
+ my $inst = $buildsystems{$name};
+ $inst->{thirdparty} = 1;
+ push(@buildsystems, $inst);
+ delete($buildsystems{$name});
+ }
+
+ # The rest are 3rd party build systems
+ foreach my $name (sort(keys(%buildsystems))) {
+ my $inst = $buildsystems{$name};
+ $inst->{thirdparty} = 1;
+ push @buildsystems, $inst;
+ }
+
+ return @buildsystems;
+}
+
+sub buildsystems_init {
+ my %args=@_;
+
+ # Compat 10 defaults to --parallel by default
+ my $max_parallel = compat(9) ? 1 : -1;
+
+ # Available command line options
+ my %options = (
+ "D=s" => \$opt_sourcedir,
+ "sourcedir=s" => \$opt_sourcedir,
+ "sourcedirectory=s" => \$opt_sourcedir,
+
+ "B:s" => \$opt_builddir,
+ "builddir:s" => \$opt_builddir,
+ "builddirectory:s" => \$opt_builddir,
+
+ "S=s" => \$opt_buildsys,
+ "buildsystem=s" => \$opt_buildsys,
+
+ "l" => \$opt_list,
+ "list" => \$opt_list,
+
+ "parallel" => sub { $max_parallel = -1 },
+ 'no-parallel' => sub { $max_parallel = 1 },
+ "max-parallel=i" => \$max_parallel,
+
+ 'reload-all-buildenv-variables' => sub {
+ Debian::Debhelper::Dh_Lib::reset_buildflags();
+ },
+ );
+ if (compat(8)) {
+ # This option only works in compat 9+ where we actually set buildflags
+ $options{'reload-all-buildenv-variables'} = sub {
+ die("--reload-all-buildenv-variables only work reliably in compat 9+.\n");
+ };
+ }
+ $args{options}{$_} = $options{$_} foreach keys(%options);
+ Debian::Debhelper::Dh_Lib::init(%args);
+ Debian::Debhelper::Dh_Lib::setup_buildenv();
+ set_parallel($max_parallel);
+}
+
+sub set_parallel {
+ my $max=shift;
+
+ # Get number of processes from parallel=n option, limiting it
+ # with $max if needed
+ $opt_parallel=get_buildoption("parallel") || 1;
+
+ if ($max > 0 && $opt_parallel > $max) {
+ $opt_parallel = $max;
+ }
+}
+
+sub buildsystems_list {
+ my $step=shift;
+
+ my @buildsystems = load_all_buildsystems();
+ my %auto_selectable = map { $_ => 1 } @THIRD_PARTY_BUILDSYSTEMS;
+ my $auto = autoselect_buildsystem($step, grep { ! $_->{thirdparty} || $auto_selectable{$_->NAME} } @buildsystems);
+ my $specified_text;
+
+ if ($opt_buildsys) {
+ for my $inst (@buildsystems) {
+ my $full_name = $inst->NAME;
+ if ($full_name eq $opt_buildsys) {
+ $specified_text = $full_name;
+ } elsif ($inst->IS_GENERATOR_BUILD_SYSTEM and ref($inst)->NAME eq $opt_buildsys) {
+ my $default = $inst->DEFAULT_TARGET_BUILD_SYSTEM;
+ $specified_text = "${opt_buildsys}+${default} (default for ${opt_buildsys})";
+ }
+ }
+ }
+
+ # List build systems (including auto and specified status)
+ foreach my $inst (@buildsystems) {
+ printf("%-20s %s", $inst->NAME(), $inst->FULL_DESCRIPTION());
+ print " [3rd party]" if $inst->{thirdparty};
+ print "\n";
+ }
+ print "\n";
+ print "Auto-selected: ", $auto->NAME(), "\n" if defined $auto;
+ print "Specified: ", $specified_text, "\n" if defined $specified_text;
+ print "No system auto-selected or specified\n"
+ if ! defined $auto && ! defined $specified_text;
+}
+
+sub buildsystems_do {
+ my $step=shift;
+
+ if (!defined $step) {
+ $step = basename($0);
+ $step =~ s/^dh_auto_//;
+ }
+
+ if (grep(/^\Q$step\E$/, BUILD_STEPS) == 0) {
+ error("unrecognized build step: " . $step);
+ }
+
+ if ($opt_list) {
+ buildsystems_list($step);
+ exit 0;
+ }
+
+ my $buildsystem = load_buildsystem($opt_buildsys, $step);
+ if (defined $buildsystem) {
+ my ($xdg_runtime_dir, $err, $ref);
+ local $SIG{'INT'} = sub { $ref = 'INT'; die(\$ref); };
+ local $SIG{'TERM'} = sub { $ref = 'TERM'; die(\$ref); };
+ if ($step eq 'test' and not compat(12)) {
+ require File::Temp;
+ $xdg_runtime_dir = File::Temp->newdir('dh-xdg-rundir-XXXXXXXX',
+ TMPDIR => 1,
+ CLEANUP => 1,
+ );
+ $ENV{'XDG_RUNTIME_DIR'} = $xdg_runtime_dir->dirname;
+ }
+ eval {
+ $buildsystem->pre_building_step($step);
+ $buildsystem->$step(@_, @{$dh{U_PARAMS}});
+ $buildsystem->post_building_step($step);
+ };
+ $err = $@;
+ doit('rm', '-fr', '--', $xdg_runtime_dir) if $xdg_runtime_dir;
+ if ($err) {
+ my $sig;
+ die($err) if $err ne \$ref;
+ $sig = $ref;
+ delete($SIG{$sig});
+ kill($sig => $$);
+ }
+ }
+ return 0;
+}
+
+1
diff --git a/lib/Debian/Debhelper/Dh_Getopt.pm b/lib/Debian/Debhelper/Dh_Getopt.pm
new file mode 100644
index 0000000..5486c41
--- /dev/null
+++ b/lib/Debian/Debhelper/Dh_Getopt.pm
@@ -0,0 +1,332 @@
+#!/usr/bin/perl
+#
+# Debhelper option processing library.
+#
+# Joey Hess GPL copyright 1998-2002
+
+package Debian::Debhelper::Dh_Getopt;
+use strict;
+use warnings;
+
+use Debian::Debhelper::Dh_Lib;
+use Getopt::Long;
+
+my (%exclude_package, %internal_excluded_package, %explicitly_requested_packages, %profile_enabled_packages,
+ $profile_excluded_pkg);
+
+sub showhelp {
+ my $prog=basename($0);
+ print "Usage: $prog [options]\n\n";
+ print " $prog is a part of debhelper. See debhelper(7)\n";
+ print " and $prog(1) for complete usage instructions.\n";
+ exit(1);
+}
+
+# Passed an option name and an option value, adds packages to the list
+# of packages. We need this so the list will be built up in the right
+# order.
+sub AddPackage { my($option,$value)=@_;
+ if ($option eq 'i' or $option eq 'indep') {
+ push @{$dh{DOPACKAGES}}, getpackages('indep');
+ $dh{DOINDEP}=1;
+ }
+ elsif ($option eq 'a' or $option eq 'arch' or
+ $option eq 's' or $option eq 'same-arch') {
+ push @{$dh{DOPACKAGES}}, getpackages('arch');
+ $dh{DOARCH}=1;
+ if ($option eq 's' or $option eq 'same-arch') {
+ deprecated_functionality('-s/--same-arch is deprecated; please use -a/--arch instead',
+ 12,
+ '-s/--same-arch has been removed; please use -a/--arch instead'
+ );
+ }
+ }
+ elsif ($option eq 'p' or $option eq 'package') {
+ assert_opt_is_known_package($value, '-p/--package');
+ %profile_enabled_packages = map { $_ => 1 } getpackages('both') if not %profile_enabled_packages;
+ $explicitly_requested_packages{$value} = 1;
+ # Silently ignore packages that are not enabled by the
+ # profile.
+ if (exists($profile_enabled_packages{$value})) {
+ push @{$dh{DOPACKAGES}}, $value;
+ } else {
+ $profile_excluded_pkg = 1;
+ }
+ }
+ else {
+ error("bad option $option - should never happen!\n");
+ }
+}
+
+# Sets a package as the debug package.
+sub SetDebugPackage { my($option,$value)=@_;
+ $dh{DEBUGPACKAGE} = $value;
+ # For backwards compatibility
+ $dh{DEBUGPACKAGES} = [$value];
+}
+
+# Add a package to a list of packages that should not be acted on.
+sub ExcludePackage {
+ my($option, $value)=@_;
+ assert_opt_is_known_package($value, '-N/--no-package');
+ $exclude_package{$value}=1;
+}
+
+# Add another item to the exclude list.
+sub AddExclude {
+ my($option,$value)=@_;
+ push @{$dh{EXCLUDE}},$value;
+}
+
+# This collects non-options values.
+sub NonOption {
+ push @{$dh{ARGV}}, @_;
+}
+
+sub getoptions {
+ my $array=shift;
+ my %params=@_;
+
+ if (! exists $params{bundling} || $params{bundling}) {
+ Getopt::Long::config("bundling");
+ }
+ Getopt::Long::config('no_ignore_case');
+ if ( ! -f 'debian/control' or ! compat(12, 1)) {
+ Getopt::Long::config('no_auto_abbrev');
+ }
+
+ my @test;
+ my %options=(
+ "v" => \$dh{VERBOSE},
+ "verbose" => \$dh{VERBOSE},
+
+ "no-act" => \$dh{NO_ACT},
+
+ "i" => \&AddPackage,
+ "indep" => \&AddPackage,
+
+ "a" => \&AddPackage,
+ "arch" => \&AddPackage,
+
+ "p=s" => \&AddPackage,
+ "package=s" => \&AddPackage,
+
+ "N=s" => \&ExcludePackage,
+ "no-package=s" => \&ExcludePackage,
+
+ "remaining-packages" => \$dh{EXCLUDE_LOGGED},
+
+ "dbg-package=s" => \&SetDebugPackage,
+
+ "s" => \&AddPackage,
+ "same-arch" => \&AddPackage,
+
+ "n" => \$dh{NOSCRIPTS},
+ "noscripts" => \$dh{NOSCRIPTS},
+ "no-scripts" => \$dh{NOSCRIPTS},
+ "o" => \$dh{ONLYSCRIPTS},
+ "onlyscripts" => \$dh{ONLYSCRIPTS},
+ "only-scripts" => \$dh{ONLYSCRIPTS},
+
+ "X=s" => \&AddExclude,
+ "exclude=s" => \&AddExclude,
+
+ "d" => \$dh{D_FLAG},
+
+ "P=s" => \$dh{TMPDIR},
+ "tmpdir=s" => \$dh{TMPDIR},
+
+ "u=s", => \$dh{U_PARAMS},
+
+ "V:s", => \$dh{V_FLAG},
+
+ "A" => \$dh{PARAMS_ALL},
+ "all" => \$dh{PARAMS_ALL},
+
+ "h|help" => \&showhelp,
+
+ "mainpackage=s" => \$dh{MAINPACKAGE},
+
+ "name=s" => \$dh{NAME},
+
+ "error-handler=s" => \$dh{ERROR_HANDLER},
+
+ "O=s" => sub { push @test, $_[1] },
+
+ (ref $params{options} ? %{$params{options}} : ()) ,
+
+ "<>" => \&NonOption,
+ );
+
+ if ($params{test}) {
+ foreach my $key (keys %options) {
+ $options{$key}=sub {};
+ }
+ }
+
+ my $oldwarn;
+ if ($params{test} || $params{ignore_unknown_options}) {
+ $oldwarn=$SIG{__WARN__};
+ $SIG{__WARN__}=sub {};
+ }
+ my $ret=Getopt::Long::GetOptionsFromArray($array, %options);
+ if ($params{test} || $params{ignore_unknown_options}) {
+ $SIG{__WARN__}=$oldwarn;
+ }
+
+ foreach my $opt (@test) {
+ # Try to parse an option, and skip it
+ # if it is not known.
+ if (getoptions([$opt], %params,
+ ignore_unknown_options => 0,
+ test => 1)) {
+ getoptions([$opt], %params);
+ }
+ }
+
+ return 1 if $params{ignore_unknown_options};
+ return $ret;
+}
+
+sub split_options_string {
+ my $str=shift;
+ $str=~s/^\s+//;
+ return split(/\s+/,$str);
+}
+
+# Parse options and set %dh values.
+sub parseopts {
+ my %params=@_;
+
+ my @ARGV_extra;
+
+ # DH_INTERNAL_OPTIONS is used to pass additional options from
+ # dh through an override target to a command.
+ if (defined $ENV{DH_INTERNAL_OPTIONS}) {
+ @ARGV_extra=split(/\x1e/, $ENV{DH_INTERNAL_OPTIONS});
+ getoptions(\@ARGV_extra, %params);
+
+ # Avoid forcing acting on packages specified in
+ # DH_INTERNAL_OPTIONS. This way, -p can be specified
+ # at the command line to act on a specific package, but when
+ # nothing is specified, the excludes will cause the set of
+ # packages DH_INTERNAL_OPTIONS specifies to be acted on.
+ if (defined $dh{DOPACKAGES}) {
+ foreach my $package (getpackages()) {
+ if (! grep { $_ eq $package } @{$dh{DOPACKAGES}}) {
+ $exclude_package{$package} = 1;
+ $internal_excluded_package{$package} = 1;
+ }
+ }
+ }
+ delete $dh{DOPACKAGES};
+ delete $dh{DOINDEP};
+ delete $dh{DOARCH};
+ }
+
+ # DH_OPTIONS can contain additional options to be parsed like @ARGV
+ if (defined $ENV{DH_OPTIONS}) {
+ @ARGV_extra=split_options_string($ENV{DH_OPTIONS});
+ my $ret=getoptions(\@ARGV_extra, %params);
+ if (!$ret) {
+ warning("ignored unknown options in DH_OPTIONS");
+ }
+ }
+
+ my $ret=getoptions(\@ARGV, %params);
+ if (!$ret) {
+ if (! compat(7)) {
+ error("unknown option or error during option parsing; aborting");
+ }
+ }
+
+ # Check to see if -V was specified. If so, but no parameters were
+ # passed, the variable will be defined but empty.
+ if (defined($dh{V_FLAG})) {
+ $dh{V_FLAG_SET}=1;
+ }
+
+ # If we have not been given any packages to act on, assume they
+ # want us to act on them all. Note we have to do this before excluding
+ # packages out, below.
+ if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) {
+ my $do_exit = 0;
+ if ($profile_excluded_pkg) {
+ if (! $dh{BLOCK_NOOP_WARNINGS}) {
+ warning('All requested packages have been excluded'
+ . ' (e.g. via a Build-Profile or due to architecture restrictions).');
+ }
+ $do_exit = 1;
+ }
+ if ($dh{DOINDEP} || $dh{DOARCH}) {
+ # User specified that all arch (in)dep package be
+ # built, and there are none of that type.
+ if (! $dh{BLOCK_NOOP_WARNINGS}) {
+ warning("You asked that all arch in(dep) packages be built, but there are none of that type.");
+ }
+ $do_exit = 1;
+ }
+ exit(0) if $do_exit;
+ push @{$dh{DOPACKAGES}},getpackages("both");
+ }
+
+ # Remove excluded packages from the list of packages to act on.
+ # Also unique the list, in case some options were specified that
+ # added a package to it twice.
+ my (@package_list, $package, %packages_seen);
+ foreach $package (@{$dh{DOPACKAGES}}) {
+ if (defined($dh{EXCLUDE_LOGGED}) &&
+ grep { $_ eq $Debian::Debhelper::Dh_Lib::TOOL_NAME } load_log($package)) {
+ $exclude_package{$package}=1;
+ }
+ if (! $exclude_package{$package}) {
+ if (! exists $packages_seen{$package}) {
+ $packages_seen{$package}=1;
+ push @package_list, $package;
+ }
+ }
+ }
+ @{$dh{DOPACKAGES}}=@package_list;
+
+ if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) {
+ if (! $dh{BLOCK_NOOP_WARNINGS}) {
+ my %archs;
+ if (%explicitly_requested_packages) {
+ # Avoid sending a confusing error message when debhelper must exclude a package given via -p.
+ # This commonly happens due to Build-Profiles or/and when build only a subset of the packages
+ # (e.g. dpkg-buildpackage -A vs. -B vs. none of the options)
+ for my $pkg (sort(keys(%explicitly_requested_packages))) {
+ if (exists($internal_excluded_package{$pkg}) or not exists($profile_enabled_packages{$pkg})) {
+ delete($explicitly_requested_packages{$pkg});
+ }
+ }
+ if (not %explicitly_requested_packages) {
+ warning('All requested packages have been excluded'
+ . ' (e.g. via a Build-Profile or due to architecture restrictions).');
+ exit(0);
+ }
+ }
+ for my $pkg (getpackages()) {
+ $archs{package_declared_arch($pkg)} = 1;
+ }
+ warning("No packages to build. Possible architecture mismatch: " . hostarch() .
+ ", want: " . join(" ", sort keys %archs));
+ }
+ exit(0);
+ }
+
+ if (defined $dh{U_PARAMS}) {
+ # Split the U_PARAMS up into an array.
+ my $u=$dh{U_PARAMS};
+ undef $dh{U_PARAMS};
+ push @{$dh{U_PARAMS}}, split(/\s+/,$u);
+ }
+
+ # Anything left in @ARGV is options that appeared after a --
+ # These options are added to the U_PARAMS array, while the
+ # non-option values we collected replace them in @ARGV;
+ push @{$dh{U_PARAMS}}, @ARGV, @ARGV_extra;
+ @ARGV=@{$dh{ARGV}} if exists $dh{ARGV};
+}
+
+1
diff --git a/lib/Debian/Debhelper/Dh_Lib.pm b/lib/Debian/Debhelper/Dh_Lib.pm
new file mode 100644
index 0000000..7cf59e0
--- /dev/null
+++ b/lib/Debian/Debhelper/Dh_Lib.pm
@@ -0,0 +1,3111 @@
+#!/usr/bin/perl
+#
+# Library functions for debhelper programs, perl version.
+#
+# Joey Hess, GPL copyright 1997-2008.
+
+package Debian::Debhelper::Dh_Lib;
+
+use v5.24;
+use warnings;
+use utf8;
+
+# Disable unicode_strings for now until a better solution for
+# Debian#971362 comes around.
+no feature 'unicode_strings';
+
+
+use constant {
+ # Lowest compat level supported
+ 'MIN_COMPAT_LEVEL' => 7,
+ # Lowest compat level that does *not* cause deprecation
+ # warnings
+ 'LOWEST_NON_DEPRECATED_COMPAT_LEVEL' => 10,
+ # Lowest compat level to generate "debhelper-compat (= X)"
+ # relations for.
+ 'LOWEST_VIRTUAL_DEBHELPER_COMPAT_LEVEL' => 9,
+ # Highest compat level permitted
+ 'MAX_COMPAT_LEVEL' => 15,
+ # Magic value for xargs
+ 'XARGS_INSERT_PARAMS_HERE' => \'<INSERT-HERE>', #'# Hi emacs.
+ # Magic value for debhelper tools to request "current version"
+ 'DH_BUILTIN_VERSION' => \'<DH_LIB_VERSION>', #'# Hi emacs.
+ # Default Package-Type / extension (must be aligned with dpkg)
+ 'DEFAULT_PACKAGE_TYPE' => 'deb',
+};
+
+
+# The Makefile changes this if debhelper is installed in a PREFIX.
+my $prefix="/usr";
+# The Makefile changes this during install to match the actual version.
+use constant HIGHEST_STABLE_COMPAT_LEVEL => undef;
+
+# Locations we search for data files by default
+my @DATA_INC_PATH = (
+ "${prefix}/share/debhelper",
+);
+# Enable the use of DH_DATAFILES for testing purposes.
+unshift(@DATA_INC_PATH, split(':', $ENV{'DH_DATAFILES'})) if exists($ENV{'DH_DATAFILES'});
+
+use constant {
+ # Package-Type / extension for dbgsym packages
+ # TODO: Find a way to determine this automatically from the vendor
+ # - blocked by Dpkg::Vendor having a rather high load time (for debhelper)
+ 'DBGSYM_PACKAGE_TYPE' => DEFAULT_PACKAGE_TYPE,
+ # Lowest compat level supported that is not scheduled for removal.
+ # - Set to MIN_COMPAT_LEVEL when there are no pending compat removals.
+ 'MIN_COMPAT_LEVEL_NOT_SCHEDULED_FOR_REMOVAL' => MIN_COMPAT_LEVEL,
+};
+
+
+# Internal constants used to define limits in variable expansions.
+use constant {
+ # How many expansions are permitted in total.
+ _VAR_SUBST_EXPANSION_COUNT_LIMIT => 50,
+ # When recursion is enabled, how many times will we expand a pattern
+ # on the same position in the string.
+ _VAR_SUBST_SAME_POSITION_RECURSION_LIMIT => 20,
+ # Expansions are always allowed to grow up to this length regardless
+ # of original input size (provided it does not trip another limit)
+ _VAR_SUBST_EXPANSION_MIN_SUPPORTED_SIZE_LIMIT => 4096,
+ # Factor input is allowed to grow before it triggers an error
+ # (_VAR_SUBST_EXPANSION_MIN_SUPPORTED_SIZE_LIMIT overrules this for a
+ # given input if the max size limit computed with this factor is less
+ # than _VAR_SUBST_EXPANSION_MIN_SUPPORTED_SIZE_LIMIT)
+ _VAR_SUBST_EXPANSION_DYNAMIC_EXPANSION_FACTOR_LIMIT => 3,
+};
+
+
+use Errno qw(ENOENT EXDEV);
+use Exporter qw(import);
+use File::Glob qw(bsd_glob GLOB_CSH GLOB_NOMAGIC GLOB_TILDE);
+our (@EXPORT, %dh);
+@EXPORT = (
+ # debhelper basis functionality
+qw(
+ init
+ %dh
+ compat
+),
+ # External command tooling API
+qw(
+ doit
+ doit_noerror
+ qx_cmd
+ xargs
+ XARGS_INSERT_PARAMS_HERE
+ print_and_doit
+ print_and_doit_noerror
+
+ complex_doit
+ escape_shell
+),
+ # Logging/messaging/error handling
+qw(
+ error
+ error_exitcode
+ warning
+ verbose_print
+ nonquiet_print
+),
+ # Package related actions
+qw(
+ getpackages
+ sourcepackage
+ tmpdir
+ dbgsym_tmpdir
+ default_sourcedir
+ pkgfile
+ pkgext
+ pkgfilename
+ package_is_arch_all
+ package_binary_arch
+ package_declared_arch
+ package_multiarch
+ package_section
+ package_arch
+ package_type
+ process_pkg
+ compute_doc_main_package
+ isnative
+ is_udeb
+),
+ # File/path related actions
+qw(
+ basename
+ dirname
+ mkdirs
+ install_file
+ install_prog
+ install_lib
+ install_dir
+ install_dh_config_file
+ make_symlink
+ make_symlink_raw_target
+ rename_path
+ find_hardlinks
+ rm_files
+ excludefile
+ is_so_or_exec_elf_file
+ is_empty_dir
+ reset_perm_and_owner
+ log_installed_files
+
+ filearray
+ filedoublearray
+ glob_expand
+ glob_expand_error_handler_reject
+ glob_expand_error_handler_warn_and_discard
+ glob_expand_error_handler_silently_ignore
+ glob_expand_error_handler_reject_nomagic_warn_discard
+),
+ # Generate triggers, substvars, maintscripts, build-time temporary files
+qw(
+ autoscript
+ autotrigger
+ addsubstvar
+ delsubstvar
+
+ generated_file
+ restore_file_on_clean
+),
+ # Split tasks among different cores
+qw(
+ on_pkgs_in_parallel
+ on_items_in_parallel
+ on_selected_pkgs_in_parallel
+),
+ # R³ framework
+qw(
+ should_use_root
+ gain_root_cmd
+
+),
+ # Architecture, cross-tooling, build options and profiles
+qw(
+ dpkg_architecture_value
+ hostarch
+ cross_command
+ is_cross_compiling
+ is_build_profile_active
+ get_buildoption
+ perl_cross_incdir
+),
+ # Other
+qw(
+ open_gz
+ get_source_date_epoch
+ get_non_binnmu_date_epoch
+ deprecated_functionality
+),
+ # Special-case functionality (e.g. tool specific), debhelper(-core) functionality and deprecated functions
+qw(
+ inhibit_log
+ load_log
+ write_log
+ commit_override_log
+ debhelper_script_subst
+ debhelper_script_per_package_subst
+ is_make_jobserver_unavailable
+ clean_jobserver_makeflags
+ set_buildflags
+ DEFAULT_PACKAGE_TYPE
+ DBGSYM_PACKAGE_TYPE
+ DH_BUILTIN_VERSION
+ is_known_package
+ assert_opt_is_known_package
+ restore_all_files
+
+ buildarch
+));
+
+my $MAX_PROCS = get_buildoption("parallel") || 1;
+my $DH_TOOL_VERSION;
+
+our $PKGNAME_REGEX = qr/[a-z0-9][-+\.a-z0-9]+/o;
+our $PKGVERSION_REGEX = qr/
+ (?: \d+ : )? # Optional epoch
+ [0-9][0-9A-Za-z.+:~]* # Upstream version (with no hyphens)
+ (?: - [0-9A-Za-z.+:~]+ )* # Optional debian revision (+ upstreams versions with hyphens)
+ /xoa;
+our $MAINTSCRIPT_TOKEN_REGEX = qr/[A-Za-z0-9_.+]+/o;
+our $TOOL_NAME = basename($0);
+
+# From Policy 5.1:
+#
+# The field name is composed of US-ASCII characters excluding control
+# characters, space, and colon (i.e., characters in the ranges U+0021
+# (!) through U+0039 (9), and U+003B (;) through U+007E (~),
+# inclusive). Field names must not begin with the comment character
+# (U+0023 #), nor with the hyphen character (U+002D -).
+our $DEB822_FIELD_REGEX = qr/
+ [\x21\x22\x24-\x2C\x2F-\x39\x3B-\x7F] # First character
+ [\x21-\x39\x3B-\x7F]* # Subsequent characters (if any)
+ /xoa;
+
+our $PARSE_DH_SEQUENCE_INFO = 0;
+
+# We need logging in compat 9 or in override/hook targets (for --remaining-packages to work)
+# - This option is a global toggle to disable logs for special commands (e.g. dh or dh_clean)
+# It is initialized during "init". This implies that commands that never calls init are
+# not dh_* commands or do not need the log
+my $write_log = undef;
+
+sub init {
+ my %params=@_;
+
+ if ($params{internal_parse_dh_sequence_info}) {
+ $PARSE_DH_SEQUENCE_INFO = 1;
+ }
+
+ # Check if we can by-pass the expensive Getopt::Long by optimising for the
+ # common case of "-a" or "-i"
+ if (scalar(@ARGV) == 1 && ($ARGV[0] eq '-a' || $ARGV[0] eq '-i') &&
+ ! (defined $ENV{DH_OPTIONS} && length $ENV{DH_OPTIONS}) &&
+ ! (defined $ENV{DH_INTERNAL_OPTIONS} && length $ENV{DH_INTERNAL_OPTIONS})) {
+
+ # Single -i or -a as dh does it.
+ if ($ARGV[0] eq '-i') {
+ push(@{$dh{DOPACKAGES}}, getpackages('indep'));
+ $dh{DOINDEP} = 1;
+ } else {
+ push(@{$dh{DOPACKAGES}}, getpackages('arch'));
+ $dh{DOARCH} = 1;
+ }
+
+ if (! @{$dh{DOPACKAGES}}) {
+ if (! $dh{BLOCK_NOOP_WARNINGS}) {
+ warning("You asked that all arch in(dep) packages be built, but there are none of that type.");
+ }
+ exit(0);
+ }
+ # Clear @ARGV so we do not hit the expensive case below
+ @ARGV = ();
+ }
+
+ # Check to see if an option line starts with a dash,
+ # or DH_OPTIONS is set.
+ # If so, we need to pass this off to the resource intensive
+ # Getopt::Long, which I'd prefer to avoid loading at all if possible.
+ if ((defined $ENV{DH_OPTIONS} && length $ENV{DH_OPTIONS}) ||
+ (defined $ENV{DH_INTERNAL_OPTIONS} && length $ENV{DH_INTERNAL_OPTIONS}) ||
+ grep /^-/, @ARGV) {
+ eval { require Debian::Debhelper::Dh_Getopt; };
+ error($@) if $@;
+ Debian::Debhelper::Dh_Getopt::parseopts(%params);
+ }
+
+ # Another way to set excludes.
+ if (exists $ENV{DH_ALWAYS_EXCLUDE} && length $ENV{DH_ALWAYS_EXCLUDE}) {
+ push @{$dh{EXCLUDE}}, split(":", $ENV{DH_ALWAYS_EXCLUDE});
+ }
+
+ # Generate EXCLUDE_FIND.
+ if ($dh{EXCLUDE}) {
+ $dh{EXCLUDE_FIND}='';
+ foreach (@{$dh{EXCLUDE}}) {
+ my $x=$_;
+ $x=escape_shell($x);
+ $x=~s/\./\\\\./g;
+ $dh{EXCLUDE_FIND}.="-regex .\\*$x.\\* -or ";
+ }
+ $dh{EXCLUDE_FIND}=~s/ -or $//;
+ }
+
+ # Check to see if DH_VERBOSE environment variable was set, if so,
+ # make sure verbose is on. Otherwise, check DH_QUIET.
+ if (defined $ENV{DH_VERBOSE} && $ENV{DH_VERBOSE} ne "") {
+ $dh{VERBOSE}=1;
+ } elsif (defined $ENV{DH_QUIET} && $ENV{DH_QUIET} ne "" || get_buildoption("terse")) {
+ $dh{QUIET}=1;
+ }
+
+ # Check to see if DH_NO_ACT environment variable was set, if so,
+ # make sure no act mode is on.
+ if (defined $ENV{DH_NO_ACT} && $ENV{DH_NO_ACT} ne "") {
+ $dh{NO_ACT}=1;
+ }
+
+ # Get the name of the main binary package (first one listed in
+ # debian/control). Only if the main package was not set on the
+ # command line.
+ if (! exists $dh{MAINPACKAGE} || ! defined $dh{MAINPACKAGE}) {
+ my @allpackages=getpackages();
+ $dh{MAINPACKAGE}=$allpackages[0];
+ }
+
+ # Check if packages to build have been specified, if not, fall back to
+ # the default, building all relevant packages.
+ if (! defined $dh{DOPACKAGES} || ! @{$dh{DOPACKAGES}}) {
+ push @{$dh{DOPACKAGES}}, getpackages('both');
+ }
+
+ # Check to see if -P was specified. If so, we can only act on a single
+ # package.
+ if ($dh{TMPDIR} && $#{$dh{DOPACKAGES}} > 0) {
+ error("-P was specified, but multiple packages would be acted on (".join(",",@{$dh{DOPACKAGES}}).").");
+ }
+
+ # Figure out which package is the first one we were instructed to build.
+ # This package gets special treatement: files and directories specified on
+ # the command line may affect it.
+ $dh{FIRSTPACKAGE}=${$dh{DOPACKAGES}}[0];
+
+ # If no error handling function was specified, just propagate
+ # errors out.
+ if (! exists $dh{ERROR_HANDLER} || ! defined $dh{ERROR_HANDLER}) {
+ $dh{ERROR_HANDLER}='exit 1';
+ }
+
+ $dh{U_PARAMS} //= [];
+
+ if ($params{'inhibit_log'}) {
+ $write_log = 0;
+ } else {
+ # Only initialize if unset (i.e. avoid overriding an early call
+ # to inhibit_log()
+ $write_log //= 1;
+ }
+}
+
+# Ensure the log is written if requested but only if the command was
+# successful.
+sub END {
+ return if $? != 0 or not $write_log;
+ # If there is no 'debian/control', then we are not being run from
+ # a package directory and then the write_log will not do what we
+ # expect.
+ return if not -f 'debian/control';
+ if (compat(9, 1) || $ENV{DH_INTERNAL_OVERRIDE}) {
+ write_log($TOOL_NAME, @{$dh{DOPACKAGES}});
+ }
+}
+
+sub logfile {
+ my $package=shift;
+ my $ext=pkgext($package);
+ return "debian/${ext}debhelper.log"
+}
+
+sub load_log {
+ my ($package, $db)=@_;
+
+ my @log;
+ open(LOG, "<", logfile($package)) || return;
+ while (<LOG>) {
+ chomp;
+ my $command = $_;
+ push @log, $command;
+ $db->{$package}{$command}=1 if defined $db;
+ }
+ close LOG;
+ return @log;
+}
+
+sub write_log {
+ my $cmd=shift;
+ my @packages=@_;
+
+ return if $dh{NO_ACT};
+
+ foreach my $package (@packages) {
+ my $log = logfile($package);
+ open(LOG, ">>", $log) || error("failed to write to ${log}: $!");
+ print LOG $cmd."\n";
+ close LOG;
+ }
+}
+
+sub commit_override_log {
+ my @packages=@_;
+
+ return if $dh{NO_ACT};
+
+ foreach my $package (@packages) {
+ my @log = load_log($package);
+ my $log = logfile($package);
+ open(LOG, ">", $log) || error("failed to write to ${log}: $!");
+ print LOG $_."\n" foreach @log;
+ close LOG;
+ }
+}
+
+sub inhibit_log {
+ $write_log=0;
+}
+
+# Pass it an array containing the arguments of a shell command like would
+# be run by exec(). It turns that into a line like you might enter at the
+# shell, escaping metacharacters and quoting arguments that contain spaces.
+sub escape_shell {
+ my @args=@_;
+ my @ret;
+ foreach my $word (@args) {
+ if ($word=~/\s/) {
+ # Escape only a few things since it will be quoted.
+ # Note we use double quotes because you cannot
+ # escape ' in single quotes, while " can be escaped
+ # in double.
+ # This does make -V"foo bar" turn into "-Vfoo bar",
+ # but that will be parsed identically by the shell
+ # anyway..
+ $word=~s/([\n`\$"\\])/\\$1/g;
+ push @ret, "\"$word\"";
+ }
+ else {
+ # This list is from _Unix in a Nutshell_. (except '#')
+ $word=~s/([\s!"\$()*+#;<>?@\[\]\\`|~])/\\$1/g;
+ push @ret,$word;
+ }
+ }
+ return join(' ', @ret);
+}
+
+# Run a command, and display the command to stdout if verbose mode is on.
+# Throws error if command exits nonzero.
+#
+# All commands that modify files in $TMP should be run via this
+# function.
+#
+# Note that this cannot handle complex commands, especially anything
+# involving redirection. Use complex_doit instead.
+sub doit {
+ doit_noerror(@_) || error_exitcode(_format_cmdline(@_));
+}
+
+sub doit_noerror {
+ verbose_print(_format_cmdline(@_)) if $dh{VERBOSE};
+
+ goto \&_doit;
+}
+
+sub print_and_doit {
+ print_and_doit_noerror(@_) || error_exitcode(_format_cmdline(@_));
+}
+
+sub print_and_doit_noerror {
+ nonquiet_print(_format_cmdline(@_));
+
+ goto \&_doit;
+}
+
+sub _post_fork_setup_and_exec {
+ my ($close_stdin, $options, @cmd) = @_;
+ if (defined($options)) {
+ if (defined(my $dir = $options->{chdir})) {
+ if ($dir ne '.') {
+ chdir($dir) or error("chdir(\"${dir}\") failed: $!");
+ }
+ }
+ if ($close_stdin) {
+ open(STDIN, '<', '/dev/null') or error("redirect STDIN failed: $!");
+ }
+ if (defined(my $output = $options->{stdout})) {
+ open(STDOUT, '>', $output) or error("redirect STDOUT failed: $!");
+ }
+ if (defined(my $update_env = $options->{update_env})) {
+ while (my ($k, $v) = each(%{$update_env})) {
+ if (defined($v)) {
+ $ENV{$k} = $v;
+ } else {
+ delete($ENV{$k});
+ }
+ }
+ }
+ }
+ # Force execvp call to avoid shell. Apparently, even exec can
+ # involve a shell if you don't do this.
+ exec { $cmd[0] } @cmd or error('exec (for cmd: ' . escape_shell(@cmd) . ") failed: $!");
+}
+
+sub _doit {
+ my (@cmd) = @_;
+ my $options = ref($cmd[0]) ? shift(@cmd) : undef;
+ # In compat <= 11, we warn, in compat 12 we assume people know what they are doing.
+ if (not defined($options) and @cmd == 1 and compat(12) and $cmd[0] =~ m/[\s<&>|;]/) {
+ deprecated_functionality('doit() + doit_*() calls will no longer spawn a shell in compat 12 for single string arguments (please use complex_doit instead)',
+ 12);
+ return 1 if $dh{NO_ACT};
+ return system(@cmd) == 0;
+ }
+ return 1 if $dh{NO_ACT};
+ my $pid = fork() // error("fork(): $!");
+ if (not $pid) {
+ _post_fork_setup_and_exec(1, $options, @cmd) // error("Assertion error: sub should not return!");
+ }
+ return waitpid($pid, 0) == $pid && $? == 0;
+}
+
+sub _format_cmdline {
+ my (@cmd) = @_;
+ my $options = ref($cmd[0]) ? shift(@cmd) : {};
+ my $cmd_line = escape_shell(@cmd);
+ if (defined(my $update_env = $options->{update_env})) {
+ my $need_env = 0;
+ my @params;
+ for my $key (sort(keys(%{$update_env}))) {
+ my $value = $update_env->{$key};
+ if (defined($value)) {
+ my $quoted_key = escape_shell($key);
+ push(@params, join('=', $quoted_key, escape_shell($value)));
+ # shell does not like: "FU BAR"=1 cmd
+ # if the ENV key has weird symbols, the best bet is to use env
+ $need_env = 1 if $quoted_key ne $key;
+ } else {
+ $need_env = 1;
+ push(@params, escape_shell("--unset=${key}"));
+ }
+ }
+ unshift(@params, 'env', '--') if $need_env;
+ $cmd_line = join(' ', @params, $cmd_line);
+ }
+ if (defined(my $dir = $options->{chdir})) {
+ $cmd_line = join(' ', 'cd', escape_shell($dir), '&&', $cmd_line) if $dir ne '.';
+ }
+ if (defined(my $output = $options->{stdout})) {
+ $cmd_line .= ' > ' . escape_shell($output);
+ }
+ return $cmd_line;
+}
+
+sub qx_cmd {
+ my (@cmd) = @_;
+ my $options = ref($cmd[0]) ? shift(@cmd) : undef;
+ my ($output, @output);
+ my $pid = open(my $fd, '-|') // error('fork (for cmd: ' . escape_shell(@cmd) . ") failed: $!");
+ if ($pid == 0) {
+ _post_fork_setup_and_exec(0, $options, @cmd) // error("Assertion error: sub should not return!");
+ }
+ if (wantarray) {
+ @output = <$fd>;
+ } else {
+ local $/ = undef;
+ $output = <$fd>;
+ }
+ if (not close($fd)) {
+ error("close pipe failed: $!") if $!;
+ error_exitcode(escape_shell(@cmd));
+ }
+ return @output if wantarray;
+ return $output;
+}
+
+# Run a command and display the command to stdout if verbose mode is on.
+# Use doit() if you can, instead of this function, because this function
+# forks a shell. However, this function can handle more complicated stuff
+# like redirection.
+sub complex_doit {
+ verbose_print(join(" ",@_));
+
+ if (! $dh{NO_ACT}) {
+ # The join makes system get a scalar so it forks off a shell.
+ system(join(" ", @_)) == 0 || error_exitcode(join(" ", @_))
+ }
+}
+
+
+sub error_exitcode {
+ my $command=shift;
+ if ($? == -1) {
+ error("$command failed to execute: $!");
+ }
+ elsif ($? & 127) {
+ error("$command died with signal ".($? & 127));
+ }
+ elsif ($?) {
+ error("$command returned exit code ".($? >> 8));
+ }
+ else {
+ warning("This tool claimed that $command have failed, but it");
+ warning("appears to have returned 0.");
+ error("Probably a bug in this tool is hiding the actual problem.");
+ }
+}
+
+# Some shortcut functions for installing files and dirs to always
+# have the same owner and mode
+# install_file - installs a non-executable
+# install_prog - installs an executable
+# install_lib - installs a shared library (some systems may need x-bit, others don't)
+# install_dir - installs a directory
+{
+ my $_loaded = 0;
+ sub install_file {
+ unshift(@_, 0644);
+ goto \&_install_file_to_path;
+ }
+
+ sub install_prog {
+ unshift(@_, 0755);
+ goto \&_install_file_to_path;
+ }
+ sub install_lib {
+ unshift(@_, 0644);
+ goto \&_install_file_to_path;
+ }
+
+ sub _install_file_to_path {
+ my ($mode, $source, $dest) = @_;
+ if (not $_loaded) {
+ $_loaded++;
+ require File::Copy;
+ }
+ verbose_print(sprintf('install -p -m%04o %s', $mode, escape_shell($source, $dest)))
+ if $dh{VERBOSE};
+ return 1 if $dh{NO_ACT};
+ # "install -p -mXXXX foo bar" silently discards broken
+ # symlinks to install the file in place. File::Copy does not,
+ # so emulate it manually. (#868204)
+ if ( -l $dest and not -e $dest and not unlink($dest) and $! != ENOENT) {
+ error("unlink $dest failed: $!");
+ }
+ File::Copy::copy($source, $dest) or error("copy($source, $dest): $!");
+ chmod($mode, $dest) or error("chmod($mode, $dest): $!");
+ my (@stat) = stat($source);
+ error("stat($source): $!") if not @stat;
+ utime($stat[8], $stat[9], $dest)
+ or error(sprintf("utime(%d, %d, %s): $!", $stat[8] , $stat[9], $dest));
+ return 1;
+ }
+}
+
+
+sub _mkdirs {
+ my ($log, @dirs) = @_;
+ return if not @dirs;
+ if ($log && $dh{VERBOSE}) {
+ verbose_print(sprintf('install -m0755 -d %s', escape_shell(@dirs)));
+ }
+ return 1 if $dh{NO_ACT};
+ state $_loaded;
+ if (not $_loaded) {
+ $_loaded++;
+ require File::Path;
+ }
+ my %opts = (
+ # install -d uses 0755 (no umask), make_path uses 0777 (& umask) by default.
+ # Since we claim to run install -d, then ensure the mode is correct.
+ 'chmod' => 0755,
+ );
+ eval {
+ File::Path::make_path(@dirs, \%opts);
+ };
+ if (my $err = "$@") {
+ $err =~ s/\s+at\s+\S+\s+line\s+\d+\.?\n//;
+ error($err);
+ }
+ return;
+}
+
+sub mkdirs {
+ my @to_create = grep { not -d $_ } @_;
+ return _mkdirs(0, @to_create);
+}
+
+sub install_dir {
+ my @dirs = @_;
+ return _mkdirs(1, @dirs);
+}
+
+sub rename_path {
+ my ($source, $dest) = @_;
+
+ if ($dh{VERBOSE}) {
+ my $files = escape_shell($source, $dest);
+ verbose_print("mv $files");
+ }
+ return 1 if $dh{NO_ACT};
+ if (not rename($source, $dest)) {
+ my $ok = 0;
+ if ($! == EXDEV) {
+ # Replay with a fork+exec to handle crossing two mount
+ # points (See #897569)
+ $ok = _doit('mv', $source, $dest);
+ }
+ if (not $ok) {
+ my $files = escape_shell($source, $dest);
+ error("mv $files: $!");
+ }
+ }
+ return 1;
+}
+
+sub reset_perm_and_owner {
+ my ($mode, @paths) = @_;
+ my $_mode;
+ my $use_root = should_use_root();
+ # Dark goat blood to tell 0755 from "0755"
+ if (length( do { no warnings "numeric"; $mode & "" } ) ) {
+ # 0755, leave it alone.
+ $_mode = $mode;
+ } else {
+ # "0755" -> convert to 0755
+ $_mode = oct($mode);
+ }
+ if ($dh{VERBOSE}) {
+ verbose_print(sprintf('chmod %#o -- %s', $_mode, escape_shell(@paths)));
+ verbose_print(sprintf('chown 0:0 -- %s', escape_shell(@paths))) if $use_root;
+ }
+ return if $dh{NO_ACT};
+ for my $path (@paths) {
+ chmod($_mode, $path) or error(sprintf('chmod(%#o, %s): %s', $mode, $path, $!));
+ if ($use_root) {
+ chown(0, 0, $path) or error("chown(0, 0, $path): $!");
+ }
+ }
+}
+
+# Run a command that may have a huge number of arguments, like xargs does.
+# Pass in a reference to an array containing the arguments, and then other
+# parameters that are the command and any parameters that should be passed to
+# it each time.
+sub xargs {
+ my ($args, @static_args) = @_;
+
+ # The kernel can accept command lines up to 20k worth of characters.
+ my $command_max=20000; # LINUX SPECIFIC!!
+ # (And obsolete; it's bigger now.)
+ # I could use POSIX::ARG_MAX, but that would be slow.
+
+ # Figure out length of static portion of command.
+ my $static_length=0;
+ my $subst_index = -1;
+ for my $i (0..$#static_args) {
+ my $arg = $static_args[$i];
+ if ($arg eq XARGS_INSERT_PARAMS_HERE) {
+ error("Only one insertion place supported in xargs, got command: @static_args") if $subst_index > -1;
+ $subst_index = $i;
+ next;
+ }
+ $static_length+=length($arg)+1;
+ }
+
+ my @collect=();
+ my $length=$static_length;
+ foreach (@$args) {
+ if (length($_) + 1 + $static_length > $command_max) {
+ error("This command is greater than the maximum command size allowed by the kernel, and cannot be split up further. What on earth are you doing? \"@_ $_\"");
+ }
+ $length+=length($_) + 1;
+ if ($length < $command_max) {
+ push @collect, $_;
+ }
+ else {
+ if ($#collect > -1) {
+ if ($subst_index < 0) {
+ doit(@static_args, @collect);
+ } else {
+ my @cmd = @static_args;
+ splice(@cmd, $subst_index, 1, @collect);
+ doit(@cmd);
+ }
+ }
+ @collect=($_);
+ $length=$static_length + length($_) + 1;
+ }
+ }
+ if ($#collect > -1) {
+ if ($subst_index < 0) {
+ doit(@static_args, @collect);
+ } else {
+ my @cmd = @static_args;
+ splice(@cmd, $subst_index, 1, @collect);
+ doit(@cmd);
+ }
+ }
+}
+
+# Print something if the verbose flag is on.
+sub verbose_print {
+ my $message=shift;
+
+ if ($dh{VERBOSE}) {
+ print "\t$message\n";
+ }
+}
+
+# Print something unless the quiet flag is on
+sub nonquiet_print {
+ my $message=shift;
+
+ if (!$dh{QUIET}) {
+ if (defined($message)) {
+ print "\t$message\n";
+ } else {
+ print "\n";
+ }
+ }
+}
+
+sub _color {
+ my ($msg, $color) = @_;
+ state $_use_color;
+ if (not defined($_use_color)) {
+ # This part is basically Dpkg::ErrorHandling::setup_color over again
+ # with some tweaks.
+ # (but the module uses Dpkg + Dpkg::Gettext, so it is very expensive
+ # to load)
+ my $mode = $ENV{'DH_COLORS'} // $ENV{'DPKG_COLORS'};
+ # Support NO_COLOR (https://no-color.org/)
+ $mode //= exists($ENV{'NO_COLOR'}) ? 'never' : 'auto';
+
+ if ($mode eq 'auto') {
+ $_use_color = 1 if -t *STDOUT or -t *STDERR;
+ } elsif ($mode eq 'always') {
+ $_use_color = 1;
+ } else {
+ $_use_color = 0;
+ }
+
+ eval {
+ require Term::ANSIColor if $_use_color;
+ };
+ if ($@) {
+ # In case of errors, skip colors.
+ $_use_color = 0;
+ }
+ }
+ if ($_use_color) {
+ local $ENV{'NO_COLOR'} = undef;
+ $msg = Term::ANSIColor::colored($msg, $color);
+ }
+ return $msg;
+}
+
+# Output an error message and die (can be caught).
+sub error {
+ my ($message) = @_;
+ # ensure the error code is well defined.
+ $! = 255;
+ die(_color($TOOL_NAME, 'bold') . ': ' . _color('error', 'bold red') . ": $message\n");
+}
+
+# Output a warning.
+sub warning {
+ my ($message) = @_;
+ $message //= '';
+
+ print STDERR _color($TOOL_NAME, 'bold') . ': ' . _color('warning', 'bold yellow') . ": $message\n";
+}
+
+# Returns the basename of the argument passed to it.
+sub basename {
+ my $fn=shift;
+
+ $fn=~s/\/$//g; # ignore trailing slashes
+ $fn=~s:^.*/(.*?)$:$1:;
+ return $fn;
+}
+
+# Returns the directory name of the argument passed to it.
+sub dirname {
+ my $fn=shift;
+
+ $fn=~s/\/$//g; # ignore trailing slashes
+ $fn=~s:^(.*)/.*?$:$1:;
+ return $fn;
+}
+
+# Pass in a number, will return true iff the current compatibility level
+# is less than or equal to that number.
+my $compat_from_bd;
+{
+ my $check_pending_removals = get_buildoption('dherroron', '') eq 'obsolete-compat-levels' ? 1 : 0;
+ my $warned_compat = $ENV{DH_INTERNAL_TESTSUITE_SILENT_WARNINGS} ? 1 : 0;
+ my $declared_compat;
+ my $delared_compat_source;
+ my $c;
+
+ # Used mainly for testing
+ sub resetcompat {
+ undef $c;
+ undef $compat_from_bd;
+ }
+
+ sub _load_compat_info {
+ my ($nowarn) = @_;
+
+ getpackages() if not defined($compat_from_bd);
+
+ $c=1;
+ if (-e 'debian/compat') {
+ open(my $compat_in, '<', "debian/compat") || error "debian/compat: $!";
+ my $l=<$compat_in>;
+ close($compat_in);
+ if (! defined $l || ! length $l) {
+ error("debian/compat must contain a positive number (found an empty first line)");
+
+ }
+ else {
+ chomp $l;
+ my $new_compat = $l;
+ $new_compat =~ s/^\s*+//;
+ $new_compat =~ s/\s*+$//;
+ if ($new_compat !~ m/^\d+$/) {
+ error("debian/compat must contain a positive number (found: \"${new_compat}\")");
+ }
+ if (defined($compat_from_bd) and $compat_from_bd != -1) {
+ warning("Please specify the debhelper compat level exactly once.");
+ warning(" * debian/compat requests compat ${new_compat}.");
+ warning(" * debian/control requests compat ${compat_from_bd} via \"debhelper-compat (= ${compat_from_bd})\"");
+ warning();
+ warning("Hint: If you just added a build-dependency on debhelper-compat, then please remember to remove debian/compat");
+ warning();
+ error("debhelper compat level specified both in debian/compat and via build-dependency on debhelper-compat");
+ }
+ $c = $new_compat;
+ }
+ $delared_compat_source = 'debian/compat';
+ } elsif ($compat_from_bd != -1) {
+ $c = $compat_from_bd;
+ $delared_compat_source = "Build-Depends: debhelper-compat (= $c)";
+ } elsif (not $nowarn) {
+ error("Please specify the compatibility level in debian/compat or via Build-Depends: debhelper-compat (= X)");
+ }
+
+ $declared_compat = int($c);
+
+ if (defined $ENV{DH_COMPAT}) {
+ my $override = $ENV{DH_COMPAT};
+ error("The environment variable DH_COMPAT must be a positive integer")
+ if $override ne q{} and $override !~ m/^\d+$/;
+ $c=int($ENV{DH_COMPAT}) if $override ne q{};
+ }
+ }
+
+ sub get_compat_info {
+ if (not $c) {
+ _load_compat_info(1);
+ }
+ return ($c, $declared_compat, $delared_compat_source);
+ }
+
+ sub compat {
+ my ($num, $nowarn) = @_;
+
+ if (not $c) {
+ _load_compat_info($nowarn);
+ }
+
+ if (not $nowarn) {
+ if ($c < MIN_COMPAT_LEVEL) {
+ error("Compatibility levels before ${\MIN_COMPAT_LEVEL} are no longer supported (level $c requested)");
+ }
+
+ if ($check_pending_removals and $c < MIN_COMPAT_LEVEL_NOT_SCHEDULED_FOR_REMOVAL) {
+ my $v = MIN_COMPAT_LEVEL_NOT_SCHEDULED_FOR_REMOVAL;
+ error("Compatibility levels before ${v} are scheduled for removal and DH_COMPAT_ERROR_ON_PENDING_REMOVAL was set (level $c requested)");
+ }
+
+ if ($c < LOWEST_NON_DEPRECATED_COMPAT_LEVEL && ! $warned_compat) {
+ warning("Compatibility levels before ${\LOWEST_NON_DEPRECATED_COMPAT_LEVEL} are deprecated (level $c in use)");
+ $warned_compat=1;
+ }
+
+ if ($c > MAX_COMPAT_LEVEL) {
+ error("Sorry, but ${\MAX_COMPAT_LEVEL} is the highest compatibility level supported by this debhelper.");
+ }
+ }
+
+ return ($c <= $num);
+ }
+}
+
+# Pass it a name of a binary package, it returns the name of the tmp dir to
+# use, for that package.
+sub tmpdir {
+ my $package=shift;
+
+ if ($dh{TMPDIR}) {
+ return $dh{TMPDIR};
+ }
+ else {
+ return "debian/$package";
+ }
+}
+
+# Pass it a name of a binary package, it returns the name of the staging dir to
+# use, for that package. (Usually debian/tmp)
+sub default_sourcedir {
+ my ($package) = @_;
+
+ return 'debian/tmp';
+}
+
+# Pass this the name of a binary package, and the name of the file wanted
+# for the package, and it will return the actual existing filename to use.
+#
+# It tries several filenames:
+# * debian/package.filename.hostarch
+# * debian/package.filename.hostos
+# * debian/package.filename
+# * debian/filename (if the package is the main package)
+# If --name was specified then the files
+# must have the name after the package name:
+# * debian/package.name.filename.hostarch
+# * debian/package.name.filename.hostos
+# * debian/package.name.filename
+# * debian/name.filename (if the package is the main package)
+
+{
+ my %_check_expensive;
+
+ sub pkgfile {
+ my ($package, $filename) = @_;
+ my (@try, $check_expensive);
+
+ if (not exists($_check_expensive{$filename})) {
+ my @f = grep {
+ !/\.debhelper$/
+ } bsd_glob("debian/*.$filename.*", GLOB_CSH & ~(GLOB_NOMAGIC|GLOB_TILDE));
+ if (not @f) {
+ $check_expensive = 0;
+ } else {
+ $check_expensive = 1;
+ }
+ $_check_expensive{$filename} = $check_expensive;
+ } else {
+ $check_expensive = $_check_expensive{$filename};
+ }
+
+ # Rewrite $filename after the check_expensive globbing above
+ # as $dh{NAME} is used as a prefix (so the glob above will
+ # cover it).
+ #
+ # In practise, it should not matter as NAME is ether set
+ # globally or not. But if someone is being "clever" then the
+ # cache is reusable and for the general/normal case, it has no
+ # adverse effects.
+ if (defined $dh{NAME}) {
+ $filename="$dh{NAME}.$filename";
+ }
+
+ if (ref($package) eq 'ARRAY') {
+ # !!NOT A PART OF THE PUBLIC API!!
+ # Bulk test used by dh to speed up the can_skip check. It
+ # is NOT useful for finding the most precise pkgfile.
+ push(@try, "debian/$filename");
+ for my $pkg (@{$package}) {
+ push(@try, "debian/${pkg}.${filename}");
+ if ($check_expensive) {
+ my $cross_type = uc(package_cross_type($pkg));
+ push(@try,
+ "debian/${pkg}.${filename}.".dpkg_architecture_value("DEB_${cross_type}_ARCH"),
+ "debian/${pkg}.${filename}.".dpkg_architecture_value("DEB_${cross_type}_ARCH_OS"),
+ );
+ }
+ }
+ } else {
+ # Avoid checking for hostarch+hostos unless we have reason
+ # to believe that they exist.
+ if ($check_expensive) {
+ my $cross_type = uc(package_cross_type($package));
+ push(@try,
+ "debian/${package}.${filename}.".dpkg_architecture_value("DEB_${cross_type}_ARCH"),
+ "debian/${package}.${filename}.".dpkg_architecture_value("DEB_${cross_type}_ARCH_OS"),
+ );
+ }
+ push(@try, "debian/$package.$filename");
+ if ($package eq $dh{MAINPACKAGE}) {
+ push @try, "debian/$filename";
+ }
+ }
+ foreach my $file (@try) {
+ return $file if -f $file;
+ }
+
+ return "";
+ }
+
+ # Used by dh to ditch some caches that makes assumptions about
+ # dh_-tools can do, which does not hold for override targets.
+ sub dh_clear_unsafe_cache {
+ %_check_expensive = ();
+ }
+}
+
+# Pass it a name of a binary package, it returns the name to prefix to files
+# in debian/ for this package.
+sub pkgext {
+ my ($package) = @_;
+ return "$package.";
+}
+
+# Pass it the name of a binary package, it returns the name to install
+# files by in eg, etc. Normally this is the same, but --name can override
+# it.
+sub pkgfilename {
+ my $package=shift;
+
+ if (defined $dh{NAME}) {
+ return $dh{NAME};
+ }
+ return $package;
+}
+
+# Returns 1 if the package is a native debian package, null otherwise.
+# As a side effect, sets $dh{VERSION} to the version of this package.
+sub isnative {
+ my ($package) = @_;
+ my $cache_key = $package;
+
+ state (%isnative_cache, %pkg_version);
+
+ if (exists($isnative_cache{$cache_key})) {
+ $dh{VERSION} = $pkg_version{$cache_key};
+ return $isnative_cache{$cache_key};
+ }
+
+ # Make sure we look at the correct changelog.
+ my $isnative_changelog = pkgfile($package,"changelog");
+ if (! $isnative_changelog) {
+ $isnative_changelog = "debian/changelog";
+ $cache_key = '_source';
+ # check if we looked up the default changelog
+ if (exists($isnative_cache{$cache_key})) {
+ $dh{VERSION} = $pkg_version{$cache_key};
+ return $isnative_cache{$cache_key};
+ }
+ }
+
+ if (not %isnative_cache) {
+ require Dpkg::Changelog::Parse;
+ }
+
+ my $res = Dpkg::Changelog::Parse::changelog_parse(
+ file => $isnative_changelog,
+ compression => 0,
+ );
+ if (not defined($res)) {
+ error("No changelog entries for $package!? (changelog file: ${isnative_changelog})");
+ }
+ my $version = $res->{'Version'};
+ # Do we have a valid version?
+ if (not defined($version) or not $version->is_valid) {
+ error("changelog parse failure; invalid or missing version");
+ }
+ # Get and cache the package version.
+ $dh{VERSION} = $pkg_version{$cache_key} = $version->as_string;
+
+ # Is this a native Debian package?
+ if (index($dh{VERSION}, '-') > -1) {
+ return $isnative_cache{$cache_key} = 0;
+ } else {
+ return $isnative_cache{$cache_key} = 1;
+ }
+}
+
+sub _tool_version {
+ return $DH_TOOL_VERSION if defined($DH_TOOL_VERSION);
+ if (defined($main::VERSION)) {
+ $DH_TOOL_VERSION = $main::VERSION;
+ }
+ if (defined($DH_TOOL_VERSION) and $DH_TOOL_VERSION eq DH_BUILTIN_VERSION) {
+ my $version = "UNRELEASED-${\MAX_COMPAT_LEVEL}";
+ eval {
+ require Debian::Debhelper::Dh_Version;
+ $version = $Debian::Debhelper::Dh_Version::version;
+ };
+ $DH_TOOL_VERSION = $version;
+ } else {
+ $DH_TOOL_VERSION //= 'UNDECLARED';
+ }
+ return $DH_TOOL_VERSION;
+}
+
+# Automatically add a shell script snippet to a debian script.
+# Only works if the script has #DEBHELPER# in it.
+#
+# Parameters:
+# 1: package
+# 2: script to add to
+# 3: filename of snippet
+# 4: either text: shell-quoted sed to run on the snippet. Ie, 's/#PACKAGE#/$PACKAGE/'
+# or a sub to run on each line of the snippet. Ie sub { s/#PACKAGE#/$PACKAGE/ }
+# or a hashref with keys being variables and values being their replacement. Ie. { PACKAGE => $PACKAGE }
+# 5: Internal usage only
+sub autoscript {
+ my ($package, $script, $filename, $sed, $extra_options) = @_;
+
+ my $tool_version = _tool_version();
+ # This is the file we will modify.
+ my $outfile="debian/".pkgext($package)."$script.debhelper";
+ if ($extra_options && exists($extra_options->{'snippet-order'})) {
+ my $order = $extra_options->{'snippet-order'};
+ error("Internal error - snippet order set to unknown value: \"${order}\"")
+ if $order ne 'service';
+ $outfile = generated_file($package, "${script}.${order}");
+ }
+
+ # Figure out what shell script snippet to use.
+ my $infile;
+ if (defined($ENV{DH_AUTOSCRIPTDIR}) &&
+ -e "$ENV{DH_AUTOSCRIPTDIR}/$filename") {
+ $infile="$ENV{DH_AUTOSCRIPTDIR}/$filename";
+ }
+ else {
+ for my $dir (@DATA_INC_PATH) {
+ my $path = "${dir}/autoscripts/${filename}";
+ if (-e $path) {
+ $infile = $path;
+ last;
+ }
+ }
+ if (not defined($infile)) {
+ my @dirs = map { "$_/autoscripts" } @DATA_INC_PATH;
+ unshift(@dirs, $ENV{DH_AUTOSCRIPTDIR}) if exists($ENV{DH_AUTOSCRIPTDIR});
+ error("Could not find autoscript $filename (search path: " . join(':', @dirs) . ')');
+ }
+ }
+
+ if (-e $outfile && ($script eq 'postrm' || $script eq 'prerm')) {
+ # Add fragments to top so they run in reverse order when removing.
+ if (not defined($sed) or ref($sed)) {
+ verbose_print("[META] Prepend autosnippet \"$filename\" to $script [${outfile}.new]");
+ if (not $dh{NO_ACT}) {
+ open(my $out_fd, '>', "${outfile}.new") or error("open(${outfile}.new): $!");
+ print {$out_fd} '# Automatically added by ' . $TOOL_NAME . "/${tool_version}\n";
+ autoscript_sed($sed, $infile, undef, $out_fd);
+ print {$out_fd} "# End automatically added section\n";
+ open(my $in_fd, '<', $outfile) or error("open($outfile): $!");
+ while (my $line = <$in_fd>) {
+ print {$out_fd} $line;
+ }
+ close($in_fd);
+ close($out_fd) or error("close(${outfile}.new): $!");
+ }
+ } else {
+ complex_doit("echo \"# Automatically added by ".$TOOL_NAME."/${tool_version}\"> $outfile.new");
+ autoscript_sed($sed, $infile, "$outfile.new");
+ complex_doit("echo '# End automatically added section' >> $outfile.new");
+ complex_doit("cat $outfile >> $outfile.new");
+ }
+ rename_path("${outfile}.new", $outfile);
+ } elsif (not defined($sed) or ref($sed)) {
+ verbose_print("[META] Append autosnippet \"$filename\" to $script [${outfile}]");
+ if (not $dh{NO_ACT}) {
+ open(my $out_fd, '>>', $outfile) or error("open(${outfile}): $!");
+ print {$out_fd} '# Automatically added by ' . $TOOL_NAME . "/${tool_version}\n";
+ autoscript_sed($sed, $infile, undef, $out_fd);
+ print {$out_fd} "# End automatically added section\n";
+ close($out_fd) or error("close(${outfile}): $!");
+ }
+ } else {
+ complex_doit("echo \"# Automatically added by ".$TOOL_NAME."/${tool_version}\">> $outfile");
+ autoscript_sed($sed, $infile, $outfile);
+ complex_doit("echo '# End automatically added section' >> $outfile");
+ }
+}
+
+sub autoscript_sed {
+ my ($sed, $infile, $outfile, $out_fd) = @_;
+ if (not defined($sed) or ref($sed)) {
+ my $out = $out_fd;
+ open(my $in, '<', $infile) or error("open $infile failed: $!");
+ if (not defined($out_fd)) {
+ open($out, '>>', $outfile) or error("open($outfile): $!");
+ }
+ if (not defined($sed) or ref($sed) eq 'CODE') {
+ while (<$in>) { $sed->() if $sed; print {$out} $_; }
+ } else {
+ my $rstr = sprintf('#(%s)#', join('|', reverse(sort(keys(%$sed)))));
+ my $regex = qr/$rstr/;
+ while (my $line = <$in>) {
+ $line =~ s/$regex/$sed->{$1}/eg;
+ print {$out} $line;
+ }
+ }
+ if (not defined($out_fd)) {
+ close($out) or error("close $outfile failed: $!");
+ }
+ close($in) or error("close $infile failed: $!");
+ }
+ else {
+ error("Internal error - passed open handle for legacy method") if defined($out_fd);
+ complex_doit("sed \"$sed\" $infile >> $outfile");
+ }
+}
+
+# Adds a trigger to the package
+{
+ my %VALID_TRIGGER_TYPES = map { $_ => 1 } qw(
+ interest interest-await interest-noawait
+ activate activate-await activate-noawait
+ );
+
+ sub autotrigger {
+ my ($package, $trigger_type, $trigger_target) = @_;
+ my ($triggers_file, $ifd, $tool_version);
+
+ if (not exists($VALID_TRIGGER_TYPES{$trigger_type})) {
+ require Carp;
+ Carp::confess("Invalid/unknown trigger ${trigger_type}");
+ }
+ return if $dh{NO_ACT};
+
+ $tool_version = _tool_version();
+ $triggers_file = generated_file($package, 'triggers');
+ if ( -f $triggers_file ) {
+ open($ifd, '<', $triggers_file)
+ or error("open $triggers_file failed $!");
+ } else {
+ open($ifd, '<', '/dev/null')
+ or error("open /dev/null failed $!");
+ }
+ open(my $ofd, '>', "${triggers_file}.new")
+ or error("open ${triggers_file}.new failed: $!");
+ while (my $line = <$ifd>) {
+ next if $line =~ m{\A \Q${trigger_type}\E \s+
+ \Q${trigger_target}\E (?:\s|\Z)
+ }x;
+ print {$ofd} $line;
+ }
+ print {$ofd} '# Triggers added by ' . $TOOL_NAME . "/${tool_version}\n";
+ print {$ofd} "${trigger_type} ${trigger_target}\n";
+ close($ofd) or error("closing ${triggers_file}.new failed: $!");
+ close($ifd);
+ rename_path("${triggers_file}.new", $triggers_file);
+ }
+}
+
+# Generated files are cleaned by dh_clean AND dh_prep
+# - Package can be set to "_source" to generate a file relevant
+# for the source package (the meson build does this atm.).
+# Files for "_source" are only cleaned by dh_clean.
+sub generated_file {
+ my ($package, $filename, $mkdirs) = @_;
+ my $dir = "debian/.debhelper/generated/${package}";
+ my $path = "${dir}/${filename}";
+ $mkdirs //= 1;
+ mkdirs($dir) if $mkdirs;
+ return $path;
+}
+
+sub _update_substvar {
+ my ($substvar_file, $update_logic, $insert_logic) = @_;
+ my @lines;
+ my $changed = 0;
+ if ( -f $substvar_file) {
+ open(my $in, '<', $substvar_file) // error("open($substvar_file): $!");
+ while (my $line = <$in>) {
+ chomp($line);
+ my $orig_value = $line;
+ my $updated_value = $update_logic->($line);
+ $changed ||= !defined($updated_value) || $orig_value ne $updated_value;
+ push(@lines, $updated_value) if defined($updated_value);
+ }
+ close($in);
+ }
+ my $len = scalar(@lines);
+ push(@lines, $insert_logic->()) if $insert_logic;
+ $changed ||= $len != scalar(@lines);
+ if ($changed && !$dh{NO_ACT}) {
+ open(my $out, '>', "${substvar_file}.new") // error("open(${substvar_file}.new, \"w\"): $!");
+ for my $line (@lines) {
+ print {$out} "$line\n";
+ }
+ close($out) // error("close(${substvar_file}.new): $!");
+ rename_path("${substvar_file}.new", $substvar_file);
+ }
+ return;
+}
+
+# Removes a whole substvar line.
+sub delsubstvar {
+ my ($package, $substvar) = @_;
+ my $ext = pkgext($package);
+ my $substvarfile = "debian/${ext}substvars";
+
+ return _update_substvar($substvarfile, sub {
+ my ($line) = @_;
+ return $line if $line !~ m/^\Q${substvar}\E[?]?=/;
+ return;
+ });
+}
+
+# Adds a dependency on some package to the specified
+# substvar in a package's substvar's file.
+sub addsubstvar {
+ my ($package, $substvar, $deppackage, $verinfo, $remove) = @_;
+ my ($present);
+ my $ext = pkgext($package);
+ my $substvarfile = "debian/${ext}substvars";
+ my $str = $deppackage;
+ $str .= " ($verinfo)" if defined $verinfo && length $verinfo;
+
+ if (not defined($deppackage) and not $remove) {
+ error("Bug in helper: Must provide a value for addsubstvar (or set the remove flag, but then use delsubstvar instead)")
+ }
+
+ if (defined($str) and $str =~ m/[\n]/) {
+ $str =~ s/\n/\\n/g;
+ # Per #1026014
+ warning('Unescaped newlines in the value of a substvars can cause broken substvars files (see #1025714).');
+ warning("Hint: If you really need a newline character, provide it as \"\${Newline}\".");
+ error("Bug in helper: The substvar must not contain a raw newline character (${substvar}=${str})");
+ }
+
+ my $update_logic = sub {
+ my ($line) = @_;
+ return $line if $line !~ m/^\Q${substvar}\E([?]?=)(.*)/;
+ my $assignment_type = $1;
+ my %items = map { $_ => 1 } split(", ", $2);
+ $present = 1;
+ if ($remove) {
+ # Unchanged; we can avoid rewriting the file.
+ return $line if not exists($items{$str});
+ delete($items{$str});
+ my $replacement = join(", ", sort(keys(%items)));
+ return "${substvar}${assignment_type}${replacement}" if $replacement ne '';
+ return;
+ }
+ # Unchanged; we can avoid rewriting the file.
+ return $line if %items and exists($items{$str});
+
+ $items{$str} = 1;
+ return "${substvar}${assignment_type}" . join(", ", sort(keys(%items)));
+ };
+ my $insert_logic = sub {
+ return ("${substvar}=${str}") if not $present and not $remove;
+ return;
+ };
+ return _update_substvar($substvarfile, $update_logic, $insert_logic);
+}
+
+sub _glob_expand_error_default_msg {
+ my ($pattern, $dir_ref) = @_;
+ my $dir_list = join(', ', map { escape_shell($_) } @{$dir_ref});
+ return "Cannot find (any matches for) \"${pattern}\" (tried in $dir_list)";
+}
+
+sub glob_expand_error_handler_reject {
+ my $msg = _glob_expand_error_default_msg(@_);
+ error("$msg\n");
+ return;
+}
+
+sub glob_expand_error_handler_warn_and_discard {
+ my $msg = _glob_expand_error_default_msg(@_);
+ warning("$msg\n");
+ return;
+}
+
+# Emulates the "old" glob mechanism; not recommended for new code as
+# it permits some globs expand to nothing with only a warning.
+sub glob_expand_error_handler_reject_nomagic_warn_discard {
+ my ($pattern, $dir_ref) = @_;
+ for my $dir (@{$dir_ref}) {
+ my $full_pattern = "$dir/$pattern";
+ my @matches = bsd_glob($full_pattern, GLOB_CSH & ~(GLOB_TILDE));
+ if (@matches) {
+ goto \&glob_expand_error_handler_reject;
+ }
+ }
+ goto \&glob_expand_error_handler_warn_and_discard;
+}
+
+sub glob_expand_error_handler_silently_ignore {
+ return;
+}
+
+sub glob_expand {
+ my ($dir_ref, $error_handler, @patterns) = @_;
+ my @dirs = @{$dir_ref};
+ my @result;
+ for my $pattern (@patterns) {
+ my @m;
+ for my $dir (@dirs) {
+ my $full_pattern = "$dir/$pattern";
+ @m = bsd_glob($full_pattern, GLOB_CSH & ~(GLOB_NOMAGIC|GLOB_TILDE));
+ last if @m;
+ # Handle "foo{bar}" pattern (#888251)
+ if (-l $full_pattern or -e _) {
+ push(@m, $full_pattern);
+ last;
+ }
+ }
+ if (not @m) {
+ $error_handler //= \&glob_expand_error_handler_reject;
+ $error_handler->($pattern, $dir_ref);
+ }
+ push(@result, @m);
+ }
+ return @result;
+}
+
+
+my %BUILT_IN_SUBST = (
+ 'Space' => ' ',
+ 'Dollar' => '$',
+ 'Newline' => "\n",
+ 'Tab' => "\t",
+);
+
+sub _variable_substitution {
+ my ($text, $loc) = @_;
+ return $text if index($text, '$') < 0;
+ my $pos = -1;
+ my $subst_count = 0;
+ my $expansion_count = 0;
+ my $current_size = length($text);
+ my $expansion_size_limit = _VAR_SUBST_EXPANSION_DYNAMIC_EXPANSION_FACTOR_LIMIT * $current_size;
+ $expansion_size_limit = _VAR_SUBST_EXPANSION_MIN_SUPPORTED_SIZE_LIMIT
+ if $expansion_size_limit < _VAR_SUBST_EXPANSION_MIN_SUPPORTED_SIZE_LIMIT;
+ 1 while ($text =~ s<
+ \$\{([A-Za-z0-9][-_:0-9A-Za-z]*)\} # Match ${something} and replace it
+ >[
+ my $match = $1;
+ my $new_pos = pos()//-1;
+ my $value;
+
+ if ($pos == $new_pos) {
+ # Safe-guard in case we ever implement recursive expansion
+ error("Error substituting in ${loc} (at position $pos); recursion limit while expanding \${${match}}")
+ if (++$subst_count >= _VAR_SUBST_SAME_POSITION_RECURSION_LIMIT);
+ } else {
+ $subst_count = 0;
+ $pos = $new_pos;
+ if (++$expansion_count >= _VAR_SUBST_EXPANSION_COUNT_LIMIT) {
+ error("Error substituting in ${loc}; substitution limit of ${expansion_count} reached");
+ }
+ }
+ if (exists($BUILT_IN_SUBST{$match})) {
+ $value = $BUILT_IN_SUBST{$match};
+ } elsif ($match =~ m/^DEB_(?:BUILD|HOST|TARGET)_/) {
+ $value = dpkg_architecture_value($match) //
+ error(qq{Cannot expand "\${${match}}" in ${loc} as it is not a known dpkg-architecture value});
+ } elsif ($match =~ m/^env:(.+)/) {
+ my $env_var = $1;
+ $value = $ENV{$env_var} //
+ error(qq{Cannot expand "\${${match}}" in ${loc} as the ENV variable "${env_var}" is unset});
+ }
+ error(qq{Cannot resolve variable "\${$match}" in ${loc}})
+ if not defined($value);
+ # We do not support recursive expansion.
+ $value =~ s/\$/\$\{\}/;
+ $current_size += length($value) - length($match) - 3;
+ if ($current_size > $expansion_size_limit) {
+ error("Refusing to expand \${${match}} in ${loc} - the original input seems to grow beyond reasonable'
+ . ' limits!");
+ }
+ $value;
+ ]gex);
+ $text =~ s/\$\{\}/\$/g;
+
+ return $text;
+}
+
+# Reads in the specified file, one line at a time. splits on words,
+# and returns an array of arrays of the contents.
+# If a value is passed in as the second parameter, then glob
+# expansion is done in the directory specified by the parameter ("." is
+# frequently a good choice).
+# In compat 13+, it will do variable expansion (after splitting the lines
+# into words)
+sub filedoublearray {
+ my ($file, $globdir, $error_handler) = @_;
+
+ # executable config files are a v9 thing.
+ my $x=! compat(8) && -x $file;
+ my $expand_patterns = compat(12) ? 0 : 1;
+ my $source;
+ if ($x) {
+ require Cwd;
+ my $cmd=Cwd::abs_path($file);
+ $ENV{"DH_CONFIG_ACT_ON_PACKAGES"} = join(",", @{$dh{"DOPACKAGES"}});
+ open(DH_FARRAY_IN, '-|', $cmd) || error("cannot run $file: $!");
+ delete $ENV{"DH_CONFIG_ACT_ON_PACKAGES"};
+ $source = "output of ./${file}";
+ }
+ else {
+ open (DH_FARRAY_IN, '<', $file) || error("cannot read $file: $!");
+ $source = $file;
+ }
+
+ my @ret;
+ while (<DH_FARRAY_IN>) {
+ chomp;
+ if ($x) {
+ if (m/^\s++$/) {
+ error("Executable config file $file produced a non-empty whitespace-only line");
+ }
+ } else {
+ s/^\s++//;
+ next if /^#/;
+ s/\s++$//;
+ }
+ # We always ignore/permit empty lines
+ next if $_ eq '';
+ my @line;
+ my $source_ref = "${source} (line $.)";
+
+ if (defined($globdir) && ! $x) {
+ if (ref($globdir)) {
+ my @patterns = split;
+ if ($expand_patterns) {
+ @patterns = map {_variable_substitution($_, $source_ref)} @patterns;
+ }
+ push(@line, glob_expand($globdir, $error_handler, @patterns));
+ } else {
+ # Legacy call - Silently discards globs that match nothing.
+ #
+ # The tricky bit is that the glob expansion is done
+ # as if we were in the specified directory, so the
+ # filenames that come out are relative to it.
+ foreach (map { glob "$globdir/$_" } split) {
+ s#^$globdir/##;
+ if ($expand_patterns) {
+ $_ = _variable_substitution($_, $source_ref);
+ }
+ push @line, $_;
+ }
+ }
+ }
+ else {
+ @line = split;
+ if ($expand_patterns) {
+ @line = map {_variable_substitution($_, $source_ref)} @line;
+ }
+ }
+ push @ret, [@line];
+ }
+
+ if (!close(DH_FARRAY_IN)) {
+ if ($x) {
+ _executable_dh_config_file_failed($file, $!, $?);
+ } else {
+ error("problem reading $file: $!");
+ }
+ }
+
+ return @ret;
+}
+
+# Reads in the specified file, one word at a time, and returns an array of
+# the result. Can do globbing as does filedoublearray.
+sub filearray {
+ return map { @$_ } filedoublearray(@_);
+}
+
+# Passed a filename, returns true if -X says that file should be excluded.
+sub excludefile {
+ my $filename = shift;
+ foreach my $f (@{$dh{EXCLUDE}}) {
+ return 1 if $filename =~ /\Q$f\E/;
+ }
+ return 0;
+}
+
+sub dpkg_architecture_value {
+ my $var = shift;
+ state %dpkg_arch_output;
+ if (exists($ENV{$var})) {
+ my $value = $ENV{$var};
+ return $value if $value ne q{};
+ warning("ENV[$var] is set to the empty string. It has been ignored to avoid bugs like #862842");
+ delete($ENV{$var});
+ }
+ if (! exists($dpkg_arch_output{$var})) {
+ # Return here if we already consulted dpkg-architecture
+ # (saves a fork+exec on unknown variables)
+ return if %dpkg_arch_output;
+
+ open(my $fd, '-|', 'dpkg-architecture')
+ or error("dpkg-architecture failed");
+ while (my $line = <$fd>) {
+ chomp($line);
+ my ($k, $v) = split(/=/, $line, 2);
+ $dpkg_arch_output{$k} = $v;
+ }
+ close($fd);
+ }
+ return $dpkg_arch_output{$var};
+}
+
+# Confusing name for hostarch
+sub buildarch {
+ deprecated_functionality('buildarch() is deprecated and replaced by hostarch()', 12);
+ goto \&hostarch;
+}
+
+# Returns the architecture that will run binaries produced (DEB_HOST_ARCH)
+sub hostarch {
+ dpkg_architecture_value('DEB_HOST_ARCH');
+}
+
+# Returns a truth value if this seems to be a cross-compile
+sub is_cross_compiling {
+ return dpkg_architecture_value("DEB_BUILD_GNU_TYPE")
+ ne dpkg_architecture_value("DEB_HOST_GNU_TYPE");
+}
+
+# Passed an arch and a space-separated list of arches to match against, returns true if matched
+sub samearch {
+ my $arch=shift;
+ my @archlist=split(/\s+/,shift);
+ state %knownsame;
+
+ foreach my $a (@archlist) {
+ if (exists $knownsame{$arch}{$a}) {
+ return 1 if $knownsame{$arch}{$a};
+ next;
+ }
+
+ require Dpkg::Arch;
+ if (Dpkg::Arch::debarch_is($arch, $a)) {
+ return $knownsame{$arch}{$a}=1;
+ }
+ else {
+ $knownsame{$arch}{$a}=0;
+ }
+ }
+
+ return 0;
+}
+
+
+# Returns a list of packages in the control file.
+# Pass "arch" or "indep" to specify arch-dependent (that will be built
+# for the system's arch) or independent. If nothing is specified,
+# returns all packages. Also, "both" returns the union of "arch" and "indep"
+# packages.
+#
+# As a side effect, populates %package_arches and %package_types
+# with the types of all packages (not only those returned).
+my (%package_types, %package_arches, %package_multiarches, %packages_by_type,
+ %package_sections, $sourcepackage, %package_cross_type, %dh_bd_sequences);
+
+# Resets the arrays; used mostly for testing
+sub resetpackages {
+ undef $sourcepackage;
+ %package_types = %package_arches = %package_multiarches =
+ %packages_by_type = %package_sections = %package_cross_type = ();
+ %dh_bd_sequences = ();
+}
+
+# Returns source package name
+sub sourcepackage {
+ getpackages() if not defined($sourcepackage);
+ return $sourcepackage;
+}
+
+sub getpackages {
+ my ($type) = @_;
+ error("getpackages: First argument must be one of \"arch\", \"indep\", or \"both\"")
+ if defined($type) and $type ne 'both' and $type ne 'indep' and $type ne 'arch';
+
+ $type //= 'all-listed-in-control-file';
+
+ if (not %packages_by_type) {
+ _parse_debian_control();
+ }
+ return @{$packages_by_type{$type}};
+}
+
+sub _strip_spaces {
+ my ($v) = @_;
+ return if not defined($v);
+ $v =~ s/^\s++//;
+ $v =~ s/\s++$//;
+ return $v;
+}
+
+sub _parse_debian_control {
+ my $valid_pkg_re = qr{^${PKGNAME_REGEX}$}o;
+ my (%seen, @profiles, $source_section, $cross_target_arch, %field_values,
+ $field_name, %bd_fields, $bd_field_value, %seen_fields, $fd);
+ if (exists $ENV{'DEB_BUILD_PROFILES'}) {
+ @profiles=split /\s+/, $ENV{'DEB_BUILD_PROFILES'};
+ }
+ if (not open($fd, '<', 'debian/control')) {
+ error("\"debian/control\" not found. Are you sure you are in the correct directory?")
+ if $! == ENOENT;
+ error("cannot read debian/control: $!\n");
+ };
+
+ $packages_by_type{$_} = [] for qw(both indep arch all-listed-in-control-file);
+ while (<$fd>) {
+ chomp;
+ s/\s+$//;
+ next if m/^\s*+\#/;
+
+ if (/^\s/) {
+ if (not %seen_fields) {
+ error("Continuation line seen before first stanza in debian/control (line $.)");
+ }
+ # Continuation line
+ s/^\s[.]?//;
+ push(@{$bd_field_value}, $_) if $bd_field_value;
+ # Ensure it is not completely empty or the code below will assume the paragraph ended
+ $_ = '.' if not $_;
+ } elsif (not $_ and not %seen_fields) {
+ # Ignore empty lines before first stanza
+ next;
+ } elsif ($_) {
+ my ($value);
+
+ if (m/^($DEB822_FIELD_REGEX):\s*(.*)/o) {
+ ($field_name, $value) = (lc($1), $2);
+ if (exists($seen_fields{$field_name})) {
+ my $first_time = $seen_fields{$field_name};
+ error("${field_name}-field appears twice in the same stanza of debian/control. " .
+ "First time on line $first_time, second time: $.");
+ }
+ $seen_fields{$field_name} = $.;
+ $bd_field_value = undef;
+ } else {
+ # Invalid file
+ error("Parse error in debian/control, line $., read: $_");
+ }
+ if ($field_name eq 'source') {
+ $sourcepackage = $value;
+ if ($sourcepackage !~ $valid_pkg_re) {
+ error('Source-field must be a valid package name, ' .
+ "got: \"${sourcepackage}\", should match \"${valid_pkg_re}\"");
+ }
+ next;
+ } elsif ($field_name eq 'section') {
+ $source_section = $value;
+ next;
+ } elsif ($field_name =~ /^(?:build-depends(?:-arch|-indep)?)$/) {
+ $bd_field_value = [$value];
+ $bd_fields{$field_name} = $bd_field_value;
+ }
+ }
+ last if not $_ or eof;
+ }
+ error("could not find Source: line in control file.") if not defined($sourcepackage);
+ if (%bd_fields) {
+ my ($dh_compat_bd, $final_level);
+ my %field2addon_type = (
+ 'build-depends' => 'both',
+ 'build-depends-arch' => 'arch',
+ 'build-depends-indep' => 'indep',
+ );
+ for my $field (sort(keys(%bd_fields))) {
+ my $value = join(' ', @{$bd_fields{$field}});
+ $value =~ s/^\s*//;
+ $value =~ s/\s*(?:,\s*)?$//;
+ for my $dep (split(/\s*,\s*/, $value)) {
+ if ($dep =~ m/^debhelper-compat\s*[(]\s*=\s*(${PKGVERSION_REGEX})\s*[)]$/) {
+ my $version = $1;
+ if ($version =~m/^(\d+)\D.*$/) {
+ my $guessed_compat = $1;
+ warning("Please use the compat level as the exact version rather than the full version.");
+ warning(" Perhaps you meant: debhelper-compat (= ${guessed_compat})");
+ if ($field ne 'build-depends') {
+ warning(" * Also, please move the declaration to Build-Depends (it was found in ${field})");
+ }
+ error("Invalid compat level ${version}, derived from relation: ${dep}");
+ }
+ $final_level = $version;
+ error("Duplicate debhelper-compat build-dependency: ${dh_compat_bd} vs. ${dep}") if $dh_compat_bd;
+ error("The debhelper-compat build-dependency must be in the Build-Depends field (not $field)")
+ if $field ne 'build-depends';
+ $dh_compat_bd = $dep;
+ } elsif ($dep =~ m/^debhelper-compat\s*(?:\S.*)?$/) {
+ my $clevel = "${\MAX_COMPAT_LEVEL}";
+ eval {
+ require Debian::Debhelper::Dh_Version;
+ $clevel = $Debian::Debhelper::Dh_Version::version;
+ };
+ $clevel =~ s/^\d+\K\D.*$//;
+ warning("Found invalid debhelper-compat relation: ${dep}");
+ warning(" * Please format the relation as (example): debhelper-compat (= ${clevel})");
+ warning(" * Note that alternatives, architecture restrictions, build-profiles etc. are not supported.");
+ if ($field ne 'build-depends') {
+ warning(" * Also, please move the declaration to Build-Depends (it was found in ${field})");
+ }
+ warning(" * If this is not possible, then please remove the debhelper-compat relation and insert the");
+ warning(" compat level into the file debian/compat. (E.g. \"echo ${clevel} > debian/compat\")");
+ error("Could not parse desired debhelper compat level from relation: $dep");
+ }
+ # Build-Depends on dh-sequence-<foo> OR dh-sequence-<foo> (<op> <version>)
+ if ($PARSE_DH_SEQUENCE_INFO and $dep =~ m/^dh-sequence-(${PKGNAME_REGEX})\s*(?:[(]\s*(?:[<>]?=|<<|>>)\s*(?:${PKGVERSION_REGEX})\s*[)])?(\s*[^\|]+[]>]\s*)?$/) {
+ my $sequence = $1;
+ my $has_profile_or_arch_restriction = $2 ? 1 : 0;
+ my $addon_type = $field2addon_type{$field};
+ if (not defined($field)) {
+ warning("Cannot map ${field} to an add-on type (like \"both\", \"indep\" or \"arch\")");
+ error("Internal error: Cannot satisfy dh sequence add-on request for sequence ${sequence} via ${field}.");
+ }
+ if (defined($dh_bd_sequences{$sequence})) {
+ error("Saw $dep multiple times (last time in $field). However dh only support that build-"
+ . 'dependency at most once across all Build-Depends(-Arch|-Indep) fields');
+ }
+ if ($has_profile_or_arch_restriction) {
+ require Dpkg::Deps;
+ my $dpkg_dep = Dpkg::Deps::deps_parse($dep, build_profiles => \@profiles, build_dep => 1,
+ reduce_restrictions => 1);
+ # If dpkg reduces it to nothing, then it was not relevant for us after all
+ next if not $dpkg_dep;
+ }
+ $dh_bd_sequences{$sequence} = $addon_type;
+ }
+ }
+ }
+ $compat_from_bd = $final_level // -1;
+ } else {
+ $compat_from_bd = -1;
+ }
+
+ %seen_fields = ();
+ $field_name = undef;
+
+ while (<$fd>) {
+ chomp;
+ s/\s+$//;
+ if (m/^\#/) {
+ # Skip unless EOF for the special case where the last line
+ # is a comment line directly after the last stanza. In
+ # that case we need to "commit" the last stanza as well or
+ # we end up omitting the last package.
+ next if not eof;
+ $_ = '';
+ }
+
+ if (/^\s/) {
+ # Continuation line
+ if (not %seen_fields) {
+ error("Continuation line seen outside stanza in debian/control (line $.)");
+ }
+ s/^\s[.]?//;
+ $field_values{$field_name} .= ' ' . $_;
+ # Ensure it is not completely empty or the code below will assume the paragraph ended
+ $_ = '.' if not $_;
+ } elsif (not $_ and not %seen_fields) {
+ # Ignore empty lines before first stanza
+ next;
+ } elsif ($_) {
+ my ($value);
+ if (m/^($DEB822_FIELD_REGEX):\s*(.*)/o) {
+ ($field_name, $value) = (lc($1), $2);
+ if (exists($seen_fields{$field_name})) {
+ my $first_time = $seen_fields{$field_name};
+ error("${field_name}-field appears twice in the same stanza of debian/control. " .
+ "First time on line $first_time, second time: $.");
+ }
+
+ if ($field_name =~ m/^(?:x[bc]*-)?package-type$/) {
+ # Normalize variants into the main "Package-Type" field
+ $field_name = 'package-type';
+ if (exists($seen_fields{$field_name})) {
+ my $package = _strip_spaces($field_values{'package'} // '');
+ my $help = "(issue seen prior \"Package\"-field)";
+ $help = "for package ${package}" if $package;
+ error("Multiple definitions of (X-)Package-Type in line $. ${help}");
+ }
+ }
+ $seen_fields{$field_name} = $.;
+ $field_values{$field_name} = $value;
+ $bd_field_value = undef;
+ } else {
+ # Invalid file
+ error("Parse error in debian/control, line $., read: $_");
+ }
+ }
+ if (!$_ or eof) { # end of stanza.
+ if (%field_values) {
+ my $package = _strip_spaces($field_values{'package'} // '');
+ my $build_profiles = $field_values{'build-profiles'};
+ my $included_in_build_profile = 1;
+ my $arch = _strip_spaces($field_values{'architecture'} // '');
+ my $cross_type = _strip_spaces($field_values{'x-dh-build-for-type'} // 'host');
+
+ # Detect duplicate package names in the same control file.
+ if ($package eq '') {
+ error("Binary paragraph ending on line $. is missing mandatory \"Package\"-field");
+ }
+ if (! $seen{$package}) {
+ $seen{$package}=1;
+ } else {
+ error("debian/control has a duplicate entry for $package");
+ }
+ if ($package !~ $valid_pkg_re) {
+ error('Package-field must be a valid package name, ' .
+ "got: \"${package}\", should match \"${valid_pkg_re}\"");
+ }
+ if ($cross_type ne 'host' and $cross_type ne 'target') {
+ error("Unknown value of X-DH-Build-For-Type \"$cross_type\" for package $package");
+ }
+
+ $package_types{$package} = _strip_spaces($field_values{'package-type'} // 'deb');
+ $package_arches{$package} = $arch;
+ $package_multiarches{$package} = _strip_spaces($field_values{'multi-arch'} // '');
+ $package_sections{$package} = _strip_spaces($field_values{'section'} // $source_section);
+ $package_cross_type{$package} = $cross_type;
+ push(@{$packages_by_type{'all-listed-in-control-file'}}, $package);
+
+ if (defined($build_profiles)) {
+ eval {
+ # rely on libdpkg-perl providing the parsing functions
+ # because if we work on a package with a Build-Profiles
+ # field, then a high enough version of dpkg-dev is needed
+ # anyways
+ require Dpkg::BuildProfiles;
+ my @restrictions = Dpkg::BuildProfiles::parse_build_profiles($build_profiles);
+ if (@restrictions) {
+ $included_in_build_profile = Dpkg::BuildProfiles::evaluate_restriction_formula(
+ \@restrictions,
+ \@profiles);
+ }
+ };
+ if ($@) {
+ error("The control file has a Build-Profiles field. Requires libdpkg-perl >= 1.17.14");
+ }
+ }
+
+ if ($included_in_build_profile) {
+ if ($arch eq 'all') {
+ push(@{$packages_by_type{'indep'}}, $package);
+ push(@{$packages_by_type{'both'}}, $package);
+ } else {
+ my $included = 0;
+ $included = 1 if $arch eq 'any';
+ if (not $included) {
+ my $desired_arch = hostarch();
+ if ($cross_type eq 'target') {
+ $cross_target_arch //= dpkg_architecture_value('DEB_TARGET_ARCH');
+ $desired_arch = $cross_target_arch;
+ }
+ $included = 1 if samearch($desired_arch, $arch);
+ }
+ if ($included) {
+ push(@{$packages_by_type{'arch'}}, $package);
+ push(@{$packages_by_type{'both'}}, $package);
+ }
+ }
+ }
+ }
+ %field_values = ();
+ %seen_fields = ();
+ }
+ }
+ close($fd);
+}
+
+# Return true if we should use root.
+# - Takes an optional keyword; if passed, this will return true if the keyword is listed in R^3 (Rules-Requires-Root)
+# - If the optional keyword is omitted or not present in R^3 and R^3 is not 'binary-targets', then returns false
+# - Returns true otherwise (i.e. keyword is in R^3 or R^3 is 'binary-targets')
+sub should_use_root {
+ my ($keyword) = @_;
+ my $rrr_env = $ENV{'DEB_RULES_REQUIRES_ROOT'} // 'binary-targets';
+ $rrr_env =~ s/^\s++//;
+ $rrr_env =~ s/\s++$//;
+ return 0 if $rrr_env eq 'no';
+ return 1 if $rrr_env eq 'binary-targets';
+ return 0 if not defined($keyword);
+
+ state %rrr = map { $_ => 1 } split(' ', $rrr_env);
+ return 1 if exists($rrr{$keyword});
+ return 0;
+}
+
+# Returns the "gain root command" as a list suitable for passing as a part of the command to "doit()"
+sub gain_root_cmd {
+ my $raw_cmd = $ENV{DEB_GAIN_ROOT_CMD};
+ return if not defined($raw_cmd) or $raw_cmd =~ m/^\s*+$/;
+ return split(' ', $raw_cmd);
+}
+
+sub root_requirements {
+ my $rrr_env = $ENV{'DEB_RULES_REQUIRES_ROOT'} // 'binary-targets';
+ $rrr_env =~ s/^\s++//;
+ $rrr_env =~ s/\s++$//;
+ return 'none' if $rrr_env eq 'no';
+ return 'legacy-root' if $rrr_env eq 'binary-targets';
+ return 'targeted-promotion';
+}
+
+# Returns the arch a package will build for.
+#
+# Deprecated: please switch to the more descriptive
+# package_binary_arch function instead.
+sub package_arch {
+ my $package=shift;
+ return package_binary_arch($package);
+}
+
+# Returns the architecture going into the resulting .deb, i.e. the
+# host architecture or "all".
+sub package_binary_arch {
+ my $package=shift;
+
+ if (! exists $package_arches{$package}) {
+ warning "package $package is not in control info";
+ return hostarch();
+ }
+ return 'all' if $package_arches{$package} eq 'all';
+ return dpkg_architecture_value('DEB_TARGET_ARCH') if package_cross_type($package) eq 'target';
+ return hostarch();
+}
+
+# Returns the Architecture: value which the package declared.
+sub package_declared_arch {
+ my $package=shift;
+
+ if (! exists $package_arches{$package}) {
+ warning "package $package is not in control info";
+ return hostarch();
+ }
+ return $package_arches{$package};
+}
+
+# Returns whether the package specified Architecture: all
+sub package_is_arch_all {
+ my $package=shift;
+
+ if (! exists $package_arches{$package}) {
+ warning "package $package is not in control info";
+ return hostarch();
+ }
+ return $package_arches{$package} eq 'all';
+}
+
+# Returns the multiarch value of a package.
+sub package_multiarch {
+ my $package=shift;
+
+ # Test the architecture field instead, as it is common for a
+ # package to not have a multi-arch value.
+ if (! exists $package_arches{$package}) {
+ warning "package $package is not in control info";
+ # The only sane default
+ return 'no';
+ }
+ return $package_multiarches{$package} // 'no';
+}
+
+# Returns the (raw) section value of a package (possibly including component).
+sub package_section {
+ my ($package) = @_;
+
+ # Test the architecture field instead, as it is common for a
+ # package to not have a multi-arch value.
+ if (! exists $package_sections{$package}) {
+ warning "package $package is not in control info";
+ return 'unknown';
+ }
+ return $package_sections{$package} // 'unknown';
+}
+
+sub package_cross_type {
+ my ($package) = @_;
+
+ # Test the architecture field instead, as it is common for a
+ # package to not have a multi-arch value.
+ if (! exists $package_cross_type{$package}) {
+ warning "package $package is not in control info";
+ return 'host';
+ }
+ return $package_cross_type{$package} // 'host';
+}
+
+sub package_type {
+ my ($package) = @_;
+
+ if (! exists $package_types{$package}) {
+ warning "package $package is not in control info";
+ return DEFAULT_PACKAGE_TYPE;
+ }
+ return $package_types{$package};
+}
+
+# Return true if a given package is really a udeb.
+sub is_udeb {
+ my $package=shift;
+
+ return package_type($package) eq 'udeb';
+}
+
+
+sub process_pkg {
+ my ($package) = @_;
+ state %packages_to_process = map { $_ => 1 } @{$dh{DOPACKAGES}};
+ return $packages_to_process{$package} // 0;
+}
+
+# Only useful for dh(1)
+sub bd_dh_sequences {
+ # Use $sourcepackage as check because %dh_bd_sequence can be empty
+ # after running getpackages().
+ getpackages() if not defined($sourcepackage);
+ return \%dh_bd_sequences;
+}
+
+sub _concat_slurp_script_files {
+ my (@files) = @_;
+ my $res = '';
+ for my $file (@files) {
+ open(my $fd, '<', $file) or error("open($file) failed: $!");
+ my $f = join('', <$fd>);
+ close($fd);
+ $res .= $f;
+ }
+ return $res;
+}
+
+sub _substitution_generator {
+ my ($input) = @_;
+ my $cache = {};
+ return sub {
+ my ($orig_key) = @_;
+ return $cache->{$orig_key} if exists($cache->{$orig_key});
+ my $value = exists($input->{$orig_key}) ? $input->{$orig_key} : undef;
+ if (not defined($value)) {
+ if ($orig_key =~ m/^DEB_(?:BUILD|HOST|TARGET)_/) {
+ $value = dpkg_architecture_value($orig_key);
+ } elsif ($orig_key =~ m{^ENV[.](\S+)$}) {
+ $value = $ENV{$1} // '';
+ }
+ } elsif (ref($value) eq 'CODE') {
+ $value = $value->($orig_key);
+ } elsif ($value =~ s/^@//) {
+ $value = _concat_slurp_script_files($value);
+ }
+ $cache->{$orig_key} = $value;
+ return $value;
+ };
+}
+
+sub debhelper_script_per_package_subst {
+ my ($package, $provided_subst) = @_;
+ my %vars = %{$provided_subst};
+ $vars{'PACKAGE'} = $package if not exists($vars{'PACKAGE'});
+ for my $var (keys(%{$provided_subst})) {
+ if ($var !~ $Debian::Debhelper::Dh_Lib::MAINTSCRIPT_TOKEN_REGEX) {
+ warning("User defined token ${var} does not match ${Debian::Debhelper::Dh_Lib::MAINTSCRIPT_TOKEN_REGEX}");
+ error("Invalid provided token ${var}: It cannot be substituted as it does not follow the token name rules");
+ }
+ if ($var =~ m/^pkg[.]\Q${package}\E[.](.+)$/) {
+ my $new_key = $1;
+ $vars{$new_key} = $provided_subst->{$var};
+ }
+ }
+ return \%vars;
+}
+
+
+# Handles #DEBHELPER# substitution in a script; also can generate a new
+# script from scratch if none exists but there is a .debhelper file for it.
+sub debhelper_script_subst {
+ my ($package, $script, $extra_vars) = @_;
+
+ my $tmp=tmpdir($package);
+ my $ext=pkgext($package);
+ my $file=pkgfile($package,$script);
+ my %variables = defined($extra_vars) ? %{$extra_vars} : ();
+ my $service_script = generated_file($package, "${script}.service", 0);
+ my @generated_scripts = ("debian/$ext$script.debhelper", $service_script);
+ my $subst;
+ @generated_scripts = grep { -f } @generated_scripts;
+ if ($script eq 'prerm' or $script eq 'postrm') {
+ @generated_scripts = reverse(@generated_scripts);
+ }
+ if (not exists($variables{'DEBHELPER'})) {
+ $variables{'DEBHELPER'} = sub {
+ return _concat_slurp_script_files(@generated_scripts);
+ };
+ }
+ $subst = _substitution_generator(\%variables);
+
+ if ($file ne '') {
+ if ($dh{VERBOSE}) {
+ verbose_print('cp -f ' . escape_shell($file) . " $tmp/DEBIAN/$script");
+ verbose_print("[META] Replace #TOKEN#s in \"$tmp/DEBIAN/$script\"");
+ }
+ if (not $dh{NO_ACT}) {
+ my $regex = qr{#(${MAINTSCRIPT_TOKEN_REGEX})#}o;
+ open(my $out_fd, '>', "$tmp/DEBIAN/$script") or error("open($tmp/DEBIAN/$script) failed: $!");
+ open(my $in_fd, '<', $file) or error("open($file) failed: $!");
+ while (my $line = <$in_fd>) {
+ $line =~ s{$regex}{$subst->($1) // "#${1}#"}ge;
+ print {$out_fd} $line;
+ }
+ close($in_fd);
+ close($out_fd) or error("close($tmp/DEBIAN/$script) failed: $!");
+ }
+ reset_perm_and_owner('0755', "$tmp/DEBIAN/$script");
+ }
+ elsif (@generated_scripts) {
+ if ($dh{VERBOSE}) {
+ verbose_print(q{printf '#!/bin/sh\nset -e\n' > } . "$tmp/DEBIAN/$script");
+ verbose_print("cat @generated_scripts >> $tmp/DEBIAN/$script");
+ }
+ if (not $dh{NO_ACT}) {
+ open(my $out_fd, '>', "$tmp/DEBIAN/$script") or error("open($tmp/DEBIAN/$script): $!");
+ print {$out_fd} "#!/bin/sh\n";
+ print {$out_fd} "set -e\n";
+ for my $generated_script (@generated_scripts) {
+ open(my $in_fd, '<', $generated_script)
+ or error("open($generated_script) failed: $!");
+ while (my $line = <$in_fd>) {
+ print {$out_fd} $line;
+ }
+ close($in_fd);
+ }
+ close($out_fd) or error("close($tmp/DEBIAN/$script) failed: $!");
+ }
+ reset_perm_and_owner('0755', "$tmp/DEBIAN/$script");
+ }
+}
+
+sub rm_files {
+ my @files = @_;
+ verbose_print('rm -f ' . escape_shell(@files))
+ if $dh{VERBOSE};
+ return 1 if $dh{NO_ACT};
+ for my $file (@files) {
+ if (not unlink($file) and $! != ENOENT) {
+ error("unlink $file failed: $!");
+ }
+ }
+ return 1;
+}
+
+sub make_symlink_raw_target {
+ my ($src, $dest) = @_;
+ verbose_print('ln -s ' . escape_shell($src, $dest))
+ if $dh{VERBOSE};
+ return 1 if $dh{NO_ACT};
+ if (not symlink($src, $dest)) {
+ error("symlink($src, $dest) failed: $!");
+ }
+ return 1;
+}
+
+# make_symlink($dest, $src[, $tmp]) creates a symlink from $dest -> $src.
+# if $tmp is given, $dest will be created within it.
+# Usually $tmp should be the value of tmpdir($package);
+sub make_symlink{
+ my $dest = shift;
+ my $src = _expand_path(shift);
+ my $tmp = shift;
+ $tmp = '' if not defined($tmp);
+
+ if ($dest =~ m{(?:^|/)*[.]{2}(?:/|$)}) {
+ error("Invalid destination/link name (contains \"..\"-segments): $dest");
+ }
+
+ $src =~ s{^(?:[.]/+)++}{};
+ $dest =~ s{^(?:[.]/+)++}{};
+
+ $src=~s:^/++::;
+ $dest=~s:^/++::;
+
+ if ($src eq $dest) {
+ warning("skipping link from $src to self");
+ return;
+ }
+
+
+
+ # Policy says that if the link is all within one toplevel
+ # directory, it should be relative. If it's between
+ # top level directories, leave it absolute.
+ my @src_dirs = grep { $_ ne '.' } split(m:/+:,$src);
+ my @dest_dirs = grep { $_ ne '.' } split(m:/+:,$dest);
+ if (@src_dirs > 0 && $src_dirs[0] eq $dest_dirs[0]) {
+ # Figure out how much of a path $src and $dest
+ # share in common.
+ my $x;
+ for ($x=0; $x < @src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
+ # Build up the new src.
+ $src="";
+ for (1..$#dest_dirs - $x) {
+ $src.="../";
+ }
+ for ($x .. $#src_dirs) {
+ $src.=$src_dirs[$_]."/";
+ }
+ if ($x > $#src_dirs && ! length $src) {
+ $src="."; # special case
+ }
+ $src=~s:/$::;
+ }
+ else {
+ # Make sure it's properly absolute.
+ $src="/$src";
+ }
+
+ my $full_dest = "$tmp/$dest";
+ if ( -l $full_dest ) {
+ # All ok - we can always replace a link, and target directory must exists
+ } elsif (-d _) {
+ # We cannot replace a directory though
+ error("link destination $full_dest is a directory");
+ } else {
+ # Make sure the directory the link will be in exists.
+ my $basedir=dirname($full_dest);
+ install_dir($basedir);
+ }
+ rm_files($full_dest);
+ make_symlink_raw_target($src, $full_dest);
+}
+
+# _expand_path expands all path "." and ".." components, but doesn't
+# resolve symbolic links.
+sub _expand_path {
+ my $start = @_ ? shift : '.';
+ my @pathname = split(m:/+:,$start);
+ my @respath;
+ for my $entry (@pathname) {
+ if ($entry eq '.' || $entry eq '') {
+ # Do nothing
+ }
+ elsif ($entry eq '..') {
+ if ($#respath == -1) {
+ # Do nothing
+ }
+ else {
+ pop @respath;
+ }
+ }
+ else {
+ push @respath, $entry;
+ }
+ }
+
+ my $result;
+ for my $entry (@respath) {
+ $result .= '/' . $entry;
+ }
+ if (! defined $result) {
+ $result="/"; # special case
+ }
+ return $result;
+}
+
+# Checks if make's jobserver is enabled via MAKEFLAGS, but
+# the FD used to communicate with it is actually not available.
+sub is_make_jobserver_unavailable {
+ if (exists $ENV{MAKEFLAGS} &&
+ $ENV{MAKEFLAGS} =~ /(?:^|\s)--jobserver-(?:fds|auth)=(\d+)/) {
+ if (!open(my $in, "<&$1")) {
+ return 1; # unavailable
+ }
+ else {
+ close $in;
+ return 0; # available
+ }
+ }
+
+ return; # no jobserver specified
+}
+
+# Cleans out jobserver options from MAKEFLAGS.
+sub clean_jobserver_makeflags {
+ if (exists $ENV{MAKEFLAGS}) {
+ if ($ENV{MAKEFLAGS} =~ /(?:^|\s)--jobserver-(?:fds|auth)=\d+/) {
+ $ENV{MAKEFLAGS} =~ s/(?:^|\s)--jobserver-(?:fds|auth)=\S+//g;
+ $ENV{MAKEFLAGS} =~ s/(?:^|\s)-j\b//g;
+ }
+ delete $ENV{MAKEFLAGS} if $ENV{MAKEFLAGS} =~ /^\s*$/;
+ }
+}
+
+# If cross-compiling, returns appropriate cross version of command.
+sub cross_command {
+ my ($package, $command) = @_;
+ if (package_cross_type($package) eq 'target') {
+ if (dpkg_architecture_value("DEB_HOST_GNU_TYPE") ne dpkg_architecture_value("DEB_TARGET_GNU_TYPE")) {
+ return dpkg_architecture_value("DEB_TARGET_GNU_TYPE") . "-$command";
+ }
+ }
+ if (is_cross_compiling()) {
+ return dpkg_architecture_value("DEB_HOST_GNU_TYPE")."-$command";
+ }
+ else {
+ return $command;
+ }
+}
+
+# Returns the SOURCE_DATE_EPOCH ENV variable if set OR computes it
+# from the latest changelog entry, sets the SOURCE_DATE_EPOCH ENV
+# variable and returns the computed value.
+sub get_source_date_epoch {
+ return $ENV{SOURCE_DATE_EPOCH} if exists($ENV{SOURCE_DATE_EPOCH});
+ _parse_non_binnmu_date_epoch();
+ return $ENV{SOURCE_DATE_EPOCH};
+}
+
+{
+ my $_non_binnmu_date_epoch;
+
+ # Needed for dh_strip_nondeterminism - not exported by default because it is not likely
+ # to be useful beyond that one helper.
+ sub get_non_binnmu_date_epoch {
+ return $_non_binnmu_date_epoch if defined($_non_binnmu_date_epoch);
+ _parse_non_binnmu_date_epoch();
+ return $_non_binnmu_date_epoch;
+ }
+
+ sub _parse_non_binnmu_date_epoch {
+ eval { require Dpkg::Changelog::Debian };
+ if ($@) {
+ warning "unable to set SOURCE_DATE_EPOCH: $@";
+ return;
+ }
+ eval { require Time::Piece };
+ if ($@) {
+ warning "unable to set SOURCE_DATE_EPOCH: $@";
+ return;
+ }
+
+ my $changelog = Dpkg::Changelog::Debian->new(range => {"count" => 2});
+ $changelog->load("debian/changelog");
+
+ my $first_entry = $changelog->[0];
+ my $non_binnmu_entry = $first_entry;
+ my $optional_fields = $first_entry->get_optional_fields();
+ my $first_tt = $first_entry->get_timestamp();
+ $first_tt =~ s/\s*\([^\)]+\)\s*$//; # Remove the optional timezone codename
+ my $first_timestamp = Time::Piece->strptime($first_tt, "%a, %d %b %Y %T %z")->epoch;
+ my $non_binnmu_timestamp = $first_timestamp;
+ if (exists($optional_fields->{'Binary-Only'}) and lc($optional_fields->{'Binary-Only'}) eq 'yes') {
+ $non_binnmu_entry = $changelog->[1];
+ my $non_binnmu_options = $non_binnmu_entry->get_optional_fields();
+ if (exists($non_binnmu_options->{'Binary-Only'}) and lc($non_binnmu_options->{'Binary-Only'}) eq 'yes') {
+ error("internal error: Could not locate the first non-binnmu entry in the change (assumed it would be the second entry)");
+ }
+ my $non_binnmu_tt = $non_binnmu_entry->get_timestamp();
+ $non_binnmu_tt =~ s/\s*\([^\)]+\)\s*$//; # Remove the optional timezone codename
+ $non_binnmu_timestamp = Time::Piece->strptime($non_binnmu_tt, "%a, %d %b %Y %T %z")->epoch();
+ }
+
+ $ENV{SOURCE_DATE_EPOCH} = $first_timestamp if not exists($ENV{SOURCE_DATE_EPOCH});
+ $_non_binnmu_date_epoch = $non_binnmu_timestamp;
+ return;
+ }
+}
+
+# Setup the build ENV by setting dpkg-buildflags (via set_buildflags()) plus
+# cleaning up HOME (etc) in compat 13+
+sub setup_buildenv {
+ set_buildflags();
+ if (not compat(12)) {
+ setup_home_and_xdg_dirs();
+ }
+}
+
+sub setup_home_and_xdg_dirs {
+ require Cwd;
+ my $cwd = Cwd::getcwd();
+ my $home_dir = join('/', $cwd, generated_file('_source', 'home', 0));
+ my @paths = (
+ $home_dir,
+ );
+ my @clear_env = qw(
+ XDG_CACHE_HOME
+ XDG_CONFIG_DIRS
+ XDG_CONFIG_HOME
+ XDG_DATA_HOME
+ XDG_DATA_DIRS
+ XDG_RUNTIME_DIR
+ );
+ mkdirs(@paths);
+ for my $envname (@clear_env) {
+ delete($ENV{$envname});
+ }
+ $ENV{'HOME'} = $home_dir;
+ return;
+}
+
+sub reset_buildflags {
+ eval { require Dpkg::BuildFlags };
+ if ($@) {
+ warning "unable to load build flags: $@";
+ return;
+ }
+ delete($ENV{'DH_INTERNAL_BUILDFLAGS'});
+ my $buildflags = Dpkg::BuildFlags->new();
+ foreach my $flag ($buildflags->list()) {
+ next unless $flag =~ /^[A-Z]/; # Skip flags starting with lowercase
+ delete($ENV{$flag});
+ }
+}
+
+# Sets environment variables from dpkg-buildflags. Avoids changing
+# any existing environment variables.
+sub set_buildflags {
+ return if $ENV{DH_INTERNAL_BUILDFLAGS};
+ $ENV{DH_INTERNAL_BUILDFLAGS}=1;
+
+ # For the side effect of computing the SOURCE_DATE_EPOCH variable.
+ get_source_date_epoch();
+
+ return if compat(8);
+
+ # Export PERL_USE_UNSAFE_INC as a transitional step to allow us
+ # to remove . from @INC by default without breaking packages which
+ # rely on this [CVE-2016-1238]
+ $ENV{PERL_USE_UNSAFE_INC} = 1 if compat(10);
+
+ eval { require Dpkg::BuildFlags };
+ if ($@) {
+ warning "unable to load build flags: $@";
+ return;
+ }
+
+ my $buildflags = Dpkg::BuildFlags->new();
+ $buildflags->load_config();
+ foreach my $flag ($buildflags->list()) {
+ next unless $flag =~ /^[A-Z]/; # Skip flags starting with lowercase
+ if (! exists $ENV{$flag}) {
+ $ENV{$flag} = $buildflags->get($flag);
+ }
+ }
+}
+
+# Gets a DEB_BUILD_OPTIONS option, if set.
+sub get_buildoption {
+ my ($wanted, $default) = @_;
+
+ return $default if not exists($ENV{DEB_BUILD_OPTIONS});
+
+ foreach my $opt (split(/\s+/, $ENV{DEB_BUILD_OPTIONS})) {
+ # currently parallel= is the only one with a parameter
+ if ($opt =~ /^parallel=(-?\d+)$/ && $wanted eq 'parallel') {
+ return $1;
+ } elsif ($opt =~ m/^dherroron=(\S*)$/ && $wanted eq 'dherroron') {
+ my $value = $1;
+ if ($value ne 'obsolete-compat-levels') {
+ warning("Unknown value \"${value}\" as parameter for \"dherroron\" seen in DEB_BUILD_OPTIONS");
+ }
+ return $value;
+ } elsif ($opt eq $wanted) {
+ return 1;
+ }
+ }
+ return $default;
+}
+
+# Returns true if DEB_BUILD_PROFILES lists the given profile.
+sub is_build_profile_active {
+ my ($wanted) = @_;
+ return 0 if not exists($ENV{DEB_BUILD_PROFILES});
+ for my $prof (split(m/\s+/, $ENV{DEB_BUILD_PROFILES})) {
+ return 1 if $prof eq $wanted;
+ }
+ return 0;
+}
+
+
+# Called when an executable config file failed. It provides a more helpful error message in
+# some cases (especially when the file was not intended to be executable).
+sub _executable_dh_config_file_failed {
+ my ($source, $err, $proc_err) = @_;
+ error("Error closing fd/process for ${source}: $err") if $err;
+ # The interpreter did not like the file for some reason.
+ # Lets check if the maintainer intended it to be
+ # executable.
+ if (not is_so_or_exec_elf_file($source) and not _has_shebang_line($source)) {
+ warning("${source} is marked executable but does not appear to an executable config.");
+ warning();
+ warning("If ${source} is intended to be an executable config file, please ensure it can");
+ warning("be run as a stand-alone script/program (e.g. \"./${source}\")");
+ warning("Otherwise, please remove the executable bit from the file (e.g. chmod -x \"${source}\")");
+ warning();
+ warning('Please see "Executable debhelper config files" in debhelper(7) for more information.');
+ warning();
+ }
+ $? = $proc_err;
+ error_exitcode("${source} (executable config)");
+ return;
+}
+
+
+# install a dh config file (e.g. debian/<pkg>.lintian-overrides) into
+# the package. Under compat 9+ it may execute the file and use its
+# output instead.
+#
+# install_dh_config_file(SOURCE, TARGET)
+sub install_dh_config_file {
+ my ($source, $target) = @_;
+
+ if (!compat(8) and -x $source) {
+ my @sstat = stat(_) || error("cannot stat $source: $!");
+ open(my $tfd, '>', $target) || error("cannot open $target: $!");
+ chmod(0644, $tfd) || error("cannot chmod $target: $!");
+ open(my $sfd, '-|', $source) || error("cannot run $source: $!");
+ while (my $line = <$sfd>) {
+ print ${tfd} $line;
+ }
+ if (!close($sfd)) {
+ _executable_dh_config_file_failed($source, $!, $?);
+ }
+ close($tfd) || error("cannot close $target: $!");
+ # Set the mtime (and atime) to ensure reproducibility.
+ utime($sstat[9], $sstat[9], $target);
+ } else {
+ install_file($source, $target);
+ }
+ return 1;
+}
+
+sub restore_file_on_clean {
+ my ($file) = @_;
+ my $bucket_index = 'debian/.debhelper/bucket/index';
+ my $bucket_dir = 'debian/.debhelper/bucket/files';
+ my $checksum;
+ mkdirs($bucket_dir);
+ if ($file =~ m{^/}) {
+ error("restore_file_on_clean requires a path relative to the package dir");
+ }
+ $file =~ s{^\./}{}g;
+ $file =~ s{//++}{}g;
+ if ($file =~ m{^\.} or $file =~ m{/CVS/} or $file =~ m{/\.svn/}) {
+ # We do not want to smash a Vcs repository by accident.
+ warning("Attempt to store $file, which looks like a VCS file or");
+ warning("a hidden package file (like quilt's \".pc\" directory)");
+ error("This tool probably contains a bug.");
+ }
+ if (-l $file or not -f _) {
+ error("Cannot store $file: Can only store regular files (no symlinks, etc.)");
+ }
+ require Digest::SHA;
+
+ $checksum = Digest::SHA->new('256')->addfile($file, 'b')->hexdigest;
+
+ if (not $dh{NO_ACT}) {
+ my ($in_index);
+ open(my $fd, '+>>', $bucket_index)
+ or error("open($bucket_index, a+) failed: $!");
+ seek($fd, 0, 0);
+ while (my $line = <$fd>) {
+ my ($cs, $stored_file);
+ chomp($line);
+ ($cs, $stored_file) = split(m/ /, $line, 2);
+ next if ($stored_file ne $file);
+ $in_index = 1;
+ }
+ if (not $in_index) {
+ # Copy and then rename so we always have the full copy of
+ # the file in the correct place (if any at all).
+ doit('cp', '-an', '--reflink=auto', $file, "${bucket_dir}/${checksum}.tmp");
+ rename_path("${bucket_dir}/${checksum}.tmp", "${bucket_dir}/${checksum}");
+ print {$fd} "${checksum} ${file}\n";
+ }
+ close($fd) or error("close($bucket_index) failed: $!");
+ }
+
+ return 1;
+}
+
+sub restore_all_files {
+ my ($clear_index) = @_;
+ my $bucket_index = 'debian/.debhelper/bucket/index';
+ my $bucket_dir = 'debian/.debhelper/bucket/files';
+
+ return if not -f $bucket_index;
+ open(my $fd, '<', $bucket_index)
+ or error("open($bucket_index) failed: $!");
+
+ while (my $line = <$fd>) {
+ my ($cs, $stored_file, $bucket_file);
+ chomp($line);
+ ($cs, $stored_file) = split(m/ /, $line, 2);
+ $bucket_file = "${bucket_dir}/${cs}";
+ # Restore by copy and then rename. This ensures that:
+ # 1) If dh_clean is interrupted, we can always do a full restore again
+ # (otherwise, we would be missing some of the files and have to handle
+ # that with scary warnings)
+ # 2) The file is always fully restored or in its "pre-restore" state.
+ doit('cp', '-an', '--reflink=auto', $bucket_file, "${bucket_file}.tmp");
+ rename_path("${bucket_file}.tmp", $stored_file);
+ }
+ close($fd);
+ rm_files($bucket_index) if $clear_index;
+ return;
+}
+
+sub open_gz {
+ my ($file) = @_;
+ my $fd;
+ eval {
+ require PerlIO::gzip;
+ };
+ if ($@) {
+ open($fd, '-|', 'gzip', '-dc', $file)
+ or error("gzip -dc $file failed: $!");
+ } else {
+ # Pass ":unix" as well due to https://rt.cpan.org/Public/Bug/Display.html?id=114557
+ # Alternatively, we could ensure we always use "POSIX::_exit". Unfortunately,
+ # loading POSIX is insanely slow.
+ open($fd, '<:unix:gzip', $file)
+ or error("open $file [<:unix:gzip] failed: $!");
+ }
+ return $fd;
+}
+
+sub deprecated_functionality {
+ my ($warning_msg, $compat_removal, $removal_msg) = @_;
+ if (defined($compat_removal) and not compat($compat_removal - 1)) {
+ my $msg = $removal_msg // $warning_msg;
+ warning($msg);
+ error("This feature was removed in compat ${compat_removal}.");
+ } else {
+ warning($warning_msg);
+ warning("This feature will be removed in compat ${compat_removal}.")
+ if defined($compat_removal);
+ }
+ return 1;
+}
+
+sub log_installed_files {
+ my ($package, @patterns) = @_;
+
+ return if $dh{NO_ACT};
+ my $tool = $TOOL_NAME;
+ if (ref($package) eq 'HASH') {
+ my $options = $package;
+ $tool = $options->{'tool_name'} // error('Missing mandatory "tool_name" option for log_installed_files');
+ $package = $options->{'package'} // error('Missing mandatory "package" option for log_installed_files');
+ }
+
+ my $log = generated_file($package, 'installed-by-' . $tool);
+ open(my $fh, '>>', $log) or error("open $log: $!");
+ for my $src (@patterns) {
+ print $fh "$src\n";
+ }
+ close($fh) or error("close $log: $!");
+
+ return 1;
+}
+
+use constant {
+ # The ELF header is at least 0x32 bytes (32bit); any filer shorter than that is not an ELF file
+ ELF_MIN_LENGTH => 0x32,
+ ELF_MAGIC => "\x7FELF",
+ ELF_ENDIAN_LE => 0x01,
+ ELF_ENDIAN_BE => 0x02,
+ ELF_TYPE_EXECUTABLE => 0x0002,
+ ELF_TYPE_SHARED_OBJECT => 0x0003,
+};
+
+sub is_so_or_exec_elf_file {
+ my ($file) = @_;
+ open(my $fd, '<:raw', $file) or error("open $file: $!");
+ my $buflen = 0;
+ my ($buf, $endian);
+ while ($buflen < ELF_MIN_LENGTH) {
+ my $r = read($fd, $buf, ELF_MIN_LENGTH - $buflen, $buflen) // error("read ($file): $!");
+ last if $r == 0; # EOF
+ $buflen += $r
+ }
+ close($fd);
+ return 0 if $buflen < ELF_MIN_LENGTH;
+
+ return 0 if substr($buf, 0x00, 4) ne ELF_MAGIC;
+ $endian = unpack('c', substr($buf, 0x05, 1));
+ my ($long_format, $short_format);
+
+ if ($endian == ELF_ENDIAN_BE) {
+ $long_format = 'N';
+ $short_format = 'n';
+ } elsif ($endian == ELF_ENDIAN_LE) {
+ $long_format = 'V';
+ $short_format = 'v';
+ } else {
+ return 0;
+ }
+ my $elf_version = substr($buf, 0x14, 4);
+ my $elf_type = substr($buf, 0x10, 2);
+
+
+ return 0 if unpack($long_format, $elf_version) != 0x00000001;
+ my $elf_type_unpacked = unpack($short_format, $elf_type);
+ return 0 if $elf_type_unpacked != ELF_TYPE_EXECUTABLE and $elf_type_unpacked != ELF_TYPE_SHARED_OBJECT;
+ return 1;
+}
+
+sub _has_shebang_line {
+ my ($file) = @_;
+ open(my $fd, '<', $file) or error("open $file: $!");
+ my $line = <$fd>;
+ close($fd);
+ return 1 if (defined($line) and substr($line, 0, 2) eq '#!');
+ return 0;
+}
+
+# Returns true iff the given argument is an empty directory.
+# Corner-cases:
+# - false if not a directory
+sub is_empty_dir {
+ my ($dir) = @_;
+ return 0 if not -d $dir;
+ my $ret = 1;
+ opendir(my $dir_fd, $dir) or error("opendir($dir) failed: $!");
+ while (defined(my $entry = readdir($dir_fd))) {
+ next if $entry eq '.' or $entry eq '..';
+ $ret = 0;
+ last;
+ }
+ closedir($dir_fd);
+ return $ret;
+}
+
+sub on_pkgs_in_parallel(&) {
+ unshift(@_, $dh{DOPACKAGES});
+ goto \&on_items_in_parallel;
+}
+
+# Given a list of files, find all hardlinked files and return:
+# 1: a list of unique files (all files in the list are not hardlinked with any other file in that list)
+# 2: a map where the keys are names of hardlinks and the value points to the name selected as the file put in the
+# list of unique files.
+#
+# This is can be used to relink hard links after modifying one of them.
+sub find_hardlinks {
+ my (@all_files) = @_;
+ my (%seen, %hardlinks, @unique_files);
+ for my $file (@all_files) {
+ my ($dev, $inode, undef, $nlink)=stat($file);
+ if (defined $nlink && $nlink > 1) {
+ if (! $seen{"$inode.$dev"}) {
+ $seen{"$inode.$dev"}=$file;
+ push(@unique_files, $file);
+ } else {
+ # This is a hardlink.
+ $hardlinks{$file}=$seen{"$inode.$dev"};
+ }
+ } else {
+ push(@unique_files, $file);
+ }
+ }
+ return (\@unique_files, \%hardlinks);
+}
+
+sub on_items_in_parallel {
+ my ($pkgs_ref, $code) = @_;
+ my @pkgs = @{$pkgs_ref};
+ my %pids;
+ my $parallel = $MAX_PROCS;
+ my $count_per_proc = int( (scalar(@pkgs) + $parallel - 1)/ $parallel);
+ my $exit = 0;
+ if ($count_per_proc < 1) {
+ $count_per_proc = 1;
+ if (@pkgs > 3) {
+ # Forking has a considerable overhead, so bulk the number
+ # a bit. We do not do this unconditionally, because we
+ # want parallel issues (if any) to appear already with 2
+ # packages and two procs (because people are lazy when
+ # testing).
+ #
+ # Same reason for also unconditionally forking with 1 pkg
+ # in 1 proc.
+ $count_per_proc = 2;
+ }
+ }
+ # Assertion, $count_per_proc * $parallel >= scalar(@pkgs)
+ while (@pkgs) {
+ my @batch = splice(@pkgs, 0, $count_per_proc);
+ my $pid = fork() // error("fork: $!");
+ if (not $pid) {
+ # Child processes should not write to the log file
+ inhibit_log();
+ eval {
+ $code->(@batch);
+ };
+ if (my $err = $@) {
+ $err =~ s/\n$//;
+ print STDERR "$err\n";
+ exit(2);
+ }
+ exit(0);
+ }
+ $pids{$pid} = 1;
+ }
+ while (%pids) {
+ my $pid = wait;
+ error("wait() failed: $!") if $pid == -1;
+ delete($pids{$pid});
+ if ($? != 0) {
+ $exit = 1;
+ }
+ }
+ if ($exit) {
+ error("Aborting due to earlier error");
+ }
+ return;
+}
+
+*on_selected_pkgs_in_parallel = \&on_items_in_parallel;
+
+sub compute_doc_main_package {
+ my ($doc_package) = @_;
+ # if explicitly set, then choose that.
+ return $dh{DOC_MAIN_PACKAGE} if $dh{DOC_MAIN_PACKAGE};
+ # In compat 10 (and earlier), there is no auto-detection
+ return $doc_package if compat(10);
+ my $target_package = $doc_package;
+ # If it is not a -doc package, then docs should be installed
+ # under its own package name.
+ return $doc_package if $target_package !~ s/-doc$//;
+ # FOO-doc hosts the docs for FOO; seems reasonable
+ return $target_package if exists($package_types{$target_package});
+ if ($doc_package =~ m/^lib./) {
+ # Special case, "libFOO-doc" can host docs for "libFOO-dev"
+ my $lib_dev = "${target_package}-dev";
+ return $lib_dev if exists($package_types{$lib_dev});
+ # Technically, we could go look for a libFOO<something>-dev,
+ # but atm. it is presumed to be that much of a corner case
+ # that it warrents an override.
+ }
+ # We do not know; make that clear to the caller
+ return;
+}
+
+sub dbgsym_tmpdir {
+ my ($package) = @_;
+ return "debian/.debhelper/${package}/dbgsym-root";
+}
+
+sub perl_cross_incdir {
+ return if !is_cross_compiling();
+
+ # native builds don't currently need this so only load it on demand
+ require Config; Config->import();
+
+ my $triplet = dpkg_architecture_value("DEB_HOST_MULTIARCH");
+ my $perl_version = $Config::Config{version};
+ my $incdir = "/usr/lib/$triplet/perl/cross-config-${perl_version}";
+ return undef if !-e "$incdir/Config.pm";
+ return $incdir;
+}
+
+sub is_known_package {
+ my ($package) = @_;
+ state %known_packages = map { $_ => 1 } getpackages();
+ return 1 if exists($known_packages{$package});
+ return 0
+}
+
+sub assert_opt_is_known_package {
+ my ($package, $method) = @_;
+ if (not is_known_package($package)) {
+ error("Requested unknown package $package via $method, expected one of: " . join(' ', getpackages()));
+ }
+ return 1;
+}
+
+
+sub _internal_optional_file_args {
+ state $_disable_file_seccomp;
+ if (not defined($_disable_file_seccomp)) {
+ my $consider_disabling_seccomp = 0;
+ if ($ENV{'FAKEROOTKEY'} or ($ENV{'LD_PRELOAD'} // '') =~ m/fakeroot/) {
+ $consider_disabling_seccomp = 1;
+ }
+ if ($consider_disabling_seccomp) {
+ my $has_no_sandbox = (qx_cmd('file', '--help') // '') =~ m/--no-sandbox/;
+ $consider_disabling_seccomp = 0 if not $has_no_sandbox;
+ }
+ $_disable_file_seccomp = $consider_disabling_seccomp;
+ }
+ return('--no-sandbox') if $_disable_file_seccomp;
+ return;
+}
+
+1
diff --git a/lib/Debian/Debhelper/Sequence.pm b/lib/Debian/Debhelper/Sequence.pm
new file mode 100644
index 0000000..ba627f4
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence.pm
@@ -0,0 +1,131 @@
+#!/usr/bin/perl
+#
+# Internal library functions for the dh(1) command
+
+package Debian::Debhelper::Sequence;
+use strict;
+use warnings;
+
+use Exporter qw(import);
+
+use Debian::Debhelper::Dh_Lib qw(error);
+use Debian::Debhelper::SequencerUtil qw(extract_rules_target_name sequence_type SEQUENCE_NO_SUBSEQUENCES
+ SEQUENCE_ARCH_INDEP_SUBSEQUENCES SEQUENCE_TYPE_ARCH_ONLY SEQUENCE_TYPE_INDEP_ONLY SEQUENCE_TYPE_BOTH
+ FLAG_OPT_SOURCE_BUILDS_NO_ARCH_PACKAGES FLAG_OPT_SOURCE_BUILDS_NO_INDEP_PACKAGES);
+
+
+sub _as_command {
+ my ($input) = @_;
+ if (ref($input) eq 'HASH') {
+ return $input;
+ }
+ my $rules_target = extract_rules_target_name($input);
+ if (defined($rules_target)) {
+ my $sequence_type = sequence_type($rules_target);
+ return {
+ 'command' => $input,
+ 'command-options' => [],
+ 'sequence-limitation' => $sequence_type,
+ }
+ }
+ return {
+ 'command' => $input,
+ 'command-options' => [],
+ 'sequence-limitation' => SEQUENCE_TYPE_BOTH,
+ }
+}
+
+sub new {
+ my ($class, $name, $sequence_type, @cmds) = @_;
+ return bless({
+ '_name' => $name,
+ '_subsequences' => $sequence_type,
+ '_cmds' => [map {_as_command($_)} @cmds],
+ }, $class);
+}
+
+sub name {
+ my ($this) = @_;
+ return $this->{'_name'};
+}
+
+sub allowed_subsequences {
+ my ($this) = @_;
+ return $this->{'_subsequences'};
+}
+
+sub _insert {
+ my ($this, $offset, $existing, $new) = @_;
+ my @list = @{$this->{'_cmds'}};
+ my @new;
+ my $new_cmd = _as_command($new);
+ foreach my $command (@list) {
+ if ($command->{'command'} eq $existing) {
+ push(@new, $new_cmd) if $offset < 0;
+ push(@new, $command);
+ push(@new, $new_cmd) if $offset > 0;
+ } else {
+ push(@new, $command);
+ }
+ }
+ $this->{'_cmds'} = \@new;
+ return;
+}
+
+sub remove_command {
+ my ($this, $command) = @_;
+ $this->{'_cmds'} = [grep { $_->{'command'} ne $command } @{$this->{'_cmds'}}];
+ return;
+}
+
+sub add_command_at_start {
+ my ($this, $command) = @_;
+ unshift(@{$this->{'_cmds'}}, _as_command($command));
+ return;
+}
+
+sub add_command_at_end {
+ my ($this, $command) = @_;
+ push(@{$this->{'_cmds'}}, _as_command($command));
+ return;
+}
+
+sub rules_target_name {
+ my ($this, $sequence_type) = @_;
+ error("Internal error: Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
+ my $name = $this->{'_name'};
+ my $allowed_sequence_type = $this->{'_subsequences'};
+ if ($sequence_type ne SEQUENCE_TYPE_BOTH and $allowed_sequence_type eq SEQUENCE_NO_SUBSEQUENCES) {
+ error("Internal error: Requested subsequence ${sequence_type} of sequence ${name}, but it has no subsequences");
+ }
+ if ($sequence_type ne SEQUENCE_TYPE_BOTH) {
+ return "${name}-${sequence_type}";
+ }
+ return $name;
+}
+
+sub as_rules_target_command {
+ my ($this) = shift;
+ my $rules_name = $this->rules_target_name(@_);
+ return "debian/rules ${rules_name}";
+}
+
+sub flatten_sequence {
+ my ($this, $sequence_type, $flags) = @_;
+ error("Invalid sequence type $sequence_type") if $sequence_type eq SEQUENCE_NO_SUBSEQUENCES;
+ my @cmds;
+ for my $cmd_desc (@{$this->{'_cmds'}}) {
+ my $seq_limitation = $cmd_desc->{'sequence-limitation'};
+ next if ($seq_limitation eq SEQUENCE_TYPE_ARCH_ONLY and ($flags & FLAG_OPT_SOURCE_BUILDS_NO_ARCH_PACKAGES));
+ next if ($seq_limitation eq SEQUENCE_TYPE_INDEP_ONLY and ($flags & FLAG_OPT_SOURCE_BUILDS_NO_INDEP_PACKAGES));
+ if ($seq_limitation eq $sequence_type or $sequence_type eq SEQUENCE_TYPE_BOTH or $seq_limitation eq SEQUENCE_TYPE_BOTH) {
+ my $cmd = $cmd_desc->{'command'};
+ my @cmd_options = $cmd_desc->{'command-options'};
+ push(@cmds, [$cmd, @cmd_options]);
+ next;
+ }
+ }
+ return @cmds;
+}
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/build_stamp.pm b/lib/Debian/Debhelper/Sequence/build_stamp.pm
new file mode 100644
index 0000000..5c05975
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/build_stamp.pm
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+add_command_at_end('create-stamp debian/debhelper-build-stamp', 'build');
+add_command_at_end('create-stamp debian/debhelper-build-stamp', 'build-arch');
+add_command_at_end('create-stamp debian/debhelper-build-stamp', 'build-indep');
+
+1
diff --git a/lib/Debian/Debhelper/Sequence/dwz.pm b/lib/Debian/Debhelper/Sequence/dwz.pm
new file mode 100644
index 0000000..2e89ffa
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/dwz.pm
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+# Enable dh_dwz
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat error);
+
+if (not compat(11)) {
+ error("In compat 12, dh_dwz is run by default and the dwz-sequence is no longer required.");
+}
+
+insert_before('dh_strip', 'dh_dwz');
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/elf_tools.pm b/lib/Debian/Debhelper/Sequence/elf_tools.pm
new file mode 100644
index 0000000..56bb07c
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/elf_tools.pm
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat);
+
+insert_after('dh_missing', 'dh_strip');
+if (not compat(11)) {
+ insert_before('dh_strip', 'dh_dwz');
+}
+insert_after('dh_strip', 'dh_makeshlibs');
+insert_after('dh_makeshlibs', 'dh_shlibdeps');
+
+1; \ No newline at end of file
diff --git a/lib/Debian/Debhelper/Sequence/installinitramfs.pm b/lib/Debian/Debhelper/Sequence/installinitramfs.pm
new file mode 100644
index 0000000..365f283
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/installinitramfs.pm
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+# Enable dh_installinitramfs
+
+use strict;
+use warnings;
+use Debian::Debhelper::Dh_Lib qw(compat error);
+
+if (not compat(11)) {
+ error("In compat 12, dh_installinitramfs is run by default and the installinitramfs-sequence is no longer required.");
+}
+
+insert_after('dh_installgsettings', 'dh_installinitramfs');
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/installsysusers.pm b/lib/Debian/Debhelper/Sequence/installsysusers.pm
new file mode 100644
index 0000000..47c38e5
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/installsysusers.pm
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+# Enable dh_installsysusers
+
+use strict;
+use warnings;
+
+insert_after('dh_install', 'dh_installsysusers');
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/root_sequence.pm b/lib/Debian/Debhelper/Sequence/root_sequence.pm
new file mode 100644
index 0000000..45d908c
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/root_sequence.pm
@@ -0,0 +1,120 @@
+use strict;
+use warnings;
+
+use Debian::Debhelper::Dh_Lib qw(compat);
+use Debian::Debhelper::SequencerUtil;
+
+my $include_if_compat_X_or_newer = sub {
+ my ($compat, @commands) = @_;
+ return if compat($compat - 1, 1);
+ return @commands;
+};
+
+my @obsolete_command = (
+ [13, $include_if_compat_X_or_newer->(11, 'dh_systemd_enable', 'dh_systemd_start')],
+ [14, 'dh_gconf'],
+);
+
+my @commands_controlled_by_deb_build_options = (
+ $include_if_compat_X_or_newer->(13, ['dh_auto_test', 'nocheck'], ['dh_dwz', 'nostrip'], ['dh_strip', 'nostrip']),
+);
+
+my @bd_minimal = qw{
+ dh_testdir
+};
+my @bd = (@bd_minimal, qw{
+ dh_update_autotools_config
+ dh_auto_configure
+ dh_auto_build
+ dh_auto_test
+});
+my @i = (qw{
+ dh_testroot
+ dh_prep
+ dh_installdirs
+ dh_auto_install
+
+ dh_install
+ dh_installdocs
+ dh_installchangelogs
+ dh_installexamples
+ dh_installman
+
+ dh_installcatalogs
+ dh_installcron
+ dh_installdebconf
+ dh_installemacsen
+ dh_installifupdown
+ dh_installinfo
+ dh_installinit
+},
+ $include_if_compat_X_or_newer->(14, 'dh_installsysusers'),
+ $include_if_compat_X_or_newer->(13, 'dh_installtmpfiles'),
+ $include_if_compat_X_or_newer->(11, 'dh_installsystemd'),
+ $include_if_compat_X_or_newer->(12, 'dh_installsystemduser'),
+qw{
+ dh_installmenu
+ dh_installmime
+ dh_installmodules
+ dh_installlogcheck
+ dh_installlogrotate
+ dh_installpam
+ dh_installppp
+ dh_installudev
+ dh_installgsettings
+},
+ (!compat(11) ? qw(dh_installinitramfs) : qw()),
+ (compat(13) ? qw(dh_installalternatives) : qw()),
+qw{
+ dh_bugfiles
+ dh_ucf
+ dh_lintian
+ dh_icons
+ dh_perl
+ dh_usrlocal
+
+ dh_link
+},
+ (!compat(13) ? qw(dh_installalternatives) : qw()),
+qw{
+ dh_installwm
+ dh_installxfonts
+ dh_strip_nondeterminism
+ dh_compress
+ dh_fixperms
+ dh_missing
+});
+
+# Looking for dh_dwz, dh_strip, dh_makeshlibs, dh_shlibdeps (et al)? They are
+# in the elf-tools addon.
+my @b=qw{
+ dh_installdeb
+ dh_gencontrol
+ dh_md5sums
+ dh_builddeb
+};
+
+_add_sequence('build', SEQUENCE_ARCH_INDEP_SUBSEQUENCES, @bd);
+_add_sequence('install', SEQUENCE_ARCH_INDEP_SUBSEQUENCES, to_rules_target("build"), @i);
+_add_sequence('binary', SEQUENCE_ARCH_INDEP_SUBSEQUENCES, to_rules_target("install"), @b);
+_add_sequence('clean', SEQUENCE_NO_SUBSEQUENCES, @bd_minimal, qw{
+ dh_auto_clean
+ dh_clean
+});
+
+for my $obsolete_command_spec (@obsolete_command) {
+ my ($error_compat, @cmds) = @{$obsolete_command_spec};
+ for my $command (@cmds) {
+ declare_command_obsolete($error_compat, $command);
+ }
+}
+
+for my $entry (@commands_controlled_by_deb_build_options) {
+ my ($command, $dbo_flag) = @{$entry};
+ # Dear reader; Should you be in doubt, then this is internal API that is
+ # subject to change without notice. If you need this feature, please
+ # make an explicit feature request, so we can implement a better solution.
+ _skip_cmd_if_deb_build_options_contains($command, $dbo_flag);
+}
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/single_binary.pm b/lib/Debian/Debhelper/Sequence/single_binary.pm
new file mode 100644
index 0000000..68d8db1
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/single_binary.pm
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use Debian::Debhelper::Dh_Lib qw(getpackages error warning tmpdir);
+use Debian::Debhelper::SequencerUtil;
+
+my @packages = getpackages();
+my $pkg = $packages[0];
+my $tmp = tmpdir($pkg);
+if (@packages != 1) {
+ warning('Detected multiple binary packages (Package paragraphs) in debian/control, which is incompatible');
+ warning('with the single-binary dh add-on.');
+ warning();
+ warning('Please:');
+ warning(' 1) Remove the single-binary add-on ("dh-sequence-single-binary" in Build-Depends)');
+ warning(' 2) Update the packaging to cope with dh_auto_install using \"debian/tmp\" as default dest dir');
+ warning(" (Previously, it would probably have used \"${tmp}\")");
+ warning(' 3) Add Breaks/Replaces if you are moving existing files into a new package.');
+ warning(' 4) Double check that the resulting binaries have content.');
+ warning();
+ warning("IF YOU ARE ADDING A TRANSITIONAL PACKAGE: Then you probably want to pass --destdir=${tmp} to");
+ warning(' dh_auto_install. Most likely you will need Breaks + Replaces as renaming a package counts as');
+ warning(' moving files between two packages.');
+ warning();
+ warning('IF YOU ARE "SPLITTING" THE CONTENT INTO MULTIPLE PACKAGES: Then remember to install the content');
+ warning(" into them (by creating debian/${pkg}.install, etc.). Also remember to add Breaks + Replaces if");
+ warning(' you are moving files from one package into another.');
+ warning();
+ error("The single-binary add-on cannot be used for source packages that build multiple binary packages.");
+}
+
+add_command_options('dh_auto_install', "--destdir=${tmp}/");
+
+1;
diff --git a/lib/Debian/Debhelper/Sequence/systemd.pm b/lib/Debian/Debhelper/Sequence/systemd.pm
new file mode 100644
index 0000000..484e764
--- /dev/null
+++ b/lib/Debian/Debhelper/Sequence/systemd.pm
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Debian::Debhelper::Dh_Lib qw(compat error);
+
+if (not compat(10)) {
+ error("The systemd-sequence is no longer provided in compat >= 11, please rely on dh_installsystemd instead");
+}
+
+
+# dh_systemd_enable runs unconditionally, and before dh_installinit, so that
+# the latter can use invoke-rc.d and all symlinks are already in place.
+insert_before("dh_installinit", "dh_systemd_enable");
+
+# dh_systemd_start handles the case where there is no corresponding init
+# script, so it runs after dh_installinit.
+insert_after("dh_installinit", "dh_systemd_start");
+
+1
diff --git a/lib/Debian/Debhelper/SequencerUtil.pm b/lib/Debian/Debhelper/SequencerUtil.pm
new file mode 100644
index 0000000..2dc3f78
--- /dev/null
+++ b/lib/Debian/Debhelper/SequencerUtil.pm
@@ -0,0 +1,888 @@
+#!/usr/bin/perl
+#
+# Internal library functions for the dh(1) command
+
+package Debian::Debhelper::SequencerUtil;
+use strict;
+use warnings;
+use constant {
+ 'DUMMY_TARGET' => 'debhelper-fail-me',
+ 'SEQUENCE_NO_SUBSEQUENCES' => 'none',
+ 'SEQUENCE_ARCH_INDEP_SUBSEQUENCES' => 'both',
+ 'SEQUENCE_TYPE_ARCH_ONLY' => 'arch',
+ 'SEQUENCE_TYPE_INDEP_ONLY' => 'indep',
+ 'SEQUENCE_TYPE_BOTH' => 'both',
+ 'FLAG_OPT_SOURCE_BUILDS_NO_ARCH_PACKAGES' => 0x1,
+ 'FLAG_OPT_SOURCE_BUILDS_NO_INDEP_PACKAGES' => 0x2,
+ 'UNSKIPPABLE_CLI_OPTIONS_BUILD_SYSTEM' => q(-S|--buildsystem|-D|--sourcedir|--sourcedirectory|-B|--builddir|--builddirectory),
+};
+
+use Exporter qw(import);
+
+use Debian::Debhelper::Dh_Lib qw(
+ %dh
+ basename
+ commit_override_log
+ compat error
+ escape_shell
+ get_buildoption
+ getpackages
+ load_log
+ package_is_arch_all
+ pkgfile
+ rm_files
+ tmpdir
+ warning
+ write_log
+);
+
+
+our @EXPORT = qw(
+ extract_rules_target_name
+ to_rules_target
+ sequence_type
+ unpack_sequence
+ rules_explicit_target
+ extract_skipinfo
+ compute_selected_addons
+ load_sequence_addon
+ run_sequence_command_and_exit_on_failure
+ should_skip_due_to_dpo
+ check_for_obsolete_commands
+ compute_starting_point_in_sequences
+ parse_dh_cmd_options
+ run_hook_target
+ run_through_command_sequence
+ DUMMY_TARGET
+ SEQUENCE_NO_SUBSEQUENCES
+ SEQUENCE_ARCH_INDEP_SUBSEQUENCES
+ SEQUENCE_TYPE_ARCH_ONLY
+ SEQUENCE_TYPE_INDEP_ONLY
+ SEQUENCE_TYPE_BOTH
+ FLAG_OPT_SOURCE_BUILDS_NO_ARCH_PACKAGES
+ FLAG_OPT_SOURCE_BUILDS_NO_INDEP_PACKAGES
+);
+
+our (%EXPLICIT_TARGETS, $RULES_PARSED);
+
+sub extract_rules_target_name {
+ my ($command) = @_;
+ if ($command =~ m{^debian/rules\s++(.++)}) {
+ return $1
+ }
+ return;
+}
+
+sub to_rules_target {
+ return 'debian/rules '.join(' ', @_);
+}
+
+sub sequence_type {
+ my ($sequence_name) = @_;
+ if ($sequence_name =~ m/-indep$/) {
+ return 'indep';
+ } elsif ($sequence_name =~ m/-arch$/) {
+ return 'arch';
+ }
+ return 'both';
+}
+
+sub _agg_subseq {
+ my ($current_subseq, $outer_subseq) = @_;
+ if ($current_subseq eq $outer_subseq) {
+ return $current_subseq;
+ }
+ if ($current_subseq eq 'both') {
+ return $outer_subseq;
+ }
+ return $current_subseq;
+}
+
+sub unpack_sequence {
+ my ($sequences, $sequence_name, $always_inline, $completed_sequences, $flags) = @_;
+ my (@sequence, @targets, %seen, %non_inlineable_targets, @stack);
+ my $sequence_type = sequence_type($sequence_name);
+ # Walk through the sequence effectively doing a DFS of the rules targets
+ # (when we are allowed to inline them).
+ my $seq = $sequences->{$sequence_name};
+ $flags //= 0;
+
+ push(@stack, [$seq->flatten_sequence($sequence_type, $flags)]);
+ while (@stack) {
+ my $current_sequence = pop(@stack);
+ COMMAND:
+ while (@{$current_sequence}) {
+ my $command = shift(@{$current_sequence});
+ if (ref($command) eq 'ARRAY') {
+ $command = $command->[0];
+ }
+ my $rules_target=extract_rules_target_name($command);
+ next if (defined($rules_target) and exists($completed_sequences->{$rules_target}));
+ if (defined($rules_target) and $always_inline) {
+ my $subsequence = $sequences->{$rules_target};
+ my $subseq_type = _agg_subseq(sequence_type($rules_target), $sequence_type);
+ push(@stack, $current_sequence);
+ $current_sequence = [$subsequence->flatten_sequence($subseq_type, $flags)];
+ } elsif (defined($rules_target)) {
+ my $subsequence = $sequences->{$rules_target};
+ my $subseq_type = _agg_subseq(sequence_type($rules_target), $sequence_type);
+ my @subseq_types = ($subseq_type);
+ my %subtarget_status;
+ my ($transparent_subseq, $opaque_subseq, $subtarget_decided_both);
+ if ($subseq_type eq SEQUENCE_TYPE_BOTH) {
+ push(@subseq_types, SEQUENCE_TYPE_ARCH_ONLY, SEQUENCE_TYPE_INDEP_ONLY);
+ }
+ for my $ss_type (@subseq_types) {
+ my $full_rule_target = ($ss_type eq SEQUENCE_TYPE_BOTH) ? $rules_target : "${rules_target}-${ss_type}";
+ if (exists($completed_sequences->{$full_rule_target})) {
+ $subtarget_status{$ss_type} = 'complete';
+ last if $ss_type eq $subseq_type;
+ }
+ elsif (defined(rules_explicit_target($full_rule_target))) {
+ $subtarget_status{$ss_type} = 'opaque';
+ last if $ss_type eq $subseq_type;
+ }
+ else {
+ $subtarget_status{$ss_type} = 'transparent';
+ }
+ }
+ # At this point, %subtarget_status has 1 or 3 kv-pairs.
+ # - If it has 1, then just check that and be done
+ # - If it has 3, then "both" must be "transparent".
+
+ if (scalar(keys(%subtarget_status)) == 3) {
+ if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq $subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}}) {
+ # The "both" target is transparent and the subtargets agree. This is the common case
+ # of "everything is transparent" (or both subtargets are opaque) and we reduce that by
+ # reducing it to only have one key.
+ %subtarget_status = ( $subseq_type => $subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} );
+ # There is one special-case for this flow if both targets are opaque.
+ $subtarget_decided_both = 1;
+ } else {
+ # The subtargets have different status but we know that the "both" key must be irrelevant
+ # then. Remove it to simplify matters below.
+ delete($subtarget_status{${\SEQUENCE_TYPE_BOTH}});
+ }
+ }
+
+ if (scalar(keys(%subtarget_status)) == 1) {
+ # "Simple" case where we only have to check exactly one result
+ if ($subtarget_status{$subseq_type} eq 'opaque') {
+ $opaque_subseq = $subseq_type;
+ }
+ elsif ($subtarget_status{$subseq_type} eq 'transparent') {
+ $transparent_subseq = $subseq_type;
+ }
+ } else {
+ # Either can be transparent, opaque or complete at this point.
+ if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq 'transparent') {
+ $transparent_subseq = SEQUENCE_TYPE_ARCH_ONLY
+ } elsif ($subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}} eq 'transparent') {
+ $transparent_subseq = SEQUENCE_TYPE_INDEP_ONLY
+ }
+ if ($subtarget_status{${\SEQUENCE_TYPE_ARCH_ONLY}} eq 'opaque') {
+ $opaque_subseq = SEQUENCE_TYPE_ARCH_ONLY
+ } elsif ($subtarget_status{${\SEQUENCE_TYPE_INDEP_ONLY}} eq 'opaque') {
+ $opaque_subseq = SEQUENCE_TYPE_INDEP_ONLY
+ }
+ }
+ if ($opaque_subseq) {
+ if ($subtarget_decided_both) {
+ # Final special-case - we are here because the rules file define X-arch AND X-indep but
+ # not X. In this case, we want two d/rules X-{arch,indep} calls rather than a single
+ # d/rules X call.
+ for my $ss_type ((SEQUENCE_TYPE_ARCH_ONLY, SEQUENCE_TYPE_INDEP_ONLY)) {
+ my $rules_target_cmd = $subsequence->as_rules_target_command($ss_type);
+ push(@targets, $rules_target_cmd) if not $seen{$rules_target_cmd}++;
+ }
+ } else {
+ my $rules_target_cmd = $subsequence->as_rules_target_command($opaque_subseq);
+ push(@targets, $rules_target_cmd) if not $seen{$rules_target_cmd}++;
+ }
+ }
+ if ($transparent_subseq) {
+ push(@stack, $current_sequence);
+ $current_sequence = [$subsequence->flatten_sequence($transparent_subseq, $flags)];
+ }
+ next COMMAND;
+ } else {
+ if (defined($rules_target) and not $always_inline) {
+ next COMMAND if exists($non_inlineable_targets{$rules_target});
+ push(@targets, $command) if not $seen{$command}++;
+ } elsif (! $seen{$command}) {
+ $seen{$command} = 1;
+ push(@sequence, $command);
+ }
+ }
+ }
+ }
+ return (\@targets, \@sequence);
+}
+
+
+sub rules_explicit_target {
+ # Checks if a specified target exists as an explicit target
+ # in debian/rules.
+ # undef is returned if target does not exist, 0 if target is noop
+ # and 1 if target has dependencies or executes commands.
+ my ($target) = @_;
+
+ if (! $RULES_PARSED) {
+ my $processing_targets = 0;
+ my $not_a_target = 0;
+ my $current_target;
+ open(MAKE, "LC_ALL=C make -Rrnpsf debian/rules ${\DUMMY_TARGET} 2>/dev/null |");
+ while (<MAKE>) {
+ if ($processing_targets) {
+ if (/^# Not a target:/) {
+ $not_a_target = 1;
+ } else {
+ if (!$not_a_target && m/^([^#:]+)::?\s*(.*)$/) {
+ # Target is defined. NOTE: if it is a dependency of
+ # .PHONY it will be defined too but that's ok.
+ # $2 contains target dependencies if any.
+ $current_target = $1;
+ $EXPLICIT_TARGETS{$current_target} = ($2) ? 1 : 0;
+ } else {
+ if (defined($current_target)) {
+ if (m/^#/) {
+ # Check if target has commands to execute
+ if (m/^#\s*(commands|recipe) to execute/) {
+ $EXPLICIT_TARGETS{$current_target} = 1;
+ }
+ } else {
+ # Target parsed.
+ $current_target = undef;
+ }
+ }
+ }
+ # "Not a target:" is always followed by
+ # a target name, so resetting this one
+ # here is safe.
+ $not_a_target = 0;
+ }
+ } elsif (m/^# Files$/) {
+ $processing_targets = 1;
+ }
+ }
+ close MAKE;
+ $RULES_PARSED = 1;
+ }
+
+ return $EXPLICIT_TARGETS{$target};
+}
+
+sub extract_skipinfo {
+ my ($command) = @_;
+
+ foreach my $dir (split(':', $ENV{PATH})) {
+ if (open (my $h, "<", "$dir/$command")) {
+ while (<$h>) {
+ if (m/PROMISE: DH NOOP( WITHOUT\s+(.*))?\s*$/) {
+ close $h;
+ return split(' ', $2) if defined($2);
+ return ('always-skip');
+ }
+ }
+ close $h;
+ return;
+ }
+ }
+ return;
+}
+
+sub _skipped_call_due_dpo {
+ my ($command, $dbo_flag) = @_;
+ my $me = Debian::Debhelper::Dh_Lib::_color(basename($0), 'bold');
+ my $skipped = Debian::Debhelper::Dh_Lib::_color('command-omitted', 'yellow');
+ print "${me}: ${skipped}: The call to \"${command}\" was omitted due to \"DEB_BUILD_OPTIONS=${dbo_flag}\"\n";
+ return;
+}
+
+sub should_skip_due_to_dpo {
+ my ($command, $to_be_invoked) = @_;
+
+ # Indirection/reference for readability
+ my $commands_ref = \%Debian::Debhelper::DH::SequenceState::commands_skippable_via_deb_build_options;
+
+ if (not $dh{'NO_ACT'} and exists($commands_ref->{$command})) {
+ my $flags_ref = $commands_ref->{$command};
+ for my $flag (@{$flags_ref}) {
+ if (get_buildoption($flag)) {
+ _skipped_call_due_dpo($to_be_invoked, $flag) if defined($to_be_invoked);
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+sub compute_starting_point_in_sequences {
+ my ($packages_ref, $full_sequence, $logged) = @_;
+ my %startpoint;
+ if (compat(9)) {
+ foreach my $package (@{$packages_ref}) {
+ my @log = load_log($package, $logged);
+ # Find the last logged command that is in the sequence, and
+ # continue with the next command after it. If no logged
+ # command is in the sequence, we're starting at the beginning..
+ $startpoint{$package} = 0;
+ COMMAND:
+ foreach my $command (reverse(@log)) {
+ foreach my $i (0 .. $#{$full_sequence}) {
+ if ($command eq $full_sequence->[$i]) {
+ $startpoint{$package} = $i + 1;
+ last COMMAND;
+ }
+ }
+ }
+ }
+ } else {
+ foreach my $package (@{$packages_ref}) {
+ $startpoint{$package} = 0;
+ }
+ }
+ return %startpoint;
+}
+
+
+sub compute_selected_addons {
+ my ($sequence_name, @addon_requests_from_args) = @_;
+ my (@enabled_addons, %disabled_addons, %enabled);
+ my @addon_requests;
+ my $sequence_type = sequence_type($sequence_name);
+
+ my %addon_constraints = %{ Debian::Debhelper::Dh_Lib::bd_dh_sequences() };
+ my %explicitly_managed;
+
+ # Inject elf-tools early as other addons rely on their presence and it historically
+ # has been considered a part of the "core" sequence.
+ if (exists($addon_constraints{'elf-tools'})) {
+ # Explicitly requested; respect that
+ push(@addon_requests, '+elf-tools');
+ } elsif (compat(12, 1)) {
+ # In compat 12 and earlier, we only inject the sequence if there are arch
+ # packages present and the sequence requires it.
+ if (getpackages('arch') and $sequence_type ne SEQUENCE_TYPE_INDEP_ONLY) {
+ push(@addon_requests, '+elf-tools');
+ }
+ } else {
+ # In compat 13, we always inject the addon if not explicitly requested and
+ # then flag it as arch_only
+ push(@addon_requests, '+elf-tools');
+ $addon_constraints{'elf-tools'} = SEQUENCE_TYPE_ARCH_ONLY if not exists($addon_constraints{'elf-tools'});
+ }
+
+ # Order is important; DH_EXTRA_ADDONS must come before everything
+ # else; then comes built-in and finally argument provided add-ons
+ # requests.
+ push(@addon_requests, map { "+${_}" } split(",", $ENV{DH_EXTRA_ADDONS}))
+ if $ENV{DH_EXTRA_ADDONS};
+ if (not compat(9, 1)) {
+ # Enable autoreconf'ing by default in compat 10 or later.
+ push(@addon_requests, '+autoreconf');
+
+ # Enable systemd support by default in compat 10 or later.
+ # - compat 11 injects the dh_installsystemd tool directly in the
+ # sequence instead of using a --with sequence.
+ push(@addon_requests, '+systemd') if compat(10, 1);
+ push(@addon_requests, '+build-stamp');
+ }
+ for my $addon_name (sort(keys(%addon_constraints))) {
+ my $addon_type = $addon_constraints{$addon_name};
+
+ # Special-case for the "clean" target to avoid B-D-I dependencies in that for conditional add-ons
+ next if $sequence_name eq 'clean' and $addon_type ne SEQUENCE_TYPE_BOTH;
+ if ($addon_type eq 'both' or $sequence_type eq 'both' or $addon_type eq $sequence_type) {
+ push(@addon_requests, "+${addon_name}");
+ }
+ }
+
+ push(@addon_requests, @addon_requests_from_args);
+
+ # Removing disabled add-ons are expensive (O(N) per time), so we
+ # attempt to make removals in bulk. Note that we have to be order
+ # preserving (due to #885580), so there is a limit to how "smart"
+ # we can be.
+ my $flush_disable_cache = sub {
+ @enabled_addons = grep { not exists($disabled_addons{$_}) } @enabled_addons;
+ for my $addon (keys(%disabled_addons)) {
+ delete($enabled{$addon});
+ }
+ %disabled_addons = ();
+ };
+
+ for my $request (@addon_requests) {
+ if ($request =~ m/^[+-]root[-_]sequence$/) {
+ error("Invalid request to skip the sequence \"root-sequence\": It cannot be disabled")
+ if $request =~ m/^-/;
+ error("Invalid request to load the sequence \"root-sequence\": Do not reference it directly");
+ }
+ if ($request =~ s/^[+]//) {
+ # Normalize "_" to "-" in the name.
+ $request =~ tr/_/-/;
+ $flush_disable_cache->() if %disabled_addons;
+ $explicitly_managed{$request} = 1;
+ push(@enabled_addons, $request) if not $enabled{$request}++;
+ } elsif ($request =~ s/^-//) {
+ # Normalize "_" to "-" in the name.
+ $request =~ tr/_/-/;
+ $explicitly_managed{$request} = 1;
+ $disabled_addons{$request} = 1;
+ } else {
+ error("Internal error: Invalid add-on request: $request (Missing +/- prefix)");
+ }
+ }
+
+ if (compat(14, 1) && getpackages() == 1 && !exists($explicitly_managed{'single-binary'})) {
+ if (not compat(13, 1)) {
+ warning("Implicitly activating single-binary dh addon for backwards compatibility. In compat 14+,");
+ warning("this fallback will *not* happen automatically and dh_auto_install will instead use a");
+ warning("different default for --destdir, which can cause the source to produce an empty binary package");
+ warning();
+ warning('To keep the existing behaviour, please activate the single-binary addon explicitly.');
+ warning('This can be done by adding "dh-sequence-single-binary" to Build-Depends or passing');
+ warning('--with=single-binary to dh.');
+ warning();
+ warning('If you have solved this issue differently (e.g., by passing --destdir explicitly to');
+ warning('dh_auto_install or not using dh_auto_install at all) and want to silence this warning');
+ warning('without activating the addon, you can do that by passing --without=single-binary to dh');
+ warning('to explicitly acknowledge the change.');
+ warning();
+ warning('Please see the description of the "single-binary" in "man dh" for more details of what');
+ warning('it does and why this is changing from implicit behaviour to explicitly opt-in.');
+ }
+ push(@enabled_addons, 'single-binary');
+ }
+
+ $flush_disable_cache->() if %disabled_addons;
+ return map {
+ {
+ 'name' => $_,
+ 'addon-type' => $addon_constraints{$_} // SEQUENCE_TYPE_BOTH,
+ }
+ } @enabled_addons;
+}
+
+
+sub load_sequence_addon {
+ my ($addon_name, $addon_type) = @_;
+ require Debian::Debhelper::DH::AddonAPI;
+ my $mod="Debian::Debhelper::Sequence::${addon_name}";
+ $mod=~s/-/_/g;
+ local $Debian::Debhelper::DH::AddonAPI::DH_INTERNAL_ADDON_NAME = $addon_name;
+ local $Debian::Debhelper::DH::AddonAPI::DH_INTERNAL_ADDON_TYPE = $addon_type;
+ eval "package Debian::Debhelper::DH::AddonAPI; use $mod";
+ if ($@) {
+ error("unable to load addon ${addon_name}: $@");
+ }
+}
+
+sub check_for_obsolete_commands {
+ my ($full_sequence) = @_;
+ my ($found_obsolete_targets, $min_compat);
+ for my $command (@{$full_sequence}) {
+ if (exists($Debian::Debhelper::DH::SequenceState::obsolete_command{$command})) {
+ my $addon_name = $Debian::Debhelper::DH::SequenceState::obsolete_command{$command}[1];
+ error("The addon ${addon_name} claimed that $command was obsolete, but it is not!?");
+ }
+ }
+ for my $command (sort(keys(%Debian::Debhelper::DH::SequenceState::obsolete_command))) {
+ my ($addon_name, $error_compat) = @{$Debian::Debhelper::DH::SequenceState::obsolete_command{$command}};
+ $addon_name = 'debhelper' if $addon_name eq 'root-sequence';
+ for my $prefix (qw(execute_before_ execute_after_ override_)) {
+ for my $suffix ('', '-arch', '-indep') {
+ my $target = "${prefix}${command}${suffix}";
+ if (defined(rules_explicit_target($target))) {
+ $found_obsolete_targets = 1;
+ $min_compat //= $error_compat;
+ $min_compat = $error_compat if $error_compat < $min_compat;
+ warning("The target ${target} references a now obsolete command and will not be run!"
+ . " (Marked by ${addon_name}, will be an error in compat $error_compat)");
+ }
+ }
+ }
+ }
+ if ($found_obsolete_targets and not compat($min_compat - 1)) {
+ error("Aborting due to left over override/hook targets for now removed commands.");
+ }
+ return;
+}
+
+sub run_sequence_command_and_exit_on_failure {
+ my ($command, @options) = @_;
+
+ # 3 space indent lines the command being run up under the
+ # sequence name after "dh ".
+ if (!$dh{QUIET}) {
+ print " ".escape_shell($command, @options)."\n";
+ }
+
+ return if $dh{NO_ACT};
+
+ my $ret=system { $command } $command, @options;
+ if ($ret >> 8 != 0) {
+ exit $ret >> 8;
+ }
+ if ($ret) {
+ exit 1;
+ }
+ return;
+}
+
+
+sub run_hook_target {
+ my ($target_stem, $min_compat_level, $command, $packages, @opts) = @_;
+ my @todo = @{$packages};
+ foreach my $override_type (undef, "arch", "indep") {
+ @todo = _run_injected_rules_target($target_stem, $override_type, $min_compat_level, $command, \@todo, @opts);
+ }
+ return @todo;
+}
+
+# Tries to run an override / hook target for a command. Returns the list of
+# packages that it was unable to run the target for.
+sub _run_injected_rules_target {
+ my ($target_stem, $override_type, $min_compat_level, $command, $packages, @options) = @_;
+
+ my $rules_target = $target_stem .
+ (defined $override_type ? "-".$override_type : "");
+
+ $command //= $rules_target; # Ensure it is defined
+
+ # Check which packages are of the right architecture for the
+ # override_type.
+ my (@todo, @rest);
+ my $has_explicit_target = rules_explicit_target($rules_target);
+
+ if ($has_explicit_target and defined($min_compat_level) and compat($min_compat_level - 1)) {
+ error("Hook target ${rules_target} is only supported in compat ${min_compat_level} or later");
+ }
+
+ if (defined $override_type) {
+ foreach my $package (@{$packages}) {
+ my $isall=package_is_arch_all($package);
+ if (($override_type eq 'indep' && $isall) ||
+ ($override_type eq 'arch' && !$isall)) {
+ push @todo, $package;
+ } else {
+ push @rest, $package;
+ push @options, "-N$package";
+ }
+ }
+ } else {
+ @todo=@{$packages};
+ }
+
+ return @{$packages} unless defined $has_explicit_target; # no such override
+ return @rest if ! $has_explicit_target; # has empty override
+ return @rest unless @todo; # has override, but no packages to act on
+ return @rest if should_skip_due_to_dpo($command, "debian/rules $rules_target");
+
+ if (defined $override_type) {
+ # Ensure appropriate -a or -i option is passed when running
+ # an arch-specific override target.
+ my $opt=$override_type eq "arch" ? "-a" : "-i";
+ push @options, $opt unless grep { $_ eq $opt } @options;
+ }
+
+ # Discard any override log files before calling the override
+ # target
+ if (not compat(9)) {
+ my @files = glob('debian/*.debhelper.log');
+ rm_files(@files) if @files;
+ }
+ # This passes the options through to commands called
+ # inside the target.
+ $ENV{DH_INTERNAL_OPTIONS}=join("\x1e", @options);
+ $ENV{DH_INTERNAL_OVERRIDE}=$command;
+ run_sequence_command_and_exit_on_failure("debian/rules", $rules_target);
+ delete $ENV{DH_INTERNAL_OPTIONS};
+ delete $ENV{DH_INTERNAL_OVERRIDE};
+
+ # Update log for overridden command now that it has
+ # finished successfully.
+ # (But avoid logging for dh_clean since it removes
+ # the log earlier.)
+ if (! $dh{NO_ACT} && $command ne 'dh_clean' && compat(9)) {
+ write_log($command, @todo);
+ commit_override_log(@todo);
+ }
+
+ # Override targets may introduce new helper files. Strictly
+ # speaking this *shouldn't* be necessary, but lets make no
+ # assumptions.
+ Debian::Debhelper::Dh_Lib::dh_clear_unsafe_cache();
+
+ return @rest;
+}
+
+
+# Options parsed to dh that may need to be passed on to helpers
+sub parse_dh_cmd_options {
+ my (@argv) = @_;
+
+ # Ref for readability
+ my $options_ref = \@Debian::Debhelper::DH::SequenceState::options;
+
+ while (@argv) {
+ my $opt = shift(@argv);
+ if ($opt =~ /^--?(after|until|before|with|without)$/) {
+ shift(@argv);
+ next;
+ } elsif ($opt =~ /^--?(no-act|remaining|(after|until|before|with|without)=)/) {
+ next;
+ } elsif ($opt =~ /^-/) {
+ if (not @{$options_ref} and $opt eq '--parallel' or $opt eq '--no-parallel') {
+ my $max_parallel;
+ # Ignore the option if it is the default for the given
+ # compat level.
+ next if compat(9) and $opt eq '--no-parallel';
+ next if not compat(9) and $opt eq '--parallel';
+ # Having an non-empty "@options" hurts performance quite a
+ # bit. At the same time, we want to promote the use of
+ # --(no-)parallel, so "tweak" the options a bit if there
+ # is no reason to include this option.
+ $max_parallel = get_buildoption('parallel') // 1;
+ next if $max_parallel == 1;
+ }
+ if ($opt =~ m/^(--[^=]++)(?:=.*)?$/ or $opt =~ m/^(-[^-])(?:=.*)?$/) {
+ my $optname = $1;
+ if (length($optname) > 2 and (compat(12, 1) or $optname =~ m/^-[^-][^=]/)) {
+ # We cannot optimize bundled options but we can optimize a single
+ # short option with an explicit parameter (-B=F is ok, -BF is not)
+ # In compat 12 or earlier, we also punt on long options due to
+ # auto-abbreviation.
+ $Debian::Debhelper::DH::SequenceState::unoptimizable_option_bundle = 1
+ }
+ $Debian::Debhelper::DH::SequenceState::seen_options{$optname} = 1;
+ } elsif ($opt =~ m/^-[^-][^-]/) {
+ # We cannot optimize bundled options but we can optimize a single
+ # short option with an explicit parameter (-B=F is ok, -BF is not)
+ $Debian::Debhelper::DH::SequenceState::unoptimizable_option_bundle = 1
+ } else {
+ # Special case that disables NOOP cli-options() as well
+ $Debian::Debhelper::DH::SequenceState::unoptimizable_user_option = 1;
+ }
+ push(@{$options_ref}, "-O" . $opt);
+ } elsif (@{$options_ref}) {
+ if ($options_ref->[$#{$options_ref}] =~ /^-O--/) {
+ $options_ref->[$#{$options_ref}] .= '=' . $opt;
+ } else {
+ # Special case that disables NOOP cli-options() as well
+ $Debian::Debhelper::DH::SequenceState::unoptimizable_user_option = 1;
+ $options_ref->[$#{$options_ref}] .= $opt;
+ }
+ } else {
+ error("Unknown parameter: $opt");
+ }
+ }
+ return;
+}
+
+
+sub run_through_command_sequence {
+ my ($full_sequence, $startpoint, $logged, $options, $all_packages, $arch_packages, $indep_packages) = @_;
+
+ my $command_opts = \%Debian::Debhelper::DH::SequenceState::command_opts;
+ my $stoppoint = $#{$full_sequence};
+
+ # Now run the commands in the sequence.
+ foreach my $i (0 .. $stoppoint) {
+ my $command = $full_sequence->[$i];
+
+ # Figure out which packages need to run this command.
+ my (@todo, @opts);
+ my @filtered_packages = _active_packages_for_command($command, $all_packages, $arch_packages, $indep_packages);
+
+ foreach my $package (@filtered_packages) {
+ if (($startpoint->{$package}//0) > $i ||
+ $logged->{$package}{$full_sequence->[$i]}) {
+ push(@opts, "-N$package");
+ }
+ else {
+ push(@todo, $package);
+ }
+ }
+ next unless @todo;
+ push(@opts, @{$options});
+
+ my $rules_target = extract_rules_target_name($command);
+ error("Internal error: $command is a rules target, but it is not supported to be!?") if defined($rules_target);
+
+ if (my $stamp_file = _stamp_target($command)) {
+ my %seen;
+ print " create-stamp " . escape_shell($stamp_file) . "\n";
+
+ next if $dh{NO_ACT};
+ open(my $fd, '+>>', $stamp_file) or error("open($stamp_file, rw) failed: $!");
+ # Seek to the beginning
+ seek($fd, 0, 0) or error("seek($stamp_file) failed: $!");
+ while (my $line = <$fd>) {
+ chomp($line);
+ $seen{$line} = 1;
+ }
+ for my $pkg (grep {not exists($seen{$_})} @todo) {
+ print {$fd} "$pkg\n";
+ }
+ close($fd) or error("close($stamp_file) failed: $!");
+ next;
+ }
+
+ my @full_todo = @todo;
+ run_hook_target("execute_before_${command}", 10, $command, \@full_todo, @opts);
+
+ # Check for override targets in debian/rules, and run instead of
+ # the usual command. (The non-arch-specific override is tried first,
+ # for simplest semantics; mixing it with arch-specific overrides
+ # makes little sense.)
+ @todo = run_hook_target("override_${command}", undef, $command, \@full_todo, @opts);
+
+ if (@todo and not _can_skip_command($command, @todo)) {
+ # No need to run the command for any packages handled by the
+ # override targets.
+ my %todo = map {$_ => 1} @todo;
+ foreach my $package (@full_todo) {
+ if (!$todo{$package}) {
+ push @opts, "-N$package";
+ }
+ }
+ if (not should_skip_due_to_dpo($command, Debian::Debhelper::Dh_Lib::_format_cmdline($command, @opts))) {
+ my @cmd_options;
+ # Include additional command options if any
+ push(@cmd_options, @{$command_opts->{$command}})
+ if exists($command_opts->{$command});
+ push(@cmd_options, @opts);
+ run_sequence_command_and_exit_on_failure($command, _remove_dup_pkg_options(@cmd_options));
+ }
+ }
+
+ run_hook_target("execute_after_${command}", 10, $command, \@full_todo, @opts);
+ }
+}
+
+sub _remove_dup_pkg_options {
+ my (@options) = @_;
+ my @filtered_options;
+ my $arch = 0;
+ my $indep = 0;
+ for my $option (@options) {
+ if ($option eq '-a' or $option eq '--arch') {
+ next if $arch;
+ $arch = 1;
+ }
+ if ($option eq '-i' or $option eq '--indep') {
+ next if $indep;
+ $indep = 1;
+ }
+ push(@filtered_options, $option);
+ }
+ return @filtered_options;
+}
+
+
+sub _stamp_target {
+ my ($command) = @_;
+ if ($command =~ s/^create-stamp\s+//) {
+ return $command;
+ }
+ return;
+}
+
+{
+ my %skipinfo;
+ sub _can_skip_command {
+ my ($command, @packages) = @_;
+
+ return 0 if $dh{NO_ACT} and not $ENV{DH_INTERNAL_TEST_CAN_SKIP};
+
+ return 0 if $Debian::Debhelper::DH::SequenceState::unoptimizable_user_option ||
+ (exists $ENV{DH_OPTIONS} && length $ENV{DH_OPTIONS});
+
+ return 0 if exists($Debian::Debhelper::DH::SequenceState::command_opts{$command})
+ and @{$Debian::Debhelper::DH::SequenceState::command_opts{$command}};
+
+ if (! defined $skipinfo{$command}) {
+ $skipinfo{$command}=[extract_skipinfo($command)];
+ }
+ my @skipinfo=@{$skipinfo{$command}};
+ return 0 unless @skipinfo;
+ return 1 if scalar(@skipinfo) == 1 and $skipinfo[0] eq 'always-skip';
+ my ($all_pkgs, $had_cli_options);
+
+ foreach my $skipinfo (@skipinfo) {
+ my $type = 'pkgfile';
+ my $need = $skipinfo;
+ if ($skipinfo=~/^([a-zA-Z0-9-_]+)\((.*)\)$/) {
+ ($type, $need) = ($1, $2);
+ }
+ if ($type eq 'tmp') {
+ foreach my $package (@packages) {
+ my $tmp = tmpdir($package);
+ return 0 if -e "$tmp/$need";
+ }
+ } elsif ($type eq 'pkgfile' or $type eq 'pkgfile-logged') {
+ my $pkgs;
+ if ($type eq 'pkgfile') {
+ $pkgs = \@packages;
+ } else {
+ $all_pkgs //= [ getpackages() ];
+ $pkgs = $all_pkgs;
+ }
+ # Use the secret bulk check call
+ return 0 if pkgfile($pkgs, $need) ne '';
+ } elsif ($type eq 'cli-options') {
+ $had_cli_options = 1;
+ # If cli-options is empty, we know the helper does not
+ # react to any thing and can always be skipped.
+ next if $need =~ m/^\s*$/;
+ # Long options are subject to abbreviations so it is
+ # very difficult to implement this optimization with
+ # long options.
+ return 0 if $Debian::Debhelper::DH::SequenceState::unoptimizable_option_bundle;
+ $need =~ s/(?:^|\s)BUILDSYSTEM(?:\s|$)/${\UNSKIPPABLE_CLI_OPTIONS_BUILD_SYSTEM}/;
+ my @behavior_options = split(qr/\Q|\E/, $need);
+ for my $opt (@behavior_options) {
+ return 0 if exists($Debian::Debhelper::DH::SequenceState::seen_options{$opt});
+ }
+ } elsif ($type eq 'buildsystem') {
+ require Debian::Debhelper::Dh_Buildsystems;
+ my $system = Debian::Debhelper::Dh_Buildsystems::load_buildsystem(undef, $need);
+ return 0 if defined($system);
+ } elsif ($type eq 'internal') {
+ if ($need eq 'bug#950723') {
+ $all_pkgs //= [ getpackages() ];
+ push(@{$all_pkgs}, map { "${_}@"} getpackages());
+ push(@packages, map { "${_}@"} @packages);
+ } elsif ($need eq 'rrr') {
+ my $req = Debian::Debhelper::Dh_Lib::root_requirements();
+ return 0 if $req ne 'none';
+ } else {
+ warning('Broken internal NOOP hint; should not happen unless someone is using implementation details');
+ error("Unknown internal NOOP type hint in ${command}: ${need}");
+ }
+ } else {
+ # Unknown hint - make no assumptions
+ return 0;
+ }
+ }
+ return 0 if not $had_cli_options and %Debian::Debhelper::DH::SequenceState::seen_options;
+ return 1;
+ }
+}
+
+sub _active_packages_for_command {
+ my ($command, $all_packages, $arch_packages, $indep_packages) = @_;
+ my $command_opts_ref = $Debian::Debhelper::DH::SequenceState::command_opts{$command};
+ my $selection = $all_packages;
+ if (grep { $_ eq '-i'} @{$command_opts_ref}) {
+ if (grep { $_ ne '-a'} @{$command_opts_ref}) {
+ $selection = $indep_packages;
+ }
+ } elsif (grep { $_ eq '-a'} @{$command_opts_ref}) {
+ $selection = $arch_packages;
+ }
+ return @{$selection};
+}
+
+1;