summaryrefslogtreecommitdiffstats
path: root/scripts/debrebuild.pl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rwxr-xr-xscripts/debrebuild.pl715
1 files changed, 715 insertions, 0 deletions
diff --git a/scripts/debrebuild.pl b/scripts/debrebuild.pl
new file mode 100755
index 0000000..561db86
--- /dev/null
+++ b/scripts/debrebuild.pl
@@ -0,0 +1,715 @@
+#!/usr/bin/perl
+#
+# Copyright © 2014-2020 Johannes Schauer Marin Rodrigues <josch@debian.org>
+# Copyright © 2020 Niels Thykier <niels@thykier.net>
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+
+use strict;
+use warnings;
+use autodie;
+
+use Getopt::Long qw(:config gnu_getopt no_bundling no_auto_abbrev);
+
+use Dpkg::Control;
+use Dpkg::Index;
+use Dpkg::Deps;
+use Dpkg::Source::Package;
+use File::Temp qw(tempfile tempdir);
+use File::Path qw(make_path);
+use File::HomeDir;
+use JSON::PP;
+use Time::Piece;
+use File::Basename;
+use List::Util qw(any none);
+
+my $progname;
+
+BEGIN {
+ $progname = basename($0);
+ eval { require String::ShellQuote; };
+ if ($@) {
+ if ($@ =~ /^Can\'t locate String\/ShellQuote\.pm/) {
+ die
+"$progname: you must have the libstring-shellquote-perl package installed\n"
+ . "to use this script";
+ } else {
+ die
+"$progname: problem loading the String::ShellQuote module:\n $@\n"
+ . "Have you installed the libstring-shellquote-perl package?";
+ }
+ }
+
+ eval {
+ require LWP::Simple;
+ require LWP::UserAgent;
+ require URI::Escape; # libwww-perl depends on liburi-perl
+ no warnings;
+ $LWP::Simple::ua
+ = LWP::UserAgent->new(agent => 'LWP::UserAgent/debrebuild');
+ $LWP::Simple::ua->env_proxy();
+ };
+ if ($@) {
+ if ($@ =~ m/Can\'t locate LWP/) {
+ die "$progname: you must have the libwww-perl package installed\n"
+ . "to use this script";
+ } else {
+ die "$progname: problem loading the LWP and URI modules:\n $@\n"
+ . "Have you installed the libwww-perl package?";
+ }
+ }
+
+}
+
+my $respect_build_path = 1;
+my $use_tor = 0;
+my $outdir = './';
+my $builder = 'none';
+
+my %OPTIONS = (
+ 'help|h' => sub { usage(0); },
+ 'use-tor-proxy!' => \$use_tor,
+ 'respect-build-path!' => \$respect_build_path,
+ 'buildresult=s' => \$outdir,
+ 'builder=s' => \$builder,
+);
+
+sub usage {
+ my ($exit_code) = @_;
+ $exit_code //= 0;
+ print <<EOF;
+Usage: $progname [options] <buildinfo>
+ $progname <--help|-h>
+
+Given a buildinfo file from a Debian package, generate instructions for
+attempting to reproduce the binary packages built from the associated source
+and build information.
+
+Options:
+ --help, -h Show this help and exit
+ --[no-]use-tor-proxy Whether to fetch resources via tor (socks://127.0.0.1:9050)
+ Assumes "apt-transport-tor" is installed both in host + chroot
+ --[no-]respect-build-path Whether to setup the build to use the Build-Path from the
+ provided .buildinfo file.
+ --buildresults Directory for the build artifacts (default: ./)
+ --builder=BUILDER Which building software should be used. Possible values are
+ none, sbuild, mmdebstrap, dpkg and sbuild+unshare. The default
+ is none. See section BUILDER for details.
+
+Note: $progname can parse buildinfo files with and without a GPG signature. However,
+the signature (if present) is discarded as debrebuild does not support verifying
+it. If the authenticity or integrity of the buildinfo files are important to
+you, checking these need to be done before invoking $progname, for example by using
+dscverify.
+
+EXAMPLES
+
+ \$ $progname --buildresults=./artifacts --builder=mmdebstrap hello_2.10-2_amd64.buildinfo
+
+BUILDERS
+
+debrebuild can use different backends to perform the actual package rebuild.
+The desired backend is chosen using the --builder option. The default is
+"none".
+
+ none Dry-run mode. No build is performed.
+ sbuild Use sbuild to build the package. This requires sbuild to be
+ setup with schroot chroots of Debian stable distributions.
+ mmdebstrap Use mmdebstrap to build the package. This requires no
+ setup and no superuser privileges.
+ dpkg Directly run apt-get and dpkg-buildpackage on the current
+ system without chroot. This requires root privileges.
+ sbuild+unshare Use sbuild with the unshare backend. This will create the
+ chroot and perform the build without superuser privileges
+ and without any setup.
+
+UNSHARE
+
+Before kernel 5.10.1 or before Debian 11 (Bullseye), unprivileged user
+namespaces were disabled in Debian for security reasons. Refer to Debian bug
+#898446 for details. To enable user namespaces, run:
+
+ \$ sudo sysctl -w kernel.unprivileged_userns_clone=1
+
+The sbuild+unshare builder requires and the mmdebstrap builder benefits from
+having unprivileged user namespaces activated. On Ubuntu they are enabled by
+default.
+
+LIMITATIONS
+
+Currently, the code assumes that all packages were at some point part of Debian
+unstable main. This fails for packages from Debian ports, packages from
+experimental as well as for locally built packages or packages from third
+party repositories. Enabling support for Debian ports and experimental is
+conceptually possible and only needs somebody implementing it.
+
+EOF
+
+ exit($exit_code);
+}
+
+GetOptions(%OPTIONS);
+
+my $buildinfo = shift @ARGV;
+if (not defined($buildinfo)) {
+ print STDERR "ERROR: Missing mandatory buildinfo filename\n";
+ print STDERR "\n";
+ usage(1);
+}
+if ($buildinfo eq '--help' or $buildinfo eq '-h') {
+ usage(0);
+}
+
+if ($buildinfo =~ m/^-/) {
+ print STDERR "ERROR: Unsupported option $buildinfo\n";
+ print STDERR "\n";
+ usage(1);
+}
+
+if (@ARGV) {
+ print STDERR "ERROR: This program requires exactly argument!\n";
+ print STDERR "\n";
+ usage(1);
+}
+
+my $base_mirror = "http://snapshot.debian.org/archive/debian";
+if ($use_tor) {
+ $base_mirror = "tor+http://snapshot.debian.org/archive/debian";
+ eval {
+ $LWP::Simple::ua->proxy([qw(http https)] => 'socks://127.0.0.1:9050');
+ };
+ if ($@) {
+ if ($@ =~ m/Can\'t locate LWP/) {
+ die
+"Unable to use tor: the liblwp-protocol-socks-perl package is not installed\n";
+ } else {
+ die "Unable to use tor: Couldn't load socks proxy support: $@\n";
+ }
+ }
+}
+
+# buildinfo support in libdpkg-perl (>= 1.18.11)
+my $cdata = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1);
+
+if (not $cdata->load($buildinfo)) {
+ die "cannot load $buildinfo\n";
+}
+
+if ($cdata->get_option('is_pgp_signed')) {
+ print
+"$buildinfo contained a GPG signature; it has NOT been validated (debrebuild does not support this)!\n";
+} else {
+ print "$buildinfo was unsigned\n";
+}
+
+my @architectures = split /\s+/, $cdata->{"Architecture"};
+my $build_source = (scalar(grep /^source$/, @architectures)) == 1;
+my $build_archall = (scalar(grep /^all$/, @architectures)) == 1;
+@architectures = grep { !/^source$/ && !/^all$/ } @architectures;
+if (scalar @architectures > 1) {
+ die "more than one architecture in Architecture field\n";
+}
+my $build_archany = (scalar @architectures) == 1;
+
+my $build_arch = $cdata->{"Build-Architecture"};
+if (not defined($build_arch)) {
+ die "need Build-Architecture field\n";
+}
+my $host_arch = $cdata->{"Host-Architecture"};
+if (not defined($host_arch)) {
+ $host_arch = $build_arch;
+}
+
+my $srcpkgname = $cdata->{Source};
+my $srcpkgver = $cdata->{Version};
+{
+ # make $@ local, so we don't print "Undefined subroutine" error message
+ # in other parts where we evaluate $@
+ local $@ = '';
+ # field_parse_binary_source is only available starting with dpkg 1.21.0
+ eval { ($srcpkgname, $srcpkgver) = field_parse_binary_source($cdata); };
+ if ($@) {
+ ($srcpkgname, $srcpkgver) = split / /, $srcpkgname, 2;
+ # Add a simple control check to avoid the worst surprises and stop
+ # obvious cases of garbage-in-garbage-out.
+ die("Unexpected source package name: ${srcpkgname}\n")
+ if $srcpkgname =~ m{[ \t_/\(\)<>!\n%&\$\#\@]};
+ # remove the surrounding parenthesis from the version
+ $srcpkgver =~ s/^\((.*)\)$/$1/;
+ }
+}
+
+my $srcpkgbinver
+ = $cdata->{Version}; # this version will include the binmu suffix
+
+my $new_buildinfo;
+{
+ my $arch;
+ if ($build_archany) {
+ $arch = $host_arch;
+ } elsif ($build_archall) {
+ $arch = 'all';
+ } else {
+ die "nothing to build\n";
+ }
+ $new_buildinfo = "$outdir/${srcpkgname}_${srcpkgbinver}_$arch.buildinfo";
+}
+if (-e $new_buildinfo) {
+ my ($dev1, $ino1) = (lstat $buildinfo)[0, 1]
+ or die "cannot lstat $buildinfo: $!\n";
+ my ($dev2, $ino2) = (lstat $new_buildinfo)[0, 1]
+ or die "cannot lstat $new_buildinfo: $!\n";
+ if ($dev1 == $dev2 && $ino1 == $ino2) {
+ die "refusing to overwrite the input buildinfo file\n";
+ }
+}
+
+my $inst_build_deps = $cdata->{"Installed-Build-Depends"};
+if (not defined($inst_build_deps)) {
+ die "need Installed-Build-Depends field\n";
+}
+my $custom_build_path = $respect_build_path ? $cdata->{'Build-Path'} : undef;
+
+if (defined($custom_build_path)) {
+ if ($custom_build_path =~ m{['`\$\\"\(\)<>#]|(?:\a|/)[.][.](?:\z|/)}) {
+ warn(
+"Retry build with --no-respect-build-path to ignore the Build-Path field.\n"
+ );
+ die(
+"Refusing to use $custom_build_path as Build-Path: Looks too special to be true"
+ );
+ }
+
+ if ($custom_build_path eq '' or $custom_build_path !~ m{^/}) {
+ warn(
+"Retry build with --no-respect-build-path to ignore the Build-Path field.\n"
+ );
+ die(
+qq{Build-Path must be a non-empty absolute path (i.e. start with "/").\n}
+ );
+ }
+ print "Using defined Build-Path: ${custom_build_path}\n";
+} else {
+ if ($respect_build_path) {
+ print
+"No Build-Path defined; not setting a defined build path for this build.\n";
+ }
+}
+
+my $srcpkg = Dpkg::Source::Package->new();
+$srcpkg->{fields}{'Source'} = $srcpkgname;
+$srcpkg->{fields}{'Version'} = $srcpkgver;
+my $dsc_fname
+ = (dirname($buildinfo)) . '/' . $srcpkg->get_basename(1) . ".dsc";
+
+my $environment = $cdata->{"Environment"};
+if (not defined($environment)) {
+ die "need Environment field\n";
+}
+$environment =~ s/\n/ /g; # remove newlines
+$environment =~ s/^ //; # remove leading whitespace
+
+my @environment;
+foreach my $line (split /\n/, $cdata->{"Environment"}) {
+ chomp $line;
+ if ($line eq '') {
+ next;
+ }
+ my ($name, $val) = split /=/, $line, 2;
+ $val =~ s/^"(.*)"$/$1/;
+ push @environment, "$name=$val";
+}
+
+# gather all installed build-depends and figure out the version of base-files
+my $base_files_version;
+my @inst_build_deps = ();
+$inst_build_deps
+ = deps_parse($inst_build_deps, reduce_arch => 0, build_dep => 0);
+if (!defined $inst_build_deps) {
+ die "deps_parse failed\n";
+}
+
+foreach my $pkg ($inst_build_deps->get_deps()) {
+ if (!$pkg->isa('Dpkg::Deps::Simple')) {
+ die "dependency disjunctions are not allowed\n";
+ }
+ if (not defined($pkg->{package})) {
+ die "name undefined\n";
+ }
+ if (defined($pkg->{relation})) {
+ if ($pkg->{relation} ne "=") {
+ die "wrong relation";
+ }
+ if (not defined($pkg->{version})) {
+ die "version undefined\n";
+ }
+ } else {
+ die "no version";
+ }
+ if ($pkg->{package} eq "base-files") {
+ if (defined($base_files_version)) {
+ die "more than one base-files\n";
+ }
+ $base_files_version = $pkg->{version};
+ }
+ push @inst_build_deps,
+ {
+ name => $pkg->{package},
+ architecture => $pkg->{archqual},
+ version => $pkg->{version} };
+}
+
+if (!defined($base_files_version)) {
+ die "no base-files\n";
+}
+
+if ($builder ne "none") {
+ if (!-e $outdir) {
+ make_path($outdir);
+ }
+}
+
+my $build = '';
+my $changesarch = '';
+if ($build_archany and $build_archall) {
+ $build = "binary";
+ $changesarch = $host_arch;
+} elsif ($build_archany and !$build_archall) {
+ $build = "any";
+ $changesarch = $host_arch;
+} elsif (!$build_archany and $build_archall) {
+ $build = "all";
+ $changesarch = 'all';
+} else {
+ die "nothing to build\n";
+}
+
+my @install = ();
+foreach my $pkg (@inst_build_deps) {
+ my $pkg_name = $pkg->{name};
+ my $pkg_ver = $pkg->{version};
+ my $pkg_arch = $pkg->{architecture};
+ if ( not defined $pkg_arch
+ or $pkg_arch eq "all"
+ or $pkg_arch eq $build_arch) {
+ push @install, "$pkg_name=$pkg_ver";
+ } else {
+ push @install, "$pkg_name:$pkg_arch=$pkg_ver";
+ }
+}
+
+my $tarballpath = '';
+my $sourceslist = '';
+if (any { $_ eq $builder } ('none', 'dpkg')) {
+ open my $fh, '-|', 'debootsnap', "--buildinfo=$buildinfo",
+ '--sources-list-only' // die "cannot exec debootsnap";
+ $sourceslist = do { local $/; <$fh> };
+ close $fh;
+} elsif (any { $_ eq $builder } ('mmdebstrap', 'sbuild', 'sbuild+unshare')) {
+ (undef, $tarballpath)
+ = tempfile('debrebuild.tar.XXXXXXXXXXXX', OPEN => 0, TMPDIR => 1);
+ 0 == system 'debootsnap', "--buildinfo=$buildinfo", $tarballpath
+ or die "debootsnap failed";
+} else {
+ die "unsupported builder: $builder\n";
+}
+
+if ($builder eq "none") {
+ print "\n";
+ print "Manual installation and build\n";
+ print "-----------------------------\n";
+ print "\n";
+ print
+ "The following sources.list contains all the required repositories:\n";
+ print "\n";
+ print "$sourceslist\n";
+ print "\n";
+ print "You can manually install the right dependencies like this:\n";
+ print "\n";
+ print "apt-get install --no-install-recommends";
+
+ # Release files from snapshots.d.o have often expired by the time
+ # we fetch them. Include the option to work around that to assist
+ # the user.
+ print " -oAcquire::Check-Valid-Until=false";
+ foreach my $pkg (@install) {
+ print " $pkg";
+ }
+ print "\n";
+ print "\n";
+ print "And then build your package:\n";
+ print "\n";
+ if ($custom_build_path) {
+ require Cwd;
+ my $custom_build_parent_dir = dirname($custom_build_path);
+ my $dsc_path = Cwd::realpath($dsc_fname)
+ // die("Cannot resolve ${dsc_fname}: $!\n");
+ print "mkdir -p \"${custom_build_parent_dir}\"\n";
+ print qq{dpkg-source -x "${dsc_path}" "${custom_build_path}"\n};
+ print "cd \"$custom_build_path\"\n";
+ } else {
+ print qq{dpkg-source -x "${dsc_fname}"\n};
+ print "cd packagedirectory\n";
+ }
+ print "\n";
+ if ($cdata->{"Binary-Only-Changes"}) {
+ print( "Since this is a binNMU, you must put the following "
+ . "lines at the top of debian/changelog:\n\n");
+ print($cdata->{"Binary-Only-Changes"});
+ }
+ print "\n";
+ print( "$environment dpkg-buildpackage -uc "
+ . "--host-arch=$host_arch --build=$build\n");
+} elsif ($builder eq "dpkg") {
+ if ("$build_arch\n" ne `dpkg --print-architecture`) {
+ die "must be run on $build_arch\n";
+ }
+
+ if ($> != 0) {
+ die "you must be root for the dpkg builder\n";
+ }
+
+ if (-e $custom_build_path) {
+ die "$custom_build_path exists -- refusing to overwrite\n";
+ }
+
+ my $sources = '/etc/apt/sources.list.d/debrebuild.list';
+ if (-e $sources) {
+ die "$sources already exists -- refusing to overwrite\n";
+ }
+ open(FH, '>', $sources) or die "cannot open $sources: $!\n";
+ print FH "$sourceslist\n";
+ close FH;
+
+ my $config = '/etc/apt/apt.conf.d/23-debrebuild.conf';
+ if (-e $config) {
+ die "$config already exists -- refusing to overwrite\n";
+ }
+ open(FH, '>', $config) or die "cannot open $config: $!\n";
+ my @common_aptopts = (
+ 'Acquire::Check-Valid-Until "false";',
+ 'Acquire::http::Dl-Limit "1000";',
+ 'Acquire::https::Dl-Limit "1000";',
+ 'Acquire::Retries "5";',
+ 'APT::Get::allow-downgrades "true";',
+ );
+ foreach my $line (@common_aptopts) {
+ print FH "$line\n";
+ }
+ close FH;
+
+ 0 == system 'apt-get', 'update' or die "apt-get update failed\n";
+
+ my @cmd
+ = ('apt-get', 'install', '--no-install-recommends', '--yes', @install);
+ 0 == system @cmd or die "apt-get install failed\n";
+
+ 0 == system 'apt-get', 'source', '--only-source', '--download-only',
+ "$srcpkgname=$srcpkgver"
+ or die "apt-get source failed\n";
+ unlink $sources or die "failed to unlink $sources\n";
+ unlink $config or die "failed to unlink $config\n";
+ make_path(dirname $custom_build_path);
+ 0 == system 'dpkg-source', '--no-check', '--extract',
+ $srcpkg->get_basename(1) . '.dsc', $custom_build_path
+ or die "dpkg-source failed\n";
+
+ if ($cdata->{"Binary-Only-Changes"}) {
+ open my $infh, '<', "$custom_build_path/debian/changelog"
+ or die "cannot open debian/changelog for reading: $!\n";
+ my $changelogcontent = do { local $/; <$infh> };
+ close $infh;
+ open my $outfh, '>', "$custom_build_path/debian/changelog"
+ or die "cannot open debian/changelog for writing: $!\n";
+ my $logentry = $cdata->{"Binary-Only-Changes"};
+ # due to storing the binnmu changelog entry in deb822 buildinfo, the
+ # first character is an unwanted newline
+ $logentry =~ s/^\n//;
+ print $outfh $logentry;
+ # while the linebreak at the beginning is wrong, there are two missing
+ # at the end
+ print $outfh "\n\n";
+ print $outfh $changelogcontent;
+ close $outfh;
+ }
+ 0 == system 'env', "--chdir=$custom_build_path", @environment,
+ 'dpkg-buildpackage', '-uc', "--host-arch=$host_arch", "--build=$build"
+ or die "dpkg-buildpackage failed\n";
+ # we are not interested in the unpacked source directory
+ 0 == system 'rm', '-r', $custom_build_path
+ or die "failed to remove $custom_build_path: $?";
+ # but instead we want the produced artifacts
+ 0 == system 'dcmd', 'mv',
+ (dirname $custom_build_path)
+ . "/${srcpkgname}_${srcpkgbinver}_$changesarch.changes", $outdir
+ or die "dcmd failed\n";
+} elsif ($builder eq "sbuild" or $builder eq "sbuild+unshare") {
+
+ my @cmd = ('env', "--chdir=$outdir", @environment, 'sbuild');
+ push @cmd, "--build=$build_arch";
+ push @cmd, "--host=$host_arch";
+
+ if ($build_source) {
+ push @cmd, '--source';
+ } else {
+ push @cmd, '--no-source';
+ }
+ if ($build_archany) {
+ push @cmd, '--arch-any';
+ } else {
+ push @cmd, '--no-arch-any';
+ }
+ if ($build_archall) {
+ push @cmd, '--arch-all';
+ } else {
+ push @cmd, '--no-arch-all';
+ }
+ if ($cdata->{"Binary-Only-Changes"}) {
+ push @cmd, "--binNMU-changelog=$cdata->{'Binary-Only-Changes'}";
+ }
+ push @cmd, "--chroot=$tarballpath";
+ push @cmd, "--chroot-mode=unshare";
+ push @cmd, "--dist=unstable";
+ push @cmd, "--no-run-lintian";
+ push @cmd, "--no-run-autopkgtest";
+ push @cmd, "--no-apt-upgrade";
+ push @cmd, "--no-apt-distupgrade";
+ # disable the explainer
+ push @cmd, "--bd-uninstallable-explainer=";
+
+ if ($custom_build_path) {
+ push @cmd, "--build-path=$custom_build_path";
+ }
+ push @cmd, "${srcpkgname}_$srcpkgver";
+ print((join " ", @cmd) . "\n");
+ 0 == system @cmd or die "sbuild failed\n";
+} elsif ($builder eq "mmdebstrap") {
+
+ my @binnmucmds = ();
+ if ($cdata->{"Binary-Only-Changes"}) {
+ my $logentry = $cdata->{"Binary-Only-Changes"};
+ # due to storing the binnmu changelog entry in deb822 buildinfo, the first
+ # character is an unwanted newline
+ $logentry =~ s/^\n//;
+ # while the linebreak at the beginning is wrong, there are two missing at
+ # the end
+ $logentry .= "\n\n";
+ push @binnmucmds,
+ '{ printf "%s" '
+ . (String::ShellQuote::shell_quote $logentry)
+ . "; cat debian/changelog; } > debian/changelog.debrebuild",
+ "mv debian/changelog.debrebuild debian/changelog";
+ }
+
+ my @cmd = (
+ 'env', '-i',
+ 'PATH=/usr/sbin:/usr/bin:/sbin:/bin',
+ 'mmdebstrap',
+ "--arch=$build_arch",
+ "--variant=custom",
+ '--skip=setup',
+ '--skip=update',
+ '--skip=cleanup',
+ "--setup-hook=tar --exclude=\"./dev/*\" -C \"\$1\" -xf "
+ . (String::ShellQuote::shell_quote $tarballpath),
+ '--setup-hook=rm "$1"/etc/apt/sources.list',
+"--customize-hook=debsnap --force --destdir \"\$1\" $srcpkgname $srcpkgver",
+ '--customize-hook=chroot "$1" sh -c "'
+ . (
+ join ' && ',
+ "mkdir -p "
+ . (String::ShellQuote::shell_quote(dirname $custom_build_path)),
+ "dpkg-source --no-check -x /"
+ . $srcpkg->get_basename(1) . '.dsc '
+ . (String::ShellQuote::shell_quote $custom_build_path),
+ 'cd ' . (String::ShellQuote::shell_quote $custom_build_path),
+ @binnmucmds,
+"env $environment dpkg-buildpackage -uc -a $host_arch --build=$build",
+ 'cd /',
+ 'rm -r ' . (String::ShellQuote::shell_quote $custom_build_path))
+ . '"',
+ '--customize-hook=sync-out '
+ . (dirname $custom_build_path)
+ . " $outdir",
+ '',
+ '/dev/null',
+ );
+ print((join ' ', @cmd) . "\n");
+
+ 0 == system @cmd or die "mmdebstrap failed\n";
+} else {
+ die "unsupported builder: $builder\n";
+}
+
+# test if all checksums in the buildinfo file check out
+if ($builder ne "none") {
+ print "build artifacts stored in $outdir\n";
+
+ my $checksums = Dpkg::Checksums->new();
+ $checksums->add_from_control($cdata);
+ # remove the .dsc as we only did the binaries
+ # - the .dsc cannot be reproduced anyways because we cannot reproduce its
+ # signature
+ # - binNMUs can only be done with --build=any
+ foreach my $file ($checksums->get_files()) {
+ if ($file !~ /\.dsc$/) {
+ next;
+ }
+ $checksums->remove_file($file);
+ }
+
+ my $new_cdata
+ = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1);
+ $new_cdata->load($new_buildinfo);
+ my $new_checksums = Dpkg::Checksums->new();
+ $new_checksums->add_from_control($new_cdata);
+
+ my @files = $checksums->get_files();
+ my @new_files = $new_checksums->get_files();
+
+ if (scalar @files != scalar @new_files) {
+ print("old buildinfo:\n" . (join "\n", @files) . "\n");
+ print("new buildinfo:\n" . (join "\n", @new_files) . "\n");
+ die "new buildinfo contains a different number of files\n";
+ }
+
+ for (my $i = 0 ; $i <= $#files ; $i++) {
+ if ($files[$i] ne $new_files[$i]) {
+ die "different checksum files at position $i\n";
+ }
+ if ($files[$i] =~ /\.dsc$/) {
+ print("skipping $files[$i]\n");
+ next;
+ }
+ print("checking $files[$i]: ");
+ if ($checksums->get_size($files[$i])
+ != $new_checksums->get_size($files[$i])) {
+ die "size differs for $files[$i]\n";
+ } else {
+ print("size... ");
+ }
+ my $chksum = $checksums->get_checksum($files[$i], undef);
+ my $new_chksum = $new_checksums->get_checksum($new_files[$i], undef);
+ if (scalar keys %{$chksum} != scalar keys %{$new_chksum}) {
+ die "different algos for $files[$i]\n";
+ }
+ foreach my $algo (keys %{$chksum}) {
+ if (!exists $new_chksum->{$algo}) {
+ die "$algo is not used in both buildinfo files\n";
+ }
+ if ($chksum->{$algo} ne $new_chksum->{$algo}) {
+ die "value of $algo differs for $files[$i]\n";
+ }
+ print("$algo... ");
+ }
+ print("all OK\n");
+ }
+}