tails/auto/scripts/generate-build-manifest

#!/usr/bin/perl
# © 2015 Cyril Brulebois <cyril@debamax.com>, for the Tails project.
# © 2016 Tails developers <tails@boum.org>

use strict;
use warnings;
use File::Slurp;
use List::MoreUtils qw(uniq);
use YAML::XS;


# NOTE: For reference, the first one is generated by debootstrap
# (>= 1.0.73), while the other two are generated by the apt-get
# wrapper installed in the chroot during the build.
my %package_type = qw(
    deburis binary
    binuris binary
    srcuris source
);

### Various usability checks:
sub usage {
    die "Usage: $0 debootstrap-dir manifest-file";
}

my $debootstrap = shift @ARGV
    or usage;
my $manifest = shift @ARGV
    or usage;

if (! -d $debootstrap) {
    print "E: $debootstrap isn't a directory\n";
    usage;
}

if (-f "$debootstrap/unknown") {
    print "E: actions unsupported by the apt-get wrapper were logged ",
          "in $debootstrap/unknown. Aborting.";
    exit 1;
}

my $extra_packages_file = 'config/build-manifest-extra-packages.yml';
my $extra_packages;

if (-e $extra_packages_file) {
    my $yaml = read_file($extra_packages_file);
    my $extra_packages_data = Load $yaml
        or die "E: failed to load $extra_packages_file: $!";
    $extra_packages = $extra_packages_data->{packages};
}

### Read (package, version, uri) tuples and generate a single (package, version) list:
my $data;
foreach my $type (keys %package_type) {
    my $path = "$debootstrap/$type";
    if (! -f $path ) {
        print "E: $path is missing, wrong debootstrap-dir parameter? (got: $debootstrap)\n";
        usage;
    }
    print "I: processing $path\n";
    foreach my $line (read_file($path)) {
        chomp $line;
        my ($package, $version, $uri) = split / /, $line;
        # Store package_version_arch to ease sort+uniq for deduplication:
        my $arch = 'source';
        if ($package_type{$type} eq 'binary') {
            if ($uri =~ /_([^_]+)\.deb$/) {
                $arch = $1;
            }
            else {
                die "unable to determine architecture for uri=$uri";
            }
        }
        push @{ $data->{ packages_tmp }->{ $package_type{$type} } }, "${package}_${version}_${arch}";
    }

    # Add extra packages
    if ($extra_packages->{$package_type{$type}}) {
        foreach my $pkginfo (@{ $extra_packages->{$package_type{$type}} }) {
            my $package = $pkginfo->{package};
            my $version = $pkginfo->{version};
            my $arch    = $package_type{$type} eq 'binary'
                          ? $pkginfo->{arch}
                          : 'source';
            push @{ $data->{ packages_tmp }->{ $package_type{$type} } },
                "${package}_${version}_${arch}";
        }
    }
}

### Extract list of (origin, reference) from the build configuration
### (the resolved serials, stored under tmp by "apt-snapshots-serials prepare-build"):
my %origin_reference;
while (my $origin_dir = glob('tmp/APT_snapshots.d/*')) {
    my $origin_name = $origin_dir;
    $origin_name =~ s{\A tmp/APT_snapshots[.]d/}{}xms;
    $origin_reference{$origin_name} = read_file("$origin_dir/serial");
    chomp $origin_reference{$origin_name};
    $data->{origin_references}->{ $origin_name }->{reference} = $origin_reference{ $origin_name } || 'unknown';
}

### Deduplicate:
foreach my $type (uniq values %package_type) {
    foreach my $entry (uniq sort @{ $data->{ packages_tmp }->{ $type } }) {
        if ($entry =~ m{^(.+)_(.+)_(.+)$}) {
            my ($package, $version, $arch) = ($1, $2, $3);
            my $item = { package => $package, version => $version, arch => $arch, };
            # Reduce clutter:
            delete $item->{arch}
                if $type eq 'source';
            push @{ $data->{ packages }->{ $type } }, $item;
        }
    }
}
delete $data->{ packages_tmp };

my $yaml = Dump $data;
write_file($manifest, $yaml);