debian-cd-clone/tools/generate_di_list

#!/usr/bin/perl
# Generate a list of packages required for debian-installer
# This script makes use of the following variables that need to be preset:
# MIRROR, DI_CODENAME, BASEDIR

use strict;
use warnings;

die "Missing \$MIRROR variable" unless $ENV{MIRROR};
die "Missing \$DI_CODENAME variable" unless $ENV{DI_CODENAME};
die "Missing \$BASEDIR variable" unless $ENV{BASEDIR};
die "Missing \$ARCHES variable" unless $ENV{ARCHES};

my $catz = $ENV{BASEDIR} . "/tools/catz";

# Early exit if we're building a source-only CD
exit 0 if $ENV{ARCHES} =~ /^\s*source\s*$/;

my @ARCHES;
if ( $ENV{ARCHES} ) {
    push @ARCHES, 'i386' if $ENV{ARCHES} =~ /(^|\s)i386(\s|$)/;
    push @ARCHES, 'amd64' if $ENV{ARCHES} =~ /(^|\s)amd64(\s|$)/;
    push @ARCHES, grep { !/^(source|i386|amd64)$/ } split /\s+/, $ENV{ARCHES};
}
@ARCHES = qw{i386 amd64} unless @ARCHES;

my @VARIANTS;
if ( $ENV{VARIANTS} ) {
    @VARIANTS = split(" ", $ENV{VARIANTS});
}

my $DATE=`date`;
chomp $DATE;
open(OUT, ">debian-installer") || die "write: $!";
print OUT << "EOF";
/* List of udebs to be included so that debian-installer works fine 
 *
 * This list can be generated with the command:
 * ../tools/generate_di_list
 *
 * DO NOT EDIT THIS FILE, edit the above script
 *
 * Last update: $DATE
 */
EOF

sub di_ker_abi_to_number ($$$$) {
    # Make up a version we can compare sensibly from
    # the version and ABI
    my $maj = shift;
    my $min = shift;
    my $patch = shift;
    my $abi = shift;
    my $kernel_ver = ($maj * 1000000000)
	+ ($min * 1000000)
	+ ($patch * 1000)
	+ $abi;
    return $kernel_ver;
}

sub number_to_di_ker_abi ($) {
    # Convert back to a useful string
    my $num = shift;
    my $maj = int($num / 1000000000);
    $num -= ($maj * 1000000000);
    my $min = int($num / 1000000);
    $num -= ($min * 1000000);
    my $patch = int($num / 1000);
    $num -= ($patch * 1000);
    my $abi = $num;
    return "$maj.$min.$patch-$abi";
}

my @common_excludes = read_exclude("exclude-udebs");
my $mirror_path = "$ENV{MIRROR}/dists/$ENV{DI_CODENAME}";
my @components = qw(main);
push @components, 'contrib' if $ENV{CONTRIB};
push @components, 'non-free' if $ENV{NONFREE};
push @components, 'unreleased' if $ENV{UNRELEASED};
push @components, 'local' if $ENV{LOCAL};

foreach my $arch (@ARCHES) {
	(my $cpparch = $arch) =~ s/-/_/g;
    my $output = '';
    for my $component ( @components ) {
        my $pgz="$mirror_path/$component/debian-installer/binary-$arch/Packages.gz";
        my $pxz="$mirror_path/$component/debian-installer/binary-$arch/Packages.xz";
        if ( $component eq 'unreleased' and $ENV{UNRELEASED} ) {
            $pgz="$ENV{MIRROR}/dists/unreleased/main/debian-installer/binary-$arch/Packages.gz";
            $pxz="$ENV{MIRROR}/dists/unreleased/main/debian-installer/binary-$arch/Packages.xz";
        }
        if ( $component eq 'local' and $ENV{LOCALDEBS} ) {
            $pgz="$ENV{LOCALDEBS}/dists/$ENV{DI_CODENAME}/local/debian-installer/binary-$arch/Packages.gz";
            $pxz="$ENV{LOCALDEBS}/dists/$ENV{DI_CODENAME}/local/debian-installer/binary-$arch/Packages.xz";
        }

        my @exclude = @common_excludes;
        push @exclude, read_exclude("exclude-udebs-$arch")
            if -e exclude_path("exclude-udebs-$arch");

	my $pz = $pgz;
	if (! -f $pz) {
	    $pz = $pxz;
	}
	if (! -f $pz) {
            print "Missing package file for $arch/$component.\n";
            next;
	}

	# Two passes here
	# First, need to find the highest kernel ABI in the archive
	# Next, list all the udebs that:
	#   1. are not otherwise excluded
	#   2. are not kernel driver udebs, OR
	#      are kernel driver udebs with the right kernel ABI

	unless ( open (PZ, "$catz $pz |") ) {
	    warn "failed to read package file $pz: $1";
	    next;
	}

	my @output_udebs;
	my %driver_udebs;
	my $highest_kernel_ver = 0;

	while (defined (my $line = <PZ>)) {
	    chomp $line;
	    if ($line =~ m/^Package: (\S+)/) {
		my $udeb = $1;
		if (grep { $udeb =~ /^${_}$/ } @exclude) {
		    next;
		}
		if ($udeb =~ m/-modules-([0-9]*)\.([0-9]*)\.([0-9]*)-(\d+)-.*-di/) {
		    my $kernel_ver = di_ker_abi_to_number($1, $2, $3, $4);
		    if ($kernel_ver > $highest_kernel_ver) {
			$highest_kernel_ver = $kernel_ver;
		    }
		    # Append this driver udeb to a list for that kernel_ver
		    push(@{ $driver_udebs{$kernel_ver} }, $udeb);
		} else {
		    #print "found non-driver udeb $udeb\n";
		    push @output_udebs, $udeb;
		}
	    }
	}
	close PZ;
	$output .= "/* First, generic udebs */\n";
	foreach my $udeb (@output_udebs) {
	    $output .= "$udeb\n";
	}
	my $num_this_abi = scalar (@{ $driver_udebs{$highest_kernel_ver}});
	$output .= "/* Next: $num_this_abi udebs for kernel/ABI version ";
	$output .= number_to_di_ker_abi($highest_kernel_ver);
	$output .= " */\n";
	foreach my $udeb (@{ $driver_udebs{$highest_kernel_ver}}) {
	    $output .= "$udeb\n";
	}
	foreach my $key (keys (%driver_udebs)) {
	    if ($key != $highest_kernel_ver) {
		$num_this_abi = scalar (@{ $driver_udebs{$key}});
		$output .= "/* IGNORING $num_this_abi udebs for kernel/ABI version ";
		$output .= number_to_di_ker_abi($key);
		$output .= " */\n";
	    }
	}
    }

    next unless $output;
    print OUT "#ifdef ARCH_$cpparch\n";
    print OUT $output;
    print OUT "#endif /* ARCH_$cpparch */\n";
}

sub read_exclude {
	my $file=exclude_path(shift);
    unless ( open (IN, "<$file") ) {
       warn "failed to read exclude file $file";
       return;
    }
	my @ret;
	while (<IN>) {
		chomp;
		s/^#.*//;
		next unless length;
		my ($pkg,@cond) = split(" ", $_);
		my $skip = 0;
		foreach my $cond ( @cond ) {
		    if ($cond =~ /^!(.*)/) {
			$skip = 1 if grep { $_ eq $1 } @VARIANTS;
		    } else {
			$skip = 1 unless grep { $_ eq $cond } @VARIANTS;
		    }
		}
		next if $skip;
		$pkg=quotemeta($pkg);
		$pkg=~s/\\\*/.*/g;
		push @ret, $pkg;
	}
	close IN;
	return @ret;
}

sub exclude_path {
	my $file=shift;
	return "$ENV{BASEDIR}/data/$ENV{DI_CODENAME}/$file";
}