From cbffab246997fb5a06211dfb706b54e5ae5bb59f Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 16:58:51 +0200 Subject: Adding upstream version 1.21.22. Signed-off-by: Daniel Baumann --- scripts/dpkg-genbuildinfo.pl | 595 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 595 insertions(+) create mode 100755 scripts/dpkg-genbuildinfo.pl (limited to 'scripts/dpkg-genbuildinfo.pl') diff --git a/scripts/dpkg-genbuildinfo.pl b/scripts/dpkg-genbuildinfo.pl new file mode 100755 index 0000000..f26e396 --- /dev/null +++ b/scripts/dpkg-genbuildinfo.pl @@ -0,0 +1,595 @@ +#!/usr/bin/perl +# +# dpkg-genbuildinfo +# +# Copyright © 1996 Ian Jackson +# Copyright © 2000,2001 Wichert Akkerman +# Copyright © 2003-2013 Yann Dirson +# Copyright © 2006-2016 Guillem Jover +# Copyright © 2014 Niko Tyni +# Copyright © 2014-2015 Jérémy Bobbio +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +use strict; +use warnings; + +use List::Util qw(any); +use Cwd; +use File::Basename; +use File::Temp; +use POSIX qw(:fcntl_h :locale_h strftime); + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::Checksums; +use Dpkg::ErrorHandling; +use Dpkg::IPC; +use Dpkg::Path qw(find_command); +use Dpkg::Arch qw( + get_build_arch + get_host_arch + debarch_eq debarch_to_gnutriplet +); +use Dpkg::BuildTypes; +use Dpkg::BuildOptions; +use Dpkg::BuildFlags; +use Dpkg::BuildProfiles qw(get_build_profiles); +use Dpkg::BuildInfo qw(get_build_env_allowed); +use Dpkg::Control::Info; +use Dpkg::Control::Fields; +use Dpkg::Control; +use Dpkg::Changelog::Parse; +use Dpkg::Deps; +use Dpkg::Dist::Files; +use Dpkg::Lock; +use Dpkg::Version; +use Dpkg::Vendor qw(get_current_vendor run_vendor_hook); + +textdomain('dpkg-dev'); + +my $controlfile = 'debian/control'; +my $changelogfile = 'debian/changelog'; +my $changelogformat; +my $fileslistfile = 'debian/files'; +my $uploadfilesdir = '..'; +my $outputfile; +my $stdout = 0; +my $admindir = $Dpkg::ADMINDIR; +my %use_feature = ( + kernel => 0, + path => 0, +); +my @build_profiles = get_build_profiles(); +my $buildinfo_format = '1.0'; +my $buildinfo; + +my $checksums = Dpkg::Checksums->new(); +my %distbinaries; +my %archadded; +my @archvalues; + +sub get_build_date { + my $date; + + setlocale(LC_TIME, 'C'); + $date = strftime('%a, %d %b %Y %T %z', localtime); + setlocale(LC_TIME, ''); + + return $date; +} + +# There is almost the same function in dpkg-checkbuilddeps, they probably +# should be factored out. +sub parse_status { + my $status = shift; + + my $facts = Dpkg::Deps::KnownFacts->new(); + my %depends; + my @essential_pkgs; + + local $/ = ''; + open my $status_fh, '<', $status or syserr(g_('cannot open %s'), $status); + while (<$status_fh>) { + next unless /^Status: .*ok installed$/m; + + my ($package) = /^Package: (.*)$/m; + my ($version) = /^Version: (.*)$/m; + my ($arch) = /^Architecture: (.*)$/m; + my ($multiarch) = /^Multi-Arch: (.*)$/m; + + $facts->add_installed_package($package, $version, $arch, $multiarch); + + if (/^Essential: yes$/m) { + push @essential_pkgs, $package; + } + + if (/^Provides: (.*)$/m) { + my $provides = deps_parse($1, reduce_arch => 1, union => 1); + + next if not defined $provides; + + deps_iterate($provides, sub { + my $dep = shift; + $facts->add_provided_package($dep->{package}, $dep->{relation}, + $dep->{version}, $package); + }); + } + + foreach my $deptype (qw(Pre-Depends Depends)) { + next unless /^$deptype: (.*)$/m; + + my $depends = $1; + foreach (split /,\s*/, $depends) { + push @{$depends{"$package:$arch"}}, $_; + } + } + } + close $status_fh; + + return ($facts, \%depends, \@essential_pkgs); +} + +sub append_deps { + my $pkgs = shift; + + foreach my $dep_str (@_) { + next unless $dep_str; + + my $deps = deps_parse($dep_str, reduce_restrictions => 1, + build_dep => 1, + build_profiles => \@build_profiles); + + # We add every sub-dependencies as we cannot know which package in + # an OR dependency has been effectively used. + deps_iterate($deps, sub { + push @{$pkgs}, + $_[0]->{package} . (defined $_[0]->{archqual} ? ':' . $_[0]->{archqual} : ''); + 1 + }); + } +} + +sub collect_installed_builddeps { + my $control = shift; + + my ($facts, $depends, $essential_pkgs) = parse_status("$admindir/status"); + my %seen_pkgs; + my @unprocessed_pkgs; + + # Parse essential packages list. + append_deps(\@unprocessed_pkgs, + @{$essential_pkgs}, + run_vendor_hook('builtin-build-depends'), + $control->get_source->{'Build-Depends'}); + + if (build_has_any(BUILD_ARCH_DEP)) { + append_deps(\@unprocessed_pkgs, + $control->get_source->{'Build-Depends-Arch'}); + } + + if (build_has_any(BUILD_ARCH_INDEP)) { + append_deps(\@unprocessed_pkgs, + $control->get_source->{'Build-Depends-Indep'}); + } + + my $installed_deps = Dpkg::Deps::AND->new(); + + while (my $pkg_name = shift @unprocessed_pkgs) { + next if $seen_pkgs{$pkg_name}; + $seen_pkgs{$pkg_name} = 1; + + my $required_architecture; + if ($pkg_name =~ /\A(.*):(.*)\z/) { + $pkg_name = $1; + my $arch = $2; + $required_architecture = $arch if $arch !~ /\A(?:all|any|native)\Z/ + } + my $pkg; + my $qualified_pkg_name; + foreach my $installed_pkg (@{$facts->{pkg}->{$pkg_name}}) { + if (!defined $required_architecture || + $required_architecture eq $installed_pkg->{architecture}) { + $pkg = $installed_pkg; + $qualified_pkg_name = $pkg_name . ':' . $installed_pkg->{architecture}; + last; + } + } + if (defined $pkg) { + my $version = $pkg->{version}; + my $architecture = $pkg->{architecture}; + my $new_deps_str = defined $depends->{$qualified_pkg_name} ? deps_concat(@{$depends->{$qualified_pkg_name}}) : ''; + my $new_deps = deps_parse($new_deps_str); + if (!defined $required_architecture) { + $installed_deps->add(Dpkg::Deps::Simple->new("$pkg_name (= $version)")); + } else { + $installed_deps->add(Dpkg::Deps::Simple->new("$qualified_pkg_name (= $version)")); + + # Dependencies of foreign packages are also foreign packages + # (or Arch:all) so we need to qualify them as well. We figure + # out if the package is actually foreign by searching for an + # installed package of the right architecture. + deps_iterate($new_deps, sub { + my $dep = shift; + return unless defined $facts->{pkg}->{$dep->{package}}; + $dep->{archqual} //= $architecture + if any { $_[0]->{architecture} eq $architecture }, @{$facts->{pkg}->{$dep->{package}}}; + 1; + }); + } + + # We add every sub-dependencies as we cannot know which package + # in an OR dependency has been effectively used. + deps_iterate($new_deps, sub { + push @unprocessed_pkgs, + $_[0]->{package} . (defined $_[0]->{archqual} ? ':' . $_[0]->{archqual} : ''); + 1 + }); + } elsif (defined $facts->{virtualpkg}->{$pkg_name}) { + # virtual package: we cannot know for sure which implementation + # is the one that has been used, so let's add them all... + foreach my $provided (@{$facts->{virtualpkg}->{$pkg_name}}) { + push @unprocessed_pkgs, $provided->{provider}; + } + } + # else: it is a package in an OR dependency that has been otherwise + # satisfied. + } + $installed_deps->simplify_deps(Dpkg::Deps::KnownFacts->new()); + $installed_deps->sort(); + $installed_deps = "\n" . $installed_deps->output(); + $installed_deps =~ s/, /,\n/g; + + return $installed_deps; +} + +sub is_cross_executable { + my $host_arch = get_host_arch(); + my $build_arch = get_build_arch(); + + return if $host_arch eq $build_arch; + + # If we are cross-compiling, record whether it was possible to execute + # the host architecture by cross-compiling and executing a small + # host-arch binary. + my $CC = debarch_to_gnutriplet($host_arch) . '-gcc'; + + # If we do not have a cross-compiler, we might be in the process of + # building one or cross-compiling using a language other than C/C++, + # and aborting the build is then not very useful. + return if ! find_command($CC); + + my $crossprog = <<~'CROSSPROG'; + #include + int main() { write(1, "ok", 2); return 0; } + CROSSPROG + my ($stdout, $stderr) = ('', ''); + my $tmpfh = File::Temp->new(); + spawn( + exec => [ $CC, '-w', '-x', 'c', '-o', $tmpfh->filename, '-' ], + from_string => \$crossprog, + to_string => \$stdout, + error_to_string => \$stderr, + wait_child => 1, + nocheck => 1, + ); + if ($?) { + print { *STDOUT } $stdout; + print { *STDERR } $stderr; + eval { + subprocerr("$CC -w -x c -"); + }; + warning($@); + return; + } + close $tmpfh; + spawn( + exec => [ $tmpfh->filename ], + error_to_file => '/dev/null', + to_string => \$stdout, + wait_child => 1, + nocheck => 1, + ); + + return 1 if $? == 0 && $stdout eq 'ok'; + return 0; +} + +sub get_build_tainted_by { + my @tainted = run_vendor_hook('build-tainted-by'); + + if (is_cross_executable()) { + push @tainted, 'can-execute-cross-built-programs'; + } + + return @tainted; +} + +sub cleansed_environment { + # Consider only allowed variables which are not supposed to leak + # local user information. + my %env = map { + $_ => $ENV{$_} + } grep { + exists $ENV{$_} + } get_build_env_allowed(); + + # Record flags from dpkg-buildflags. + my $bf = Dpkg::BuildFlags->new(); + $bf->load_system_config(); + $bf->load_user_config(); + $bf->load_environment_config(); + foreach my $flag ($bf->list()) { + next if $bf->get_origin($flag) eq 'vendor'; + + # We do not need to record *_{STRIP,APPEND,PREPEND} as they + # have been used already to compute the above value. + $env{"DEB_${flag}_SET"} = $bf->get($flag); + } + + return join "\n", map { $_ . '="' . ($env{$_} =~ s/"/\\"/gr) . '"' } + sort keys %env; +} + +sub version { + printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; + + printf g_(' +This is free software; see the GNU General Public License version 2 or +later for copying conditions. There is NO warranty. +'); +} + +sub usage { + printf g_( +'Usage: %s [