[Reproducible-commits] [sbuild] 02/02: Add first proof-of-concept for srebuild
Johannes Schauer
josch-guest at moszumanska.debian.org
Thu Jan 1 21:42:18 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 b926810c8d9a1111897c33aca43f0e782ca71979
Author: josch <j.schauer at email.de>
Date: Thu Jan 1 22:41:21 2015 +0100
Add first proof-of-concept for srebuild
- limited to working on Debian sid, main
- limited to a single snapshot timestamp
---
bin/srebuild | 271 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
bin/srebuild-hook | 153 ++++++++++++++++++++++++++++++
2 files changed, 424 insertions(+)
diff --git a/bin/srebuild b/bin/srebuild
new file mode 100755
index 0000000..fb41c1f
--- /dev/null
+++ b/bin/srebuild
@@ -0,0 +1,271 @@
+#!/usr/bin/perl
+#
+# Copyright 2014 Johannes Schauer
+#
+# 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 Dpkg::Control;
+use Dpkg::Compression::FileHandle;
+use Dpkg::Deps;
+use DateTime::Format::Strptime;
+use Compress::Zlib;
+use File::Basename;
+use Digest::SHA qw(sha256_hex);
+
+eval {
+ require LWP::Simple;
+ require LWP::UserAgent;
+ no warnings;
+ $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: $@";
+ }
+}
+
+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: $@";
+ }
+}
+
+# this subroutine is from debsnap(1)
+sub fetch_json_page
+{
+ my ($json_url) = @_;
+ my $content = LWP::Simple::get($json_url);
+ return unless defined $content;
+ my $json = JSON->new();
+ my $json_text = $json->allow_nonref->utf8->relaxed->decode($content);
+ return $json_text;
+}
+
+sub parse_buildinfo {
+ my $buildinfo = shift;
+
+ my $fh = Dpkg::Compression::FileHandle->new(filename => $buildinfo);
+
+ my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
+ if (not $cdata->parse($fh, $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 @environ = ();
+ foreach my $dep (split(/\s*,\s*/m, $environ)) {
+ my $pkg = Dpkg::Deps::Simple->new($dep);
+ if (not defined($pkg->{package})) {
+ die "name undefined";
+ }
+ if (defined($pkg->{relation})) {
+ if ($pkg->{relation} ne "=") {
+ die "wrong relation";
+ }
+ if (not defined($pkg->{version})) {
+ die "version undefined"
+ }
+ } else {
+ die "no version";
+ }
+ push @environ, { name => $pkg->{package},
+ architecture => ( $pkg->{archqual} || $arch ),
+ version => $pkg->{version}
+ };
+ }
+
+ return $arch, $checksums, @environ
+}
+
+my $archive = "debian";
+my $suite = "sid";
+my $area = "main";
+
+my %reqpkgs = ();
+my @timestamps = ();
+
+my $dtparser = DateTime::Format::Strptime->new(
+ pattern => '%Y%m%dT%H%M%SZ',
+ on_error => 'croak',
+);
+
+my $buildinfo = shift @ARGV;
+if (not defined($buildinfo)) {
+ die "need buildinfo filename";
+}
+
+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;
+ }
+}
+
+if (not defined($dsc_fname)) {
+ die "no dsc found\n";
+}
+
+print STDERR "retrieve last seen snapshot timestamps\n";
+
+foreach my $pkg (@environ) {
+ $reqpkgs{"$pkg->{name}:$pkg->{architecture}=$pkg->{version}"} = 1;
+ my $url = "http://snapshot.debian.org/mr/binary/$pkg->{name}/$pkg->{version}/binfiles?fileinfo=1";
+ my $json_text = fetch_json_page($url);
+ unless ($json_text && @{$json_text->{result}}) {
+ die "Unable to retrieve information for $pkg->{name} from $url.\n";
+ }
+ my $hash = undef;
+ if (scalar @{$json_text->{result}} == 1) {
+ if (@{$json_text->{result}}[0]->{architecture} ne "all") {
+ die "expected arch:all\n";
+ }
+ $hash = ${$json_text->{result}}[0]->{hash};
+ } else {
+ foreach my $result (@{$json_text->{result}}) {
+ if ($result->{architecture} eq $arch) {
+ $hash = $result->{hash};
+ last;
+ }
+ }
+ }
+ if (not defined($hash)) {
+ die "cannot find architecture for $pkg->{name}\n";
+ }
+ my @first_seen = grep { $_->{archive_name} eq $archive } @{$json_text->{fileinfo}->{$hash}};
+ if (scalar @first_seen != 1) {
+ die "more than one package with the same hash\n";
+ }
+ @first_seen = map { $_->{first_seen} } @first_seen;
+ push @timestamps, $dtparser->parse_datetime($first_seen[0]);
+}
+
+# @timestamps = sort { DateTime->compare($a, $b) } @timestamps;
+ at timestamps = sort @timestamps;
+
+my $newest = $timestamps[$#timestamps];
+$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";
+
+my $response = LWP::Simple::get($snapshot_url);
+
+my $dest = Compress::Zlib::memGunzip($response)
+ or die "Cannot uncompress\n";
+
+print STDERR "process Packages.gz\n";
+
+open my $fh, '<', \$dest;
+
+while (1) {
+ my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
+ last if not $cdata->parse($fh, "Packages.gz");
+ my $pkgname = $cdata->{"Package"};
+ next if not defined($pkgname);
+ my $pkgver = $cdata->{"Version"};
+ my $pkgarch;
+ if ($cdata->{"Architecture"} eq "all") {
+ $pkgarch = $arch;
+ } else {
+ $pkgarch = $cdata->{"Architecture"};
+ }
+ my $key = "$pkgname:$pkgarch=$pkgver";
+ if (exists $reqpkgs{$key}) {
+ delete $reqpkgs{$key};
+ }
+}
+
+if (scalar (keys %reqpkgs) != 0) {
+ die "some of the requested packages are not part of this snapshot";
+}
+
+print "architecture = $arch\n";
+print "mirror = http://snapshot.debian.org/archive/$archive/$newest/\n";
+
+my $bn_buildinfo = basename $buildinfo;
+
+my $retval = system "sbuild", "--arch=$arch", "--dist=wheezy",
+ "--pre-build-command=cp /home/josch/sbuild/bin/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;
+$retval >>= 8;
+if ($retval != 0) {
+ die "failed";
+}
+
+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;
+}
diff --git a/bin/srebuild-hook b/bin/srebuild-hook
new file mode 100755
index 0000000..056e445
--- /dev/null
+++ b/bin/srebuild-hook
@@ -0,0 +1,153 @@
+#!/usr/bin/perl
+#
+# Copyright 2014 Johannes Schauer
+#
+# 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 Dpkg::Control;
+use Dpkg::Compression::FileHandle;
+use Dpkg::Deps;
+
+sub none(&@) {
+ my $code = shift;
+ foreach (@_) {
+ return 0 if $code->();
+ }
+ return 1;
+}
+
+sub system_fatal {
+ my @args = @_;
+ print "srebuild: executing: @args\n";
+ my $retval = system @args;
+ $retval >>= 8;
+ if ($retval != 0) {
+ die "failed: @args";
+ }
+}
+
+sub parse_buildinfo {
+ my $buildinfo = shift;
+
+ my $fh = Dpkg::Compression::FileHandle->new(filename => $buildinfo);
+
+ my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
+ if (not $cdata->parse($fh, $buildinfo)) {
+ die "cannot parse"
+ }
+ my $arch = $cdata->{"Build-Architecture"};
+ if (not defined($arch)) {
+ die "need Build-Architecture field"
+ }
+ my $environ = $cdata->{"Build-Environment"};
+ if (not defined($environ)) {
+ die "need Build-Environment field"
+ }
+ close $fh;
+
+ my @environ = ();
+ foreach my $dep (split(/\s*,\s*/m, $environ)) {
+ my $pkg = Dpkg::Deps::Simple->new($dep);
+ if (not defined($pkg->{package})) {
+ die "name undefined";
+ }
+ if (defined($pkg->{relation})) {
+ if ($pkg->{relation} ne "=") {
+ die "wrong relation";
+ }
+ if (not defined($pkg->{version})) {
+ die "version undefined"
+ }
+ } else {
+ die "no version";
+ }
+ push @environ, { name => $pkg->{package},
+ architecture => ( $pkg->{archqual} || $arch ),
+ version => $pkg->{version}
+ };
+ }
+
+ return $arch, @environ
+}
+
+sub chroot_setup {
+ my $buildinfo = shift;
+ my @timestamps = @_;
+
+ my ($arch, @environ) = parse_buildinfo $buildinfo;
+
+ @environ = map { "$_->{name}:$_->{architecture}=$_->{version}" } @environ;
+
+ my $fh;
+ open $fh, '>', '/etc/apt/apt.conf.d/80no-check-valid-until';
+ print $fh 'Acquire::Check-Valid-Until "false";';
+ close $fh;
+
+ open $fh, '>', '/etc/apt/apt.conf.d/99no-install-recommends';
+ print $fh 'APT::Install-Recommends "0";';
+ close $fh;
+
+ open $fh, '>', '/etc/apt/sources.list';
+ foreach my $timestamp (@timestamps) {
+ print $fh "deb http://snapshot.debian.org/archive/debian/$timestamp/ sid main\n";
+ }
+ close $fh;
+
+ system_fatal "apt-get", "update";
+
+ system_fatal "apt-get", "--yes", "--force-yes", "install", @environ;
+}
+
+sub starting_build {
+ my $buildinfo = shift;
+
+ my ($arch, @environ) = parse_buildinfo $buildinfo;
+
+ @environ = map { "$_->{name}:$_->{architecture}=$_->{version}" } @environ;
+
+ open my $fh, '-|', 'dpkg-query --show --showformat \'${Package}:${Architecture}=${Version}\n\'';
+ my @installed = ();
+ while (my $line = <$fh>) {
+ chomp $line;
+ # make arch:all packages build-arch packages
+ $line =~ s/:all=/:$arch=/;
+ push @installed, $line;
+ }
+
+ foreach my $dep (@environ) {
+ if (none {$_ eq $dep} @installed) {
+ die "require $dep to be installed but it is not";
+ }
+ }
+ print "srebuild: all packages are in the correct version\n"
+}
+
+my $mode = shift @ARGV;
+my $buildinfo = shift @ARGV;
+if (not defined($buildinfo)) {
+ die "need buildinfo filename";
+}
+
+if ($mode eq "chroot-setup") {
+ my @timestamps = @ARGV;
+ if (scalar @timestamps == 0) {
+ die "need timestamp";
+ }
+
+ chroot_setup $buildinfo, @timestamps;
+} elsif ($mode eq "starting-build") {
+ starting_build $buildinfo;
+} else {
+ die "invalid mode: $mode";
+}
--
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