#!/usr/bin/perl # # Copyright © 2014-2020 Johannes Schauer Marin Rodrigues # Copyright © 2020 Niels Thykier # # 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 < $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"); } }