From 9a08cbfcc1ef900a04580f35afe2a4592d7d6030 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Mon, 6 May 2024 02:45:20 +0200 Subject: Adding upstream version 1.19.8. Signed-off-by: Daniel Baumann --- scripts/dpkg-genbuildinfo.pl | 516 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 516 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..827b667 --- /dev/null +++ b/scripts/dpkg-genbuildinfo.pl @@ -0,0 +1,516 @@ +#!/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 POSIX qw(:fcntl_h :locale_h strftime); + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::Checksums; +use Dpkg::ErrorHandling; +use Dpkg::Arch qw(get_build_arch get_host_arch debarch_eq); +use Dpkg::Build::Types; +use Dpkg::Build::Info qw(get_build_env_whitelist); +use Dpkg::BuildOptions; +use Dpkg::BuildFlags; +use Dpkg::BuildProfiles qw(get_build_profiles); +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 %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 cleansed_environment { + # Consider only whitelisted variables which are not supposed to leak + # local user information. + my %env = map { + $_ => $ENV{$_} + } grep { + exists $ENV{$_} + } get_build_env_whitelist(); + + # 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 [