From c2958fa501424208307c1b8e3dfb3265ca693bea Mon Sep 17 00:00:00 2001
From: Johannes 'josch' Schauer <josch@mister-muffin.de>
Date: Sat, 23 Jul 2016 08:02:01 +0200
Subject: [PATCH] allow custom commands with arbitrary number of
 Packages/Sources files

---
 shrink.pl | 204 +++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 148 insertions(+), 56 deletions(-)

diff --git a/shrink.pl b/shrink.pl
index deba89b..8778c65 100755
--- a/shrink.pl
+++ b/shrink.pl
@@ -29,11 +29,16 @@ use Dpkg::Index;
 use List::Util 'shuffle';
 
 sub check {
-    system 'dose-builddebcheck', '--failures', '--explain', '--quiet', '--deb-native-arch=kfreebsd-i386', 'tmp', 'wanna-build-interesting-sources-sid.kfreebsd-i386';
+    my $wantedexit = shift;
+    print "running: ";
+    print join " ", @_;
+    print "\n";
+    system @_;
     my $exit = $? >> 8;
-    if ($exit == 64) {
+    if ($exit == $wantedexit) {
 	return 1;
     } else {
+	print "got exit $exit but wanted exit $wantedexit\n";
 	return 0;
     }
 }
@@ -41,8 +46,10 @@ sub check {
 sub write_enabled_pkgs {
     my $index = shift;
     my $enabled = shift;
+    my $fname = shift;
+    print "writing to $fname\n";
     # write out all the still enabled packages
-    open(my $fh, '>', 'tmp');
+    open(my $fh, '>', $fname);
     foreach my $k ($index->get_keys()) {
 	if (!$enabled->{$k}) {
 	    next;
@@ -56,8 +63,11 @@ sub randomize_pkgs {
     my $index = shift;
     my $enabled = shift;
     my $id_to_key = shift;
+    my $tmpname = shift;
+    my $wantedexit = shift;
+    my @checkcmd = @_;
     # randomly delete 0.5% of the packages until we failed to produce the
-    # expected result 20 consecutive times
+    # expected result as many times as 1% of the package are.
     my $num_failures = 0;
     while (1) {
 	# fill an array with the remaining enabled indices
@@ -79,8 +89,8 @@ sub randomize_pkgs {
 	for my $i (@to_disable) {
 	    $enabled->{$id_to_key->{$i}} = 0;
 	}
-	write_enabled_pkgs($index, $enabled);
-	if (check()) {
+	write_enabled_pkgs($index, $enabled, $tmpname);
+	if (check($wantedexit, @checkcmd)) {
 	    # the error we want to see is still there so we keep these keys
 	    # disabled and reset the number of failures
 	    $num_failures = 0;
@@ -112,6 +122,9 @@ sub iterate_pkgs {
     my $index = shift;
     my $enabled = shift;
     my $id_to_key = shift;
+    my $tmpname = shift;
+    my $wantedexit = shift;
+    my @checkcmd = @_;
     # we extract the array of enabled indices for better progress reporting
     # later on
     my $numpkgs = scalar keys %{$enabled};
@@ -134,8 +147,8 @@ sub iterate_pkgs {
 	$i += 1;
 	# disable the current key
 	$enabled->{$key} = 0;
-	write_enabled_pkgs($index, $enabled);
-	if (check()) {
+	write_enabled_pkgs($index, $enabled, $tmpname);
+	if (check($wantedexit, @checkcmd)) {
 	    # the error we want to see is still there so we keep this key disabled
 	} else {
 	    # the error vanished
@@ -150,6 +163,9 @@ sub delete_field {
     my $enabled = shift;
     my $id_to_key = shift;
     my $field = shift;
+    my $tmpname = shift;
+    my $wantedexit = shift;
+    my @checkcmd = @_;
     # we extract the array of enabled indices for better progress reporting
     # later on
     my $numpkgs = scalar keys %{$enabled};
@@ -178,8 +194,8 @@ sub delete_field {
 	my $fieldvalue = $pkg->{$field};
 	# disable the current key
 	delete $pkg->{$field};
-	write_enabled_pkgs($index, $enabled);
-	if (check()) {
+	write_enabled_pkgs($index, $enabled, $tmpname);
+	if (check($wantedexit, @checkcmd)) {
 	    # the error we want to see is still there so we keep this field deleted
 	} else {
 	    # the error vanished
@@ -190,59 +206,135 @@ sub delete_field {
 }
 
 sub main {
-    my $desc = $ARGV[0];
-    if (not defined($desc)) {
-	die "need a Packages file";
+    my @srcbinlisttype = ();
+
+    # first argument is the desired exit code
+    my $wantedexit = shift @ARGV;
+
+    # the following argument are paths to Packages/Sources files
+    # to find out how many of those we expect, we scan the rest of ARGV for
+    # the placeholders
+    foreach my $arg (@ARGV) {
+	if ($arg eq '__src__') {
+	    push @srcbinlisttype, "src";
+	}
+	if ($arg eq '__bin__') {
+	    push @srcbinlisttype, "bin";
+	}
     }
-
-    my $key_func = sub {
-	return $_[0]->{Package} . ' ' . $_[0]->{Version} . ' ' . $_[0]->{Architecture};
-    };
-
-    my $index = Dpkg::Index->new(get_key_func=>$key_func);
-
-    $index->load($desc);
-    my %allowed_fields = (
-	'Version' => 1,
-	'Package' => 1,
-	'Architecture' => 1,
-	'Depends' => 1,
-	# 'Multi-Arch' => 1, # not needed with only one architecture
-	'Provides' => 1,
-	'Breaks' => 1,
-	'Conflicts' => 1,
-	'Pre-Depends' => 1,
-	# 'Essential' => 1, # probably not needed
-    );
-
-    my %enabled = ();
-    my %id_to_key = ();
-    {
-	my $i = 0;
-	foreach my $key ($index->get_keys()) {
-	    $enabled{$key} = 1;
-	    $id_to_key{$i} = $key;
+    # now we now which parts are the actual input file names
+    my @srcbinlistcontent = splice @ARGV, 0, (scalar @srcbinlisttype);
+    # the rest is the command to execute
+    my @execcmd = @ARGV;
+    my $i = 0;
+    my @tmpfiles = ();
+    foreach my $val (@execcmd) {
+	if ($val eq '__src__') {
+	    $val = "src.$i.tmp";
+	    push @tmpfiles, $val;
+	    $i += 1;
+	}
+	if ($val eq '__bin__') {
+	    $val = "bin.$i.tmp";
+	    push @tmpfiles, $val;
 	    $i += 1;
-	    # delete unnecessary fields
-	    my $cdata = $index->get_by_key($key);
-	    foreach my $field (keys %{$cdata}) {
-		if (! exists $allowed_fields{$field}) {
-		    delete $cdata->{$field};
-		}
-	    }
 	}
     }
 
-    randomize_pkgs($index, \%enabled, \%id_to_key);
-    iterate_pkgs($index, \%enabled, \%id_to_key);
-    delete_field($index, \%enabled, \%id_to_key, 'Depends');
-    delete_field($index, \%enabled, \%id_to_key, 'Pre-Depends');
-    delete_field($index, \%enabled, \%id_to_key, 'Conflicts');
-    delete_field($index, \%enabled, \%id_to_key, 'Breaks');
-    delete_field($index, \%enabled, \%id_to_key, 'Provides');
+    my @data = ();
+    foreach( 0 .. $#srcbinlistcontent ) {
+	my $f = $srcbinlistcontent[$_];
+	my $t = $srcbinlisttype[$_];
+	my $r = $tmpfiles[$_];
+
+	print "reading in $f\n";
+
+	my $key_func = sub {
+	    return $_[0]->{Package} . ' ' . $_[0]->{Version} . ' ' . $_[0]->{Architecture};
+	};
+
+	my $index = Dpkg::Index->new(get_key_func=>$key_func);
+
+	$index->load($f);
+	my %allowed_fields = (
+	    'Version' => 1,
+	    'Package' => 1,
+	    'Architecture' => 1,
+	);
+	if ($t eq "bin") {
+	    $allowed_fields{'Depends'} = 1;
+	    # 'Multi-Arch' => 1, # not needed with only one architecture
+	    $allowed_fields{'Provides'} = 1;
+	    $allowed_fields{'Breaks'} = 1;
+	    $allowed_fields{'Conflicts'} = 1;
+	    $allowed_fields{'Pre-Depends'} = 1;
+	    $allowed_fields{'Source'} = 1;
+	    $allowed_fields{'Essential'} = 1; # probably not needed
+	} else {
+	    $allowed_fields{'Build-Depends'} = 1;
+	    $allowed_fields{'Build-Depends-Arch'} = 1;
+	    $allowed_fields{'Build-Depends-Indep'} = 1;
+	    $allowed_fields{'Build-Conflicts'} = 1;
+	    $allowed_fields{'Build-Conflicts-Arch'} = 1;
+	    $allowed_fields{'Build-Conflicts-Indep'} = 1;
+	}
+
+	my %enabled = ();
+	my %id_to_key = ();
+	{
+	    my $i = 0;
+	    foreach my $key ($index->get_keys()) {
+		$enabled{$key} = 1;
+		$id_to_key{$i} = $key;
+		$i += 1;
+		# delete unnecessary fields
+		my $cdata = $index->get_by_key($key);
+		foreach my $field (keys %{$cdata}) {
+		    if (! exists $allowed_fields{$field}) {
+			delete $cdata->{$field};
+		    }
+		}
+	    }
+	}
+
+	write_enabled_pkgs($index, \%enabled, $r);
+
+	push @data, [$r, $t, $index, \%enabled, \%id_to_key];
+    }
+
+    foreach my $v (@data) {
+	my ($tmpname, $t, $index, $enabled, $id_to_key) = @{$v};
+	randomize_pkgs($index, $enabled, $id_to_key, $tmpname, $wantedexit, @execcmd);
+    }
+    foreach my $v (@data) {
+	my ($tmpname, $t, $index, $enabled, $id_to_key) = @{$v};
+	iterate_pkgs($index, $enabled, $id_to_key, $tmpname, $wantedexit, @execcmd);
+    }
+
+    foreach my $v (@data) {
+	my ($tmpname, $t, $index, $enabled, $id_to_key) = @{$v};
+	if ($t eq "bin") {
+	    delete_field($index, $enabled, $id_to_key, 'Depends', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Pre-Depends', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Conflicts', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Breaks', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Provides', $tmpname, $wantedexit, @execcmd);
+	} else {
+	    delete_field($index, $enabled, $id_to_key, 'Build-Depends', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Build-Depends-Indep', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Build-Depends-Arch', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Build-Conflicts', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Build-Conflicts-Indep', $tmpname, $wantedexit, @execcmd);
+	    delete_field($index, $enabled, $id_to_key, 'Build-Conflicts-Arch', $tmpname, $wantedexit, @execcmd);
+	}
+    }
+
     # somehow, calling randomize_pkgs might remove build-essential
     #randomize_pkgs($index, \%enabled, \%id_to_key);
-    iterate_pkgs($index, \%enabled, \%id_to_key);
+    foreach my $v (@data) {
+	my ($tmpname, $t, $index, $enabled, $id_to_key) = @{$v};
+	iterate_pkgs($index, $enabled, $id_to_key, $tmpname, $wantedexit, @execcmd);
+    }
 }
 
 main();