1#!/usr/bin/perl 2# 3# Copyright © 2014-2020 Johannes Schauer Marin Rodrigues <josch@debian.org> 4# Copyright © 2020 Niels Thykier <niels@thykier.net> 5# 6# Permission is hereby granted, free of charge, to any person obtaining a copy 7# of this software and associated documentation files (the "Software"), to deal 8# in the Software without restriction, including without limitation the rights 9# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 10# copies of the Software, and to permit persons to whom the Software is 11# furnished to do so, subject to the following conditions: 12# 13# The above copyright notice and this permission notice shall be included in 14# all copies or substantial portions of the Software. 15 16use strict; 17use warnings; 18use autodie; 19 20use Getopt::Long qw(:config gnu_getopt no_bundling no_auto_abbrev); 21 22use Dpkg::Control; 23use Dpkg::Index; 24use Dpkg::Deps; 25use Dpkg::Source::Package; 26use File::Temp qw(tempdir); 27use File::Path qw(make_path); 28use File::HomeDir; 29use JSON::PP; 30use Time::Piece; 31use File::Basename; 32use List::Util qw(any none); 33 34my $progname; 35 36BEGIN { 37 $progname = basename($0); 38 eval { require String::ShellQuote; }; 39 if ($@) { 40 if ($@ =~ /^Can\'t locate String\/ShellQuote\.pm/) { 41 die 42"$progname: you must have the libstring-shellquote-perl package installed\n" 43 . "to use this script"; 44 } else { 45 die 46"$progname: problem loading the String::ShellQuote module:\n $@\n" 47 . "Have you installed the libstring-shellquote-perl package?"; 48 } 49 } 50 51 eval { 52 require LWP::Simple; 53 require LWP::UserAgent; 54 require URI::Escape; # libwww-perl depends on liburi-perl 55 no warnings; 56 $LWP::Simple::ua 57 = LWP::UserAgent->new(agent => 'LWP::UserAgent/debrebuild'); 58 $LWP::Simple::ua->env_proxy(); 59 }; 60 if ($@) { 61 if ($@ =~ m/Can\'t locate LWP/) { 62 die "$progname: you must have the libwww-perl package installed\n" 63 . "to use this script"; 64 } else { 65 die "$progname: problem loading the LWP and URI modules:\n $@\n" 66 . "Have you installed the libwww-perl package?"; 67 } 68 } 69 70} 71 72my $respect_build_path = 1; 73my $use_tor = 0; 74my $outdir = './'; 75my $builder = 'none'; 76my $timestamp = ''; 77 78my %OPTIONS = ( 79 'help|h' => sub { usage(0); }, 80 'use-tor-proxy!' => \$use_tor, 81 'respect-build-path!' => \$respect_build_path, 82 'buildresult=s' => \$outdir, 83 'builder=s' => \$builder, 84 'timestamp|t=s' => \$timestamp, 85); 86 87sub usage { 88 my ($exit_code) = @_; 89 $exit_code //= 0; 90 print <<EOF; 91Usage: $progname [options] <buildinfo> 92 $progname <--help|-h> 93 94Given a buildinfo file from a Debian package, generate instructions for 95attempting to reproduce the binary packages built from the associated source 96and build information. 97 98Options: 99 --help, -h Show this help and exit 100 --[no-]use-tor-proxy Whether to fetch resources via tor (socks://127.0.0.1:9050) 101 Assumes "apt-transport-tor" is installed both in host + chroot 102 --[no-]respect-build-path Whether to setup the build to use the Build-Path from the 103 provided .buildinfo file. 104 --buildresults Directory for the build artifacts (default: ./) 105 --builder=BUILDER Which building software should be used. Possible values are 106 none, sbuild, mmdebstrap, dpkg and sbuild+unshare. The default 107 is none. See section BUILDER for details. 108 --timestamp, -t The required unstable main timestamps from snapshot.d.o if you 109 already know them, separated by commas, or one of the values 110 "first_seen" or "metasnap". See section TIMESTAMPS. 111 112Note: $progname can parse buildinfo files with and without a GPG signature. However, 113the signature (if present) is discarded as debrebuild does not support verifying 114it. If the authenticity or integrity of the buildinfo files are important to 115you, checking these need to be done before invoking $progname, for example by using 116dscverify. 117 118EXAMPLES 119 120 \$ $progname --buildresults=./artifacts --builder=mmdebstrap hello_2.10-2_amd64.buildinfo 121 122BUILDERS 123 124debrebuild can use different backends to perform the actual package rebuild. 125The desired backend is chosen using the --builder option. The default is 126"none". 127 128 none Dry-run mode. No build is performed. 129 sbuild Use sbuild to build the package. This requires sbuild to be 130 setup with schroot chroots of Debian stable distributions. 131 mmdebstrap Use mmdebstrap to build the package. This requires no 132 setup and no superuser privileges. 133 dpkg Directly run apt-get and dpkg-buildpackage on the current 134 system without chroot. This requires root privileges. 135 sbuild+unshare Use sbuild with the unshare backend. This will create the 136 chroot and perform the build without superuser privileges 137 and without any setup. 138 139TIMESTAMPS 140 141The --timestamp option allows one to skip the step of figuring out the correct 142set of required timestamps by listing them separated by commas in the same 143format used in the snapshot.d.o URL. The default is to use the "first_seen" 144attribute from the snapshot.d.o API and download multiple Packages files until 145all required timestamps are found. To explicitly select this mode, use 146--timestamp=first_seen. Lastly, the metasnap.d.n service can be used to figure 147out the right set of timestamps. This mode can be selected by using 148--timestamp=metasnap. In contrast to the "first_seen" mode, the metasnap.d.n 149service will always return a minimal set of timestamps if the package versions 150were at some point part of Debian unstable main. 151 152UNSHARE 153 154Before kernel 5.10.1 or before Debian 11 (Bullseye), unprivileged user 155namespaces were disabled in Debian for security reasons. Refer to Debian bug 156#898446 for details. To enable user namespaces, run: 157 158 \$ sudo sysctl -w kernel.unprivileged_userns_clone=1 159 160The sbuild+unshare builder requires and the mmdebstrap builder benefits from 161having unprivileged user namespaces activated. On Ubuntu they are enabled by 162default. 163 164LIMITATIONS 165 166Currently, the code assumes that all packages were at some point part of Debian 167unstable main. This fails for packages from Debian ports, packages from 168experimental as well as for locally built packages or packages from third 169party repositories. Enabling support for Debian ports and experimental is 170conceptually possible and only needs somebody implementing it. 171 172EOF 173 174 exit($exit_code); 175} 176 177GetOptions(%OPTIONS); 178 179my $buildinfo = shift @ARGV; 180if (not defined($buildinfo)) { 181 print STDERR "ERROR: Missing mandatory buildinfo filename\n"; 182 print STDERR "\n"; 183 usage(1); 184} 185if ($buildinfo eq '--help' or $buildinfo eq '-h') { 186 usage(0); 187} 188 189if ($buildinfo =~ m/^-/) { 190 print STDERR "ERROR: Unsupported option $buildinfo\n"; 191 print STDERR "\n"; 192 usage(1); 193} 194 195if (@ARGV) { 196 print STDERR "ERROR: This program requires exactly argument!\n"; 197 print STDERR "\n"; 198 usage(1); 199} 200 201my $base_mirror = "http://snapshot.debian.org/archive/debian"; 202if ($use_tor) { 203 $base_mirror = "tor+http://snapshot.debian.org/archive/debian"; 204 eval { 205 $LWP::Simple::ua->proxy([qw(http https)] => 'socks://127.0.0.1:9050'); 206 }; 207 if ($@) { 208 if ($@ =~ m/Can\'t locate LWP/) { 209 die 210"Unable to use tor: the liblwp-protocol-socks-perl package is not installed\n"; 211 } else { 212 die "Unable to use tor: Couldn't load socks proxy support: $@\n"; 213 } 214 } 215} 216 217# buildinfo support in libdpkg-perl (>= 1.18.11) 218my $cdata = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1); 219 220if (not $cdata->load($buildinfo)) { 221 die "cannot load $buildinfo\n"; 222} 223 224if ($cdata->get_option('is_pgp_signed')) { 225 print 226"$buildinfo contained a GPG signature; it has NOT been validated (debrebuild does not support this)!\n"; 227} else { 228 print "$buildinfo was unsigned\n"; 229} 230 231my @architectures = split /\s+/, $cdata->{"Architecture"}; 232my $build_source = (scalar(grep /^source$/, @architectures)) == 1; 233my $build_archall = (scalar(grep /^all$/, @architectures)) == 1; 234@architectures = grep { !/^source$/ && !/^all$/ } @architectures; 235if (scalar @architectures > 1) { 236 die "more than one architecture in Architecture field\n"; 237} 238my $build_archany = (scalar @architectures) == 1; 239 240my $build_arch = $cdata->{"Build-Architecture"}; 241if (not defined($build_arch)) { 242 die "need Build-Architecture field\n"; 243} 244my $host_arch = $cdata->{"Host-Architecture"}; 245if (not defined($host_arch)) { 246 $host_arch = $build_arch; 247} 248 249my $srcpkgname = $cdata->{Source}; 250my $srcpkgver = $cdata->{Version}; 251my $srcpkgbinver 252 = $cdata->{Version}; # this version will include the binmu suffix 253if ($srcpkgname =~ / /) { 254 # In some cases such as binNMUs, the source field contains a version in 255 # the form: 256 # mscgen (0.20) 257 ($srcpkgname, $srcpkgver) = split / /, $srcpkgname, 2; 258 # Add a simple control check to avoid the worst surprises and stop obvious 259 # cases of garbage-in-garbage-out. 260 die("Unexpected source package name: ${srcpkgname}\n") 261 if $srcpkgname =~ m{[ \t_/\(\)<>!\n%&\$\#\@]}; 262 # remove the surrounding parenthesis from the version 263 $srcpkgver =~ s/^\((.*)\)$/$1/; 264} 265 266my $new_buildinfo; 267{ 268 my $arch; 269 if ($build_archany) { 270 $arch = $host_arch; 271 } elsif ($build_archall) { 272 $arch = 'all'; 273 } else { 274 die "nothing to build\n"; 275 } 276 $new_buildinfo = "$outdir/${srcpkgname}_${srcpkgbinver}_$arch.buildinfo"; 277} 278if (-e $new_buildinfo) { 279 my ($dev1, $ino1) = (lstat $buildinfo)[0, 1] 280 or die "cannot lstat $buildinfo: $!\n"; 281 my ($dev2, $ino2) = (lstat $new_buildinfo)[0, 1] 282 or die "cannot lstat $new_buildinfo: $!\n"; 283 if ($dev1 == $dev2 && $ino1 == $ino2) { 284 die "refusing to overwrite the input buildinfo file\n"; 285 } 286} 287 288my $inst_build_deps = $cdata->{"Installed-Build-Depends"}; 289if (not defined($inst_build_deps)) { 290 die "need Installed-Build-Depends field\n"; 291} 292my $custom_build_path = $respect_build_path ? $cdata->{'Build-Path'} : undef; 293 294if (defined($custom_build_path)) { 295 if ($custom_build_path =~ m{['`\$\\"\(\)<>#]|(?:\a|/)[.][.](?:\z|/)}) { 296 warn( 297"Retry build with --no-respect-build-path to ignore the Build-Path field.\n" 298 ); 299 die( 300"Refusing to use $custom_build_path as Build-Path: Looks too special to be true" 301 ); 302 } 303 304 if ($custom_build_path eq '' or $custom_build_path !~ m{^/}) { 305 warn( 306"Retry build with --no-respect-build-path to ignore the Build-Path field.\n" 307 ); 308 die( 309qq{Build-Path must be a non-empty absolute path (i.e. start with "/").\n} 310 ); 311 } 312 print "Using defined Build-Path: ${custom_build_path}\n"; 313} else { 314 if ($respect_build_path) { 315 print 316"No Build-Path defined; not setting a defined build path for this build.\n"; 317 } 318} 319 320my $srcpkg = Dpkg::Source::Package->new(); 321$srcpkg->{fields}{'Source'} = $srcpkgname; 322$srcpkg->{fields}{'Version'} = $srcpkgver; 323my $dsc_fname 324 = (dirname($buildinfo)) . '/' . $srcpkg->get_basename(1) . ".dsc"; 325 326my $environment = $cdata->{"Environment"}; 327if (not defined($environment)) { 328 die "need Environment field\n"; 329} 330$environment =~ s/\n/ /g; # remove newlines 331$environment =~ s/^ //; # remove leading whitespace 332 333my @environment; 334foreach my $line (split /\n/, $cdata->{"Environment"}) { 335 chomp $line; 336 if ($line eq '') { 337 next; 338 } 339 my ($name, $val) = split /=/, $line, 2; 340 $val =~ s/^"(.*)"$/$1/; 341 push @environment, "$name=$val"; 342} 343 344# gather all installed build-depends and figure out the version of base-files 345my $base_files_version; 346my @inst_build_deps = (); 347$inst_build_deps 348 = deps_parse($inst_build_deps, reduce_arch => 0, build_dep => 0); 349if (!defined $inst_build_deps) { 350 die "deps_parse failed\n"; 351} 352 353foreach my $pkg ($inst_build_deps->get_deps()) { 354 if (!$pkg->isa('Dpkg::Deps::Simple')) { 355 die "dependency disjunctions are not allowed\n"; 356 } 357 if (not defined($pkg->{package})) { 358 die "name undefined\n"; 359 } 360 if (defined($pkg->{relation})) { 361 if ($pkg->{relation} ne "=") { 362 die "wrong relation"; 363 } 364 if (not defined($pkg->{version})) { 365 die "version undefined\n"; 366 } 367 } else { 368 die "no version"; 369 } 370 if ($pkg->{package} eq "base-files") { 371 if (defined($base_files_version)) { 372 die "more than one base-files\n"; 373 } 374 $base_files_version = $pkg->{version}; 375 } 376 push @inst_build_deps, 377 { 378 name => $pkg->{package}, 379 architecture => $pkg->{archqual}, 380 version => $pkg->{version} }; 381} 382 383if (!defined($base_files_version)) { 384 die "no base-files\n"; 385} 386 387# figure out the debian release from the version of base-files 388my $base_dist; 389 390my %base_files_map = (); 391my $di_path = '/usr/share/distro-info/debian.csv'; 392eval { require Debian::DistroInfo; }; 393if (!$@) { 394 # libdistro-info-perl is installed 395 my $di = DebianDistroInfo->new(); 396 foreach my $series ($di->all) { 397 if (!$di->version($series)) { 398 next; 399 } 400 $base_files_map{ $di->version($series) } = $series; 401 } 402} elsif (-f $di_path) { 403 # distro-info-data is installed 404 open my $fh, '<', $di_path or die "cannot open $di_path: $!\n"; 405 my $i = 0; 406 while (my $line = <$fh>) { 407 chomp($line); 408 $i++; 409 my @cells = split /,/, $line; 410 if (scalar @cells < 4) { 411 die "cannot parse line $i of $di_path\n"; 412 } 413 if ( 414 $i == 1 415 and ( scalar @cells < 6 416 or $cells[0] ne 'version' 417 or $cells[1] ne 'codename' 418 or $cells[2] ne 'series' 419 or $cells[3] ne 'created' 420 or $cells[4] ne 'release' 421 or $cells[5] ne 'eol') 422 ) { 423 die "cannot find correct header in $di_path\n"; 424 } 425 if ($i == 1) { 426 next; 427 } 428 $base_files_map{ $cells[0] } = $cells[2]; 429 } 430 close $fh; 431} else { 432 # nothing is installed -- use hard-coded values 433 %base_files_map = ( 434 "6" => "squeeze", 435 "7" => "wheezy", 436 "8" => "jessie", 437 "9" => "stretch", 438 "10" => "buster", 439 "11" => "bullseye", 440 "12" => "bookworm", 441 "13" => "trixie", 442 ); 443} 444 445$base_files_version =~ s/^(\d+).*/$1/; 446 447# we subtract one from $base_files_version because we want the Debian release 448# before what is currently in unstable 449$base_dist = $base_files_map{ $base_files_version - 1 }; 450 451if (!defined $base_dist) { 452 die "base-files version didn't map to any Debian release\n"; 453} 454 455my $src_date; 456{ 457 print "retrieving snapshot.d.o data for $srcpkgname $srcpkgver\n"; 458 my $json_url 459 = "http://snapshot.debian.org/mr/package/$srcpkgname/$srcpkgver/srcfiles?fileinfo=1"; 460 my $content = LWP::Simple::get($json_url); 461 die "cannot retrieve $json_url" unless defined $content; 462 my $json = JSON::PP->new(); 463 # json options taken from debsnap 464 my $json_text = $json->allow_nonref->utf8->relaxed->decode($content); 465 die "cannot decode json" unless defined $json_text; 466 foreach my $result (@{ $json_text->{result} }) { 467 # FIXME - assumption: package is from Debian official (and not ports) 468 my @package_from_main = grep { $_->{archive_name} eq "debian" } 469 @{ $json_text->{fileinfo}->{ $result->{hash} } }; 470 if (scalar @package_from_main > 1) { 471 die 472 "more than one package with the same hash in Debian official\n"; 473 } 474 if (scalar @package_from_main == 0) { 475 die "no package with the right hash in Debian official\n"; 476 } 477 $src_date = $package_from_main[0]->{first_seen}; 478 } 479} 480if (!defined($src_date)) { 481 die "cannot find .dsc\n"; 482} 483 484# support timestamps being separated by a comma 485my @required_timestamps = (); 486if ($timestamp eq "first_seen") { 487 # nothing to do, timestamps will be figured out later 488} elsif ($timestamp eq "metasnap") { 489 # acquire the required timestamps using metasnap.d.n 490 print "retrieving required timestamps from metasnap.d.n\n"; 491 my $ua = LWP::UserAgent->new(timeout => 10); 492 $ua->env_proxy; 493 my @pkgs = (); 494 foreach my $pkg (@inst_build_deps) { 495 my $pkg_name = $pkg->{name}; 496 my $pkg_ver = $pkg->{version}; 497 my $pkg_arch = $pkg->{architecture}; 498 if (defined $pkg_arch) { 499 push @pkgs, 500 URI::Escape::uri_escape("$pkg_name:$pkg_arch=$pkg_ver"); 501 } else { 502 push @pkgs, URI::Escape::uri_escape("$pkg_name=$pkg_ver"); 503 } 504 } 505 my $response 506 = $ua->get('https://metasnap.debian.net/cgi-bin/api' 507 . '?archive=debian' 508 . "&pkgs=" 509 . (join "%2C", @pkgs) 510 . "&arch=$build_arch" 511 . '&suite=unstable' 512 . '&comp=main'); 513 if (!$response->is_success) { 514 die "request to metasnap.d.n failed: $response->status_line"; 515 } 516 foreach my $line (split /\n/, $response->decoded_content) { 517 my ($arch, $t) = split / /, $line, 2; 518 if ($arch ne $build_arch) { 519 die 520"debrebuild is currently unable to handle multiple architectures"; 521 } 522 push @required_timestamps, $t; 523 } 524} else { 525 @required_timestamps = split(/,/, $timestamp); 526} 527 528# setup a temporary apt directory 529 530my $tempdir = tempdir(CLEANUP => 1); 531 532foreach my $d (( 533 '/etc/apt', '/etc/apt/apt.conf.d', 534 '/etc/apt/preferences.d', '/etc/apt/trusted.gpg.d', 535 '/etc/apt/sources.list.d', '/var/lib/apt/lists/partial', 536 '/var/cache/apt/archives/partial', '/var/lib/dpkg', 537 ) 538) { 539 make_path("$tempdir/$d"); 540} 541 542# We use the Build-Date field as a heuristic to find a good date for the 543# stable release. If we would get the stable release from deb.debian.org 544# instead, then packages might be newer than in unstable of the past because 545# of point releases. The date from the source package will also work in most 546# cases but will fail for binNMU buildinfo files where the source package 547# might even come from years in the past 548my $build_date; 549{ 550 local $ENV{LC_ALL} = 'C'; 551 my $tp 552 = Time::Piece->strptime($cdata->{'Build-Date'}, '%a, %d %b %Y %T %z'); 553 $build_date = $tp->strftime("%Y%m%dT%H%M%SZ"); 554} 555 556sub get_sources_list() { 557 my @result = (); 558 push @result, "deb $base_mirror/$build_date/ $base_dist main"; 559 push @result, "deb-src $base_mirror/$src_date/ unstable main"; 560 foreach my $ts (@required_timestamps) { 561 push @result, "deb $base_mirror/$ts/ unstable main"; 562 } 563 return @result; 564} 565 566open(FH, '>', "$tempdir/etc/apt/sources.list"); 567print FH (join "\n", get_sources_list) . "\n"; 568close FH; 569# FIXME - document what's dpkg's status for 570# Create dpkg status 571open(FH, '>', "$tempdir/var/lib/dpkg/status"); 572close FH; #empty file 573# Create apt.conf 574my $aptconf = "$tempdir/etc/apt/apt.conf"; 575open(FH, '>', $aptconf); 576 577# We create an apt.conf and pass it to apt via the APT_CONFIG environment 578# variable instead of passing all options via the command line because 579# otherwise apt will read the system's config first and might get unwanted 580# configuration options from there. See apt.conf(5) for the order in which 581# configuration options are read. 582# 583# While we are at it, we also set all other options through our custom 584# apt.conf. 585# 586# Apt::Architecture has to be set because otherwise apt will default to the 587# architecture apt was compiled for. 588# 589# Apt::Architectures has to be set or otherwise apt will use dpkg to find all 590# foreign architectures of the system running apt. 591# 592# Dir::State::status has to be set even though Dir is set because Dir::State 593# is set to var/lib/apt, so Dir::State::status would be below that but really 594# isn't and without an absolute path, Dir::State::status would be constructed 595# from Dir + Dir::State + Dir::State::status. This has been fixed in apt 596# commit 475f75506db48a7fa90711fce4ed129f6a14cc9a. 597# 598# Acquire::Check-Valid-Until has to be set to false because the snapshot 599# timestamps might be too far in the past to still be valid. This could be 600# fixed by a solution to https://bugs.debian.org/763419 601# 602# Acquire::Languages has to be set to prevent downloading of translations from 603# the mirrors. 604# 605# Binary::apt-get::Acquire::AllowInsecureRepositories has to be set to false 606# so that apt-get update fails if repositories cannot be authenticated. The 607# default value of this option will change to true with apt from Debian 608# Buster. 609# 610# We need APT::Get::allow-downgrades set to true, because even if we choose a 611# base distribution that was released before the state that "unstable" 612# currently is in, the package versions in that stable release might be newer 613# than what is in unstable due to security fixes. Choosing a stable release 614# from an older snapshot timestamp would fix this problem but would defeat the 615# purpose of a base distribution for builders like sbuild which can take 616# advantage of existing chroot environments. 617 618print FH <<EOF; 619Apt { 620 Architecture "$build_arch"; 621 Architectures "$build_arch"; 622}; 623 624Dir "$tempdir"; 625Dir::State::status "$tempdir/var/lib/dpkg/status"; 626Acquire::Languages "none"; 627Binary::apt-get::Acquire::AllowInsecureRepositories "false"; 628EOF 629my @common_aptopts = ( 630 'Acquire::Check-Valid-Until "false";', 631 'Acquire::http::Dl-Limit "1000";', 632 'Acquire::https::Dl-Limit "1000";', 633 'Acquire::Retries "5";', 634 'APT::Get::allow-downgrades "true";', 635); 636foreach my $line (@common_aptopts) { 637 print FH "$line\n"; 638} 639close FH; 640 641# add the removed keys because they are not returned by Dpkg::Vendor 642# we don't need the Ubuntu vendor now but we already put the comments to 643# possibly extend this script to other Debian derivatives 644my @keyrings = (); 645my $debianvendor = Dpkg::Vendor::Debian->new(); 646push @keyrings, $debianvendor->run_hook('archive-keyrings'); 647push @keyrings, $debianvendor->run_hook('archive-keyrings-historic'); 648#my $ubuntuvendor = Dpkg::Vendor::Ubuntu->new(); 649#push @keyrings, $ubuntuvendor->run_hook('archive-keyrings'); 650#push @keyrings, $ubuntuvendor->run_hook('archive-keyrings-historic'); 651 652foreach my $keyring (@keyrings) { 653 my $base = basename $keyring; 654 print "$keyring\n"; 655 if (-f $keyring) { 656 print "linking $tempdir/etc/apt/trusted.gpg.d/$base to $keyring\n"; 657 symlink $keyring, "$tempdir/etc/apt/trusted.gpg.d/$base"; 658 } 659} 660 661$ENV{'APT_CONFIG'} = $aptconf; 662 6630 == system 'apt-get', 'update' or die "apt-get update failed\n"; 664 665sub dpkg_index_key_func { 666 return 667 $_[0]->{Package} . ' ' 668 . $_[0]->{Version} . ' ' 669 . $_[0]->{Architecture}; 670} 671 672sub parse_all_packages_files { 673 my $dpkg_index = Dpkg::Index->new(get_key_func => \&dpkg_index_key_func); 674 675 open(my $fd, '-|', 'apt-get', 'indextargets', '--format', '$(FILENAME)', 676 'Created-By: Packages'); 677 while (my $fname = <$fd>) { 678 chomp $fname; 679 print "parsing $fname...\n"; 680 open(my $fd2, '-|', '/usr/lib/apt/apt-helper', 'cat-file', $fname); 681 $dpkg_index->parse($fd2, "pipe") or die "cannot parse Packages file\n"; 682 close($fd2); 683 } 684 close($fd); 685 return $dpkg_index; 686} 687 688my $index = parse_all_packages_files(); 689if (scalar @required_timestamps == 0) { 690 # go through all packages in the Installed-Build-Depends field and find out 691 # the timestamps at which they were first seen each 692 my %notfound_timestamps; 693 694 my %missing; 695 696 foreach my $pkg (@inst_build_deps) { 697 my $pkg_name = $pkg->{name}; 698 my $pkg_ver = $pkg->{version}; 699 my $pkg_arch = $pkg->{architecture}; 700 701 # check if we really need to acquire this package from snapshot.d.o or if 702 # it already exists in the cache 703 if (defined $pkg->{architecture}) { 704 if ($index->get_by_key("$pkg_name $pkg_ver $pkg_arch")) { 705 print "skipping $pkg_name $pkg_ver\n"; 706 next; 707 } 708 } else { 709 if ($index->get_by_key("$pkg_name $pkg_ver $build_arch")) { 710 $pkg->{architecture} = $build_arch; 711 print "skipping $pkg_name $pkg_ver\n"; 712 next; 713 } 714 if ($index->get_by_key("$pkg_name $pkg_ver all")) { 715 $pkg->{architecture} = "all"; 716 print "skipping $pkg_name $pkg_ver\n"; 717 next; 718 } 719 } 720 721 print "retrieving snapshot.d.o data for $pkg_name $pkg_ver\n"; 722 my $json_url 723 = "http://snapshot.debian.org/mr/binary/$pkg_name/$pkg_ver/binfiles?fileinfo=1"; 724 my $content = LWP::Simple::get($json_url); 725 die "cannot retrieve $json_url" unless defined $content; 726 my $json = JSON::PP->new(); 727 # json options taken from debsnap 728 my $json_text = $json->allow_nonref->utf8->relaxed->decode($content); 729 die "cannot decode json" unless defined $json_text; 730 my $pkg_hash; 731 if (scalar @{ $json_text->{result} } == 1) { 732 # if there is only a single result, then the package must either be 733 # Architecture:all, be the build architecture or match the requested 734 # architecture 735 $pkg_hash = ${ $json_text->{result} }[0]->{hash}; 736 $pkg->{architecture} 737 = ${ $json_text->{result} }[0]->{architecture}; 738 # if a specific architecture was requested, it should match 739 if (defined $pkg_arch && $pkg_arch ne $pkg->{architecture}) { 740 die 741"package $pkg_name was explicitly requested for $pkg_arch but only $pkg->{architecture} was found\n"; 742 } 743 # if no specific architecture was requested, it should be the build 744 # architecture 745 if ( !defined $pkg_arch 746 && $build_arch ne $pkg->{architecture} 747 && "all" ne $pkg->{architecture}) { 748 die 749"package $pkg_name was implicitly requested for $pkg_arch but only $pkg->{architecture} was found\n"; 750 } 751 # Ensure that $pkg_arch is defined from here as we want to look it up 752 # later in a Packages file from snapshot.d.o if it is not in the 753 # current Packages file 754 $pkg_arch = $pkg->{architecture}; 755 } else { 756 # Since the package occurs more than once, we expect it to be of 757 # Architecture:any 758 # 759 # If no specific architecture was requested, look for the build 760 # architecture 761 if (!defined $pkg_arch) { 762 $pkg_arch = $build_arch; 763 } 764 foreach my $result (@{ $json_text->{result} }) { 765 if ($result->{architecture} eq $pkg_arch) { 766 $pkg_hash = $result->{hash}; 767 last; 768 } 769 } 770 if (!defined($pkg_hash)) { 771 die "cannot find package in architecture $pkg_arch\n"; 772 } 773 # we now know that this package is not architecture:all but has a 774 # concrete architecture 775 $pkg->{architecture} = $pkg_arch; 776 } 777 # FIXME - assumption: package is from Debian official (and not ports) 778 my @package_from_main = grep { $_->{archive_name} eq "debian" } 779 @{ $json_text->{fileinfo}->{$pkg_hash} }; 780 if (scalar @package_from_main > 1) { 781 die 782 "more than one package with the same hash in Debian official\n"; 783 } 784 if (scalar @package_from_main == 0) { 785 die "no package with the right hash in Debian official\n"; 786 } 787 my $date = $package_from_main[0]->{first_seen}; 788 $pkg->{first_seen} = $date; 789 $notfound_timestamps{$date} = 1; 790 $missing{"${pkg_name}/${pkg_ver}/${pkg_arch}"} = 1; 791 } 792 793 # feed apt with timestamped snapshot.debian.org URLs until apt is able to 794 # find all the required package versions. We start with the most recent 795 # timestamp, check which packages cannot be found at that timestamp, add 796 # the timestamp of the most recent not-found package and continue doing 797 # this iteratively until all versions can be found. 798 799 while (0 < scalar keys %notfound_timestamps) { 800 print "left to check: " . (scalar keys %notfound_timestamps) . "\n"; 801 my @timestamps = map { Time::Piece->strptime($_, '%Y%m%dT%H%M%SZ') } 802 (sort keys %notfound_timestamps); 803 my $newest = $timestamps[$#timestamps]; 804 $newest = $newest->strftime("%Y%m%dT%H%M%SZ"); 805 push @required_timestamps, $newest; 806 delete $notfound_timestamps{$newest}; 807 808 my $snapshot_url = "$base_mirror/$newest/"; 809 810 open(FH, '>>', "$tempdir/etc/apt/sources.list"); 811 print FH "deb ${snapshot_url} unstable main\n"; 812 close FH; 813 814 0 == system 'apt-get', 'update' or die "apt-get update failed\n"; 815 816 my $index = parse_all_packages_files(); 817 foreach my $pkg (@inst_build_deps) { 818 my $pkg_name = $pkg->{name}; 819 my $pkg_ver = $pkg->{version}; 820 my $pkg_arch = $pkg->{architecture}; 821 my $first_seen = $pkg->{first_seen}; 822 my $cdata = $index->get_by_key("$pkg_name $pkg_ver $pkg_arch"); 823 if (not defined($cdata->{"Package"})) { 824 # Not present yet; we hope a later snapshot URL will locate it. 825 next; 826 } 827 delete($missing{"${pkg_name}/${pkg_ver}/${pkg_arch}"}); 828 if (defined $first_seen) { 829 # this may delete timestamps that we actually need for some other 830 # packages 831 delete $notfound_timestamps{$first_seen}; 832 } 833 } 834 } 835 836 if (%missing) { 837 print STDERR 'Cannot locate the following packages via snapshots' 838 . " or the current repo/mirror\n"; 839 for my $key (sort(keys(%missing))) { 840 print STDERR " ${key}\n"; 841 } 842 exit(1); 843 } 844} else { 845 # find out the actual package architecture for all installed build 846 # dependencies without explicit architecture qualification 847 foreach my $pkg (@inst_build_deps) { 848 my $pkg_name = $pkg->{name}; 849 my $pkg_ver = $pkg->{version}; 850 if (defined $pkg->{architecture}) { 851 next; 852 } 853 if ($index->get_by_key("$pkg_name $pkg_ver $build_arch")) { 854 $pkg->{architecture} = $build_arch; 855 next; 856 } 857 if ($index->get_by_key("$pkg_name $pkg_ver all")) { 858 $pkg->{architecture} = "all"; 859 next; 860 } 861 die "cannot find $pkg_name $pkg_ver in index\n"; 862 } 863} 864 865# remove $tempdir manually to avoid any surprises 8660 == system 'apt-get', '--option', 867 'Dir::Etc::SourceList=/dev/null', '--option', 868 'Dir::Etc::SourceParts=/dev/null', 'update' 869 or die "apt-get update failed\n"; 870 871foreach my $f ( 872 '/var/cache/apt/pkgcache.bin', 873 '/var/cache/apt/srcpkgcache.bin', 874 '/var/lib/dpkg/status', 875 '/var/lib/apt/lists/lock', 876 '/etc/apt/apt.conf', 877 '/etc/apt/sources.list', 878 '/etc/apt/trusted.gpg.d/debian-archive-removed-keys.gpg', 879 '/etc/apt/trusted.gpg.d/debian-archive-keyring.gpg' 880) { 881 unlink "$tempdir/$f" or die "cannot unlink $tempdir/$f: $!\n"; 882} 883 884foreach my $d ( 885 '/var/cache/apt/archives/partial', '/var/cache/apt/archives', 886 '/var/cache/apt', '/var/cache', 887 '/var/lib/dpkg', '/var/lib/apt/lists/auxfiles', 888 '/var/lib/apt/lists/partial', '/var/lib/apt/lists', 889 '/var/lib/apt', '/var/lib', 890 '/var', '/etc/apt/sources.list.d', 891 '/etc/apt/trusted.gpg.d', '/etc/apt/preferences.d', 892 '/etc/apt/apt.conf.d', '/etc/apt', 893 '/etc', '' 894) { 895 rmdir "$tempdir/$d" or die "cannot rmdir $d: $!\n"; 896} 897 898!-e $tempdir or die "failed to remove $tempdir\n"; 899 900if ($builder ne "none") { 901 if (!-e $outdir) { 902 make_path($outdir); 903 } 904} 905 906my $build = ''; 907my $changesarch = ''; 908if ($build_archany and $build_archall) { 909 $build = "binary"; 910 $changesarch = $host_arch; 911} elsif ($build_archany and !$build_archall) { 912 $build = "any"; 913 $changesarch = $host_arch; 914} elsif (!$build_archany and $build_archall) { 915 $build = "all"; 916 $changesarch = 'all'; 917} else { 918 die "nothing to build\n"; 919} 920 921my @install = (); 922foreach my $pkg (@inst_build_deps) { 923 my $pkg_name = $pkg->{name}; 924 my $pkg_ver = $pkg->{version}; 925 my $pkg_arch = $pkg->{architecture}; 926 if (any { $_ eq $builder } ('mmdebstrap', 'none', 'dpkg')) { 927 if ($pkg_arch eq "all" || $pkg_arch eq $build_arch) { 928 push @install, "$pkg_name=$pkg_ver"; 929 } else { 930 push @install, "$pkg_name:$pkg_arch=$pkg_ver"; 931 } 932 } elsif (any { $_ eq $builder } ('sbuild', 'sbuild+unshare')) { 933 if ($pkg_arch eq "all" || $pkg_arch eq $build_arch) { 934 push @install, "$pkg_name (= $pkg_ver)"; 935 } else { 936 push @install, "$pkg_name:$pkg_arch (= $pkg_ver)"; 937 } 938 } else { 939 die "unsupported builder: $builder\n"; 940 } 941} 942 943if ($builder eq "none") { 944 print "\n"; 945 print "Manual installation and build\n"; 946 print "-----------------------------\n"; 947 print "\n"; 948 print 949 "The following sources.list contains all the required repositories:\n"; 950 print "\n"; 951 print(join "\n", get_sources_list); 952 print "\n"; 953 print "You can manually install the right dependencies like this:\n"; 954 print "\n"; 955 print "apt-get install --no-install-recommends"; 956 957 # Release files from snapshots.d.o have often expired by the time 958 # we fetch them. Include the option to work around that to assist 959 # the user. 960 print " -oAcquire::Check-Valid-Until=false"; 961 foreach my $pkg (@install) { 962 print " $pkg"; 963 } 964 print "\n"; 965 print "\n"; 966 print "And then build your package:\n"; 967 print "\n"; 968 if ($custom_build_path) { 969 require Cwd; 970 my $custom_build_parent_dir = dirname($custom_build_path); 971 my $dsc_path = Cwd::realpath($dsc_fname) 972 // die("Cannot resolve ${dsc_fname}: $!\n"); 973 print "mkdir -p \"${custom_build_parent_dir}\"\n"; 974 print qq{dpkg-source -x "${dsc_path}" "${custom_build_path}"\n}; 975 print "cd \"$custom_build_path\"\n"; 976 } else { 977 print qq{dpkg-source -x "${dsc_fname}"\n}; 978 print "cd packagedirectory\n"; 979 } 980 print "\n"; 981 if ($cdata->{"Binary-Only-Changes"}) { 982 print( "Since this is a binNMU, you must put the following " 983 . "lines at the top of debian/changelog:\n\n"); 984 print($cdata->{"Binary-Only-Changes"}); 985 } 986 print "\n"; 987 print( "$environment dpkg-buildpackage -uc " 988 . "--host-arch=$host_arch --build=$build\n"); 989} elsif ($builder eq "dpkg") { 990 if ("$build_arch\n" ne `dpkg --print-architecture`) { 991 die "must be run on $build_arch\n"; 992 } 993 994 if ($> != 0) { 995 die "you must be root for the dpkg builder\n"; 996 } 997 998 if (-e $custom_build_path) { 999 die "$custom_build_path exists -- refusing to overwrite\n"; 1000 } 1001 1002 my $sources = '/etc/apt/sources.list.d/debrebuild.list'; 1003 if (-e $sources) { 1004 die "$sources already exists -- refusing to overwrite\n"; 1005 } 1006 open(FH, '>', $sources) or die "cannot open $sources: $!\n"; 1007 print FH (join "\n", get_sources_list) . "\n"; 1008 close FH; 1009 1010 my $config = '/etc/apt/apt.conf.d/23-debrebuild.conf'; 1011 if (-e $config) { 1012 die "$config already exists -- refusing to overwrite\n"; 1013 } 1014 open(FH, '>', $config) or die "cannot open $config: $!\n"; 1015 foreach my $line (@common_aptopts) { 1016 print FH "$line\n"; 1017 } 1018 close FH; 1019 1020 0 == system 'apt-get', 'update' or die "apt-get update failed\n"; 1021 1022 my @cmd 1023 = ('apt-get', 'install', '--no-install-recommends', '--yes', @install); 1024 0 == system @cmd or die "apt-get install failed\n"; 1025 1026 0 == system 'apt-get', 'source', '--only-source', '--download-only', 1027 "$srcpkgname=$srcpkgver" 1028 or die "apt-get source failed\n"; 1029 unlink $sources or die "failed to unlink $sources\n"; 1030 unlink $config or die "failed to unlink $config\n"; 1031 make_path(dirname $custom_build_path); 1032 0 == system 'dpkg-source', '--no-check', '--extract', 1033 $srcpkg->get_basename(1) . '.dsc', $custom_build_path 1034 or die "dpkg-source failed\n"; 1035 1036 if ($cdata->{"Binary-Only-Changes"}) { 1037 open my $infh, '<', "$custom_build_path/debian/changelog" 1038 or die "cannot open debian/changelog for reading: $!\n"; 1039 my $changelogcontent = do { local $/; <$infh> }; 1040 close $infh; 1041 open my $outfh, '>', "$custom_build_path/debian/changelog" 1042 or die "cannot open debian/changelog for writing: $!\n"; 1043 my $logentry = $cdata->{"Binary-Only-Changes"}; 1044 # due to storing the binnmu changelog entry in deb822 buildinfo, the 1045 # first character is an unwanted newline 1046 $logentry =~ s/^\n//; 1047 print $outfh $logentry; 1048 # while the linebreak at the beginning is wrong, there are two missing 1049 # at the end 1050 print $outfh "\n\n"; 1051 print $outfh $changelogcontent; 1052 close $outfh; 1053 } 1054 0 == system 'env', "--chdir=$custom_build_path", @environment, 1055 'dpkg-buildpackage', '-uc', "--host-arch=$host_arch", "--build=$build" 1056 or die "dpkg-buildpackage failed\n"; 1057 # we are not interested in the unpacked source directory 1058 0 == system 'rm', '-r', $custom_build_path 1059 or die "failed to remove $custom_build_path: $?"; 1060 # but instead we want the produced artifacts 1061 0 == system 'dcmd', 'mv', 1062 (dirname $custom_build_path) 1063 . "/${srcpkgname}_${srcpkgbinver}_$changesarch.changes", $outdir 1064 or die "dcmd failed\n"; 1065} elsif ($builder eq "sbuild" or $builder eq "sbuild+unshare") { 1066 my $tarballpath = File::HomeDir->my_home 1067 . "/.cache/sbuild/$base_dist-$build_arch.tar.gz"; 1068 if ($builder eq "sbuild+unshare") { 1069 if (!-e $tarballpath) { 1070 my $chrootdir = tempdir(); 1071 0 == system 'sbuild-createchroot', '--chroot-mode=unshare', 1072 '--make-sbuild-tarball', $tarballpath, 1073 $base_dist, $chrootdir, "$base_mirror/$build_date/" 1074 or die "sbuild-createchroot failed\n"; 1075 !-e $chrootdir or die "$chrootdir wasn't removed\n"; 1076 } 1077 } 1078 1079 my @cmd = ('env', "--chdir=$outdir", @environment, 'sbuild'); 1080 foreach my $line (get_sources_list) { 1081 push @cmd, "--extra-repository=$line"; 1082 } 1083 1084 # Release files from snapshots.d.o have often expired by the time 1085 # we fetch them. Include the option to work around that to assist 1086 # the user. 1087 push @cmd, 1088 '--chroot-setup-commands=echo ' 1089 . (String::ShellQuote::shell_quote(join '\n', @common_aptopts)) 1090 . ' | tee /etc/apt/apt.conf.d/23-debrebuild.conf'; 1091 1092 # sbuild chroots have build-essential already installed. This might 1093 # interfere with the packages that we need to install. Example: 1094 # libc6-dev : Breaks: libgcc-8-dev (< 8.4.0-2~) but 8.3.0-6 is to be inst.. 1095 # Thus, we remove them beforehand -- the right versions will get installed 1096 # later anyways. 1097 # We have to list the packages manually instead of relying on autoremove 1098 # because debootstrap marks them all as manually installed. 1099 push @cmd, 1100 ( '--chroot-setup-commands=apt-get --yes remove build-essential' 1101 . ' libc6-dev gcc g++ make dpkg-dev'); 1102 push @cmd, '--chroot-setup-commands=apt-get --yes autoremove'; 1103 1104 push @cmd, "--add-depends=" . (join ",", @install); 1105 push @cmd, "--build=$build_arch"; 1106 push @cmd, "--host=$host_arch"; 1107 1108 if ($build_source) { 1109 push @cmd, '--source'; 1110 } else { 1111 push @cmd, '--no-source'; 1112 } 1113 if ($build_archany) { 1114 push @cmd, '--arch-any'; 1115 } else { 1116 push @cmd, '--no-arch-any'; 1117 } 1118 if ($build_archall) { 1119 push @cmd, '--arch-all'; 1120 } else { 1121 push @cmd, '--no-arch-all'; 1122 } 1123 if ($cdata->{"Binary-Only-Changes"}) { 1124 push @cmd, "--binNMU-changelog=$cdata->{'Binary-Only-Changes'}"; 1125 } 1126 if ($builder eq "sbuild+unshare") { 1127 push @cmd, "--chroot=$tarballpath"; 1128 push @cmd, "--chroot-mode=unshare"; 1129 } 1130 push @cmd, "--dist=$base_dist"; 1131 push @cmd, "--no-run-lintian"; 1132 push @cmd, "--no-run-autopkgtest"; 1133 push @cmd, "--no-apt-upgrade"; 1134 push @cmd, "--no-apt-distupgrade"; 1135 # disable the explainer 1136 push @cmd, "--bd-uninstallable-explainer="; 1137 # We need the aspcud resolver to install packages that are older than the 1138 # ones in the latest snapshot. Apt by default will only use the latest 1139 # package versions as candidates and sbuild uses a dummy package instead 1140 # of crafting an apt command line with the exact version requirements. 1141 push @cmd, "--build-dep-resolver=aspcud"; 1142 1143 if ($custom_build_path) { 1144 push @cmd, "--build-path=$custom_build_path"; 1145 } 1146 push @cmd, "${srcpkgname}_$srcpkgver"; 1147 print((join " ", @cmd) . "\n"); 1148 0 == system @cmd or die "sbuild failed\n"; 1149} elsif ($builder eq "mmdebstrap") { 1150 1151 my @binnmucmds = (); 1152 if ($cdata->{"Binary-Only-Changes"}) { 1153 my $logentry = $cdata->{"Binary-Only-Changes"}; 1154 # due to storing the binnmu changelog entry in deb822 buildinfo, the first 1155 # character is an unwanted newline 1156 $logentry =~ s/^\n//; 1157 # while the linebreak at the beginning is wrong, there are two missing at 1158 # the end 1159 $logentry .= "\n\n"; 1160 push @binnmucmds, 1161 '{ printf "%s" ' 1162 . (String::ShellQuote::shell_quote $logentry) 1163 . "; cat debian/changelog; } > debian/changelog.debrebuild", 1164 "mv debian/changelog.debrebuild debian/changelog"; 1165 } 1166 1167 my @cmd = ( 1168 'env', '-i', 1169 'PATH=/usr/sbin:/usr/bin:/sbin:/bin', 1170 'mmdebstrap', 1171 "--arch=$build_arch", 1172 "--variant=apt", 1173 (map { "--aptopt=$_" } @common_aptopts), 1174 '--include=' . (join ' ', @install), 1175 '--essential-hook=chroot "$1" sh -c "' 1176 . ( 1177 join ' && ', 1178 'rm /etc/apt/sources.list', 1179 'echo ' 1180 . ( 1181 String::ShellQuote::shell_quote( 1182 (join "\n", get_sources_list) . "\n" 1183 )) 1184 . ' >> /etc/apt/sources.list', 1185 'apt-get update' 1186 ) 1187 . '"', 1188 '--customize-hook=chroot "$1" sh -c "' 1189 . ( 1190 join ' && ', 1191 "apt-get source --only-source -d $srcpkgname=$srcpkgver", 1192 "mkdir -p " 1193 . (String::ShellQuote::shell_quote(dirname $custom_build_path)), 1194 "dpkg-source --no-check -x /" 1195 . $srcpkg->get_basename(1) . '.dsc ' 1196 . (String::ShellQuote::shell_quote $custom_build_path), 1197 'cd ' . (String::ShellQuote::shell_quote $custom_build_path), 1198 @binnmucmds, 1199"env $environment dpkg-buildpackage -uc -a $host_arch --build=$build", 1200 'cd /', 1201 'rm -r ' . (String::ShellQuote::shell_quote $custom_build_path)) 1202 . '"', 1203 '--customize-hook=sync-out ' 1204 . (dirname $custom_build_path) 1205 . " $outdir", 1206 $base_dist, 1207 '/dev/null', 1208 "deb $base_mirror/$build_date/ $base_dist main" 1209 ); 1210 print((join ' ', @cmd) . "\n"); 1211 1212 0 == system @cmd or die "mmdebstrap failed\n"; 1213} else { 1214 die "unsupported builder: $builder\n"; 1215} 1216 1217# test if all checksums in the buildinfo file check out 1218if ($builder ne "none") { 1219 print "build artifacts stored in $outdir\n"; 1220 1221 my $checksums = Dpkg::Checksums->new(); 1222 $checksums->add_from_control($cdata); 1223 # remove the .dsc as we only did the binaries 1224 # - the .dsc cannot be reproduced anyways because we cannot reproduce its 1225 # signature 1226 # - binNMUs can only be done with --build=any 1227 foreach my $file ($checksums->get_files()) { 1228 if ($file !~ /\.dsc$/) { 1229 next; 1230 } 1231 $checksums->remove_file($file); 1232 } 1233 1234 my $new_cdata 1235 = Dpkg::Control->new(type => CTRL_FILE_BUILDINFO, allow_pgp => 1); 1236 $new_cdata->load($new_buildinfo); 1237 my $new_checksums = Dpkg::Checksums->new(); 1238 $new_checksums->add_from_control($new_cdata); 1239 1240 my @files = $checksums->get_files(); 1241 my @new_files = $new_checksums->get_files(); 1242 1243 if (scalar @files != scalar @new_files) { 1244 print("old buildinfo:\n" . (join "\n", @files) . "\n"); 1245 print("new buildinfo:\n" . (join "\n", @new_files) . "\n"); 1246 die "new buildinfo contains a different number of files\n"; 1247 } 1248 1249 for (my $i = 0 ; $i <= $#files ; $i++) { 1250 if ($files[$i] ne $new_files[$i]) { 1251 die "different checksum files at position $i\n"; 1252 } 1253 if ($files[$i] =~ /\.dsc$/) { 1254 print("skipping $files[$i]\n"); 1255 next; 1256 } 1257 print("checking $files[$i]: "); 1258 if ($checksums->get_size($files[$i]) 1259 != $new_checksums->get_size($files[$i])) { 1260 die "size differs for $files[$i]\n"; 1261 } else { 1262 print("size... "); 1263 } 1264 my $chksum = $checksums->get_checksum($files[$i], undef); 1265 my $new_chksum = $new_checksums->get_checksum($new_files[$i], undef); 1266 if (scalar keys %{$chksum} != scalar keys %{$new_chksum}) { 1267 die "different algos for $files[$i]\n"; 1268 } 1269 foreach my $algo (keys %{$chksum}) { 1270 if (!exists $new_chksum->{$algo}) { 1271 die "$algo is not used in both buildinfo files\n"; 1272 } 1273 if ($chksum->{$algo} ne $new_chksum->{$algo}) { 1274 die "value of $algo differs for $files[$i]\n"; 1275 } 1276 print("$algo... "); 1277 } 1278 print("all OK\n"); 1279 } 1280} 1281