[Reproducible-commits] [sbuild] 01/02: srebuild: lots of improvements after review by Guillem Jover - thanks!
Johannes Schauer
josch-guest at moszumanska.debian.org
Sat Jan 3 08:04:41 UTC 2015
This is an automated email from the git hooks/post-receive script.
josch-guest pushed a commit to branch pu/reproducible_builds
in repository sbuild.
commit d4a82cbd3c4fbb09ecbeeffd3d4e6c2ea050e933
Author: josch <j.schauer at email.de>
Date: Sat Jan 3 07:41:46 2015 +0100
srebuild: lots of improvements after review by Guillem Jover - thanks!
- do not evaluate content of $@ after eval because it's fragile and
locale dependent
- use CTRL_FILE_CHANGES for parsing .buildinfo
- use ->load instead of ->parse which avoids manually creating a
Dpkg::Compression::FileHandle
- use Dpkg::Checksums which avoids manual parsing of Checksums-* fields
- use [-1] to get last element of array
- use CTRL_INDEX_PKG to parse Packages.gz
- use none which is now part of List::Util
---
bin/srebuild | 132 ++++++++++++++++++++++++++++-------------------------------
1 file changed, 63 insertions(+), 69 deletions(-)
diff --git a/bin/srebuild b/bin/srebuild
index 1d2172b..598093d 100755
--- a/bin/srebuild
+++ b/bin/srebuild
@@ -18,10 +18,14 @@ use warnings;
use Dpkg::Control;
use Dpkg::Compression::FileHandle;
use Dpkg::Deps;
+use Dpkg::Index;
+use Dpkg::Checksums;
use DateTime::Format::Strptime;
use Compress::Zlib;
use File::Basename;
use Digest::SHA qw(sha256_hex);
+use List::Util qw(first);
+use Cwd qw/abs_path/;
eval {
require LWP::Simple;
@@ -30,22 +34,14 @@ eval {
$LWP::Simple::ua = LWP::UserAgent->new(agent => 'LWP::UserAgent/srebuild');
};
if ($@) {
- if ($@ =~ m/Can\'t locate LWP/) {
- die "Unable to run: the libwww-perl package is not installed";
- } else {
- die "Unable to run: Couldn't load LWP::Simple: $@";
- }
+ die "Unable to run: Couldn't load LWP::Simple: $@ (is the libwww-perl package installed?)";
}
eval {
require JSON;
};
if ($@) {
- if ($@ =~ m/Can\'t locate JSON/) {
- die "Unable to run: the libjson-perl package is not installed";
- } else {
- die "Unable to run: Couldn't load JSON: $@";
- }
+ die "Unable to run: Couldn't load JSON: $@ (is the libjson-perl package installed?)";
}
# this subroutine is from debsnap(1)
@@ -59,32 +55,53 @@ sub fetch_json_page
return $json_text;
}
+sub check_checksums
+{
+ my $checksums = shift;
+
+ foreach my $fname ($checksums->get_files ()) {
+ my $chksum = $checksums->get_checksum ($fname, 'sha256');
+ my $size = $checksums->get_size ($fname);
+ my $size2 = (stat($fname))[7];
+ if ($size != $size2) {
+ print "buildinfo: $size\n";
+ print "actual: $size2\n";
+ die "size mismatch for $fname\n"
+ }
+ open my $fh, '<', $fname;
+ my $chksum2 = sha256_hex <$fh>;
+ close $fh;
+ if ($chksum ne $chksum2) {
+ print "buildinfo: $chksum\n";
+ print "actual: $chksum2\n";
+ die "checksum mismatch for $fname\n";
+ }
+ }
+}
+
sub parse_buildinfo {
my $buildinfo = shift;
- my $fh = Dpkg::Compression::FileHandle->new(filename => $buildinfo);
+ # the CTRL_FILE_CHANGES type should be closest to the .buildinfo format
+ my $cdata = Dpkg::Control->new(type => CTRL_FILE_CHANGES);
- my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
- if (not $cdata->parse($fh, $buildinfo)) {
+ if (not $cdata->load($buildinfo)) {
die "cannot parse"
}
my $arch = $cdata->{"Build-Architecture"};
if (not defined($arch)) {
die "need Build-Architecture field";
}
- my $checksums = $cdata->{"Checksums-Sha256"};
- if (not defined($checksums)) {
- die "need Checksums-Sha256 field";
- }
my $environ = $cdata->{"Build-Environment"};
if (not defined($environ)) {
die "need Build-Environment field";
}
- close $fh;
- # remove newline from start and end
- $checksums =~ s{^\Q$/\E}{};
- $checksums = [ map { [ split /\s+/ ] } ( split /\s*\n\s*/, $checksums ) ];
+ my $checksums = Dpkg::Checksums->new();
+ $checksums->add_from_control($cdata);
+ if (scalar $checksums->get_files() == 0) {
+ die "need Checksums-* field";
+ }
my @environ = ();
foreach my $dep (split(/\s*,\s*/m, $environ)) {
@@ -132,32 +149,9 @@ my ($arch, $checksums, @environ) = parse_buildinfo $buildinfo;
print STDERR "check original checksums\n";
-my $dsc_fname;
-
-foreach my $sum (@{$checksums}) {
- my ($chksum, $size, $fname) = @{$sum};
- my $size2 = (stat($fname))[7];
- if ($size != $size2) {
- print "$size\n";
- print "$size2\n";
- die "size mismatch for $fname\n"
- }
- open my $fh, '<', $fname;
- my $chksum2 = sha256_hex <$fh>;
- if ($chksum ne $chksum2) {
- print "$chksum\n";
- print "$chksum2\n";
- die "checksum mismatch for $fname\n";
- }
- close $fh;
- if ($fname =~ /.dsc/) {
- if (defined($dsc_fname)) {
- die "more than one dsc\n";
- }
- $dsc_fname = $fname;
- }
-}
+check_checksums $checksums;
+my $dsc_fname = first { /.dsc$/ } ($checksums->get_files ());
if (not defined($dsc_fname)) {
die "no dsc found\n";
}
@@ -199,12 +193,13 @@ foreach my $pkg (@environ) {
# @timestamps = sort { DateTime->compare($a, $b) } @timestamps;
@timestamps = sort @timestamps;
-my $newest = $timestamps[$#timestamps];
+# get the last element, i.e. the most recent timestamp
+my $newest = $timestamps[-1];
$newest = $newest->strftime("%Y%m%dT%H%M%SZ");
my $snapshot_url = "http://snapshot.debian.org/archive/$archive/$newest/dists/$suite/$area/binary-$arch/Packages.gz";
-print STDERR "download Packages.gz\n";
+print STDERR "download Packages.gz for timestamp $newest\n";
my $response = LWP::Simple::get($snapshot_url);
@@ -216,7 +211,7 @@ print STDERR "process Packages.gz\n";
open my $fh, '<', \$dest;
while (1) {
- my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
+ my $cdata = Dpkg::Control->new(type => CTRL_INDEX_PKG);
last if not $cdata->parse($fh, "Packages.gz");
my $pkgname = $cdata->{"Package"};
next if not defined($pkgname);
@@ -232,40 +227,39 @@ while (1) {
delete $reqpkgs{$key};
}
}
+close $fh;
-if (scalar (keys %reqpkgs) != 0) {
- die "some of the requested packages are not part of this snapshot";
+my @notfound = keys %reqpkgs;
+if (scalar @notfound != 0) {
+ die "some of the requested packages are not part of this snapshot: ".(join ", ", @notfound);
}
print "architecture = $arch\n";
print "mirror = http://snapshot.debian.org/archive/$archive/$newest/\n";
my $bn_buildinfo = basename $buildinfo;
+# calculate absolute path because sbuild changes directories and the user
+# should not be required to specify the absolute path on the command line
+$buildinfo = abs_path($buildinfo);
+
+print "starting sbuild with timestamp $newest\n";
my $retval = system "sbuild", "--arch=$arch", "--dist=wheezy",
"--pre-build-command=cp /usr/share/sbuild/srebuild-hook $buildinfo %SBUILD_CHROOT_DIR/tmp",
"--chroot-setup-command=/tmp/srebuild-hook chroot-setup /tmp/$bn_buildinfo $newest",
"--starting-build-commands=/tmp/srebuild-hook starting-build /tmp/$bn_buildinfo",
$dsc_fname;
+
+print "sbuild finished with timestamp $newest\n";
+
$retval >>= 8;
if ($retval != 0) {
- die "failed";
+ die "sbuild failed: $retval";
}
-foreach my $sum (@{$checksums}) {
- my ($chksum, $size, $fname) = @{$sum};
- my $size2 = (stat($fname))[7];
- if ($size != $size2) {
- print "$size\n";
- print "$size2\n";
- die "size mismatch for $fname\n"
- }
- open my $fh, '<', $fname;
- my $chksum2 = sha256_hex <$fh>;
- if ($chksum ne $chksum2) {
- print "$chksum\n";
- print "$chksum2\n";
- die "checksum mismatch for $fname\n";
- }
- close $fh;
-}
+
+print "check new checksums\n";
+
+check_checksums $checksums;
+
+print "everything is okay!\n";
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/reproducible/sbuild.git
More information about the Reproducible-commits
mailing list