josch/deb-shrink-packages
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

allow custom commands with arbitrary number of Packages/Sources files

Browse source
This commit is contained in:
Johannes 'josch' Schauer 2016-07-23 08:02:01 +02:00
parent 197995a019
commit c2958fa501
1 changed files with 148 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

204
shrink.pl
View file

@ -29,11 +29,16 @@ use Dpkg::Index;
use List::Util 'shuffle'; use List::Util 'shuffle';
sub check { 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; my $exit = $? >> 8;
if ($exit == 64) { if ($exit == $wantedexit) {
return 1; return 1;
} else { } else {
print "got exit $exit but wanted exit $wantedexit\n";
return 0; return 0;
} }
} }
@ -41,8 +46,10 @@ sub check {
sub write_enabled_pkgs { sub write_enabled_pkgs {
my $index = shift; my $index = shift;
my $enabled = shift; my $enabled = shift;
my $fname = shift;
print "writing to $fname\n";
# write out all the still enabled packages # write out all the still enabled packages
open(my $fh, '>', 'tmp'); open(my $fh, '>', $fname);
foreach my $k ($index->get_keys()) { foreach my $k ($index->get_keys()) {
if (!$enabled->{$k}) { if (!$enabled->{$k}) {
next; next;
@ -56,8 +63,11 @@ sub randomize_pkgs {
my $index = shift; my $index = shift;
my $enabled = shift; my $enabled = shift;
my $id_to_key = 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 # 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; my $num_failures = 0;
while (1) { while (1) {
# fill an array with the remaining enabled indices # fill an array with the remaining enabled indices
@ -79,8 +89,8 @@ sub randomize_pkgs {
for my $i (@to_disable) { for my $i (@to_disable) {
$enabled->{$id_to_key->{$i}} = 0; $enabled->{$id_to_key->{$i}} = 0;
} }
write_enabled_pkgs($index, $enabled); write_enabled_pkgs($index, $enabled, $tmpname);
if (check()) { if (check($wantedexit, @checkcmd)) {
# the error we want to see is still there so we keep these keys # the error we want to see is still there so we keep these keys
# disabled and reset the number of failures # disabled and reset the number of failures
$num_failures = 0; $num_failures = 0;
@ -112,6 +122,9 @@ sub iterate_pkgs {
my $index = shift; my $index = shift;
my $enabled = shift; my $enabled = shift;
my $id_to_key = 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 # we extract the array of enabled indices for better progress reporting
# later on # later on
my $numpkgs = scalar keys %{$enabled}; my $numpkgs = scalar keys %{$enabled};
@ -134,8 +147,8 @@ sub iterate_pkgs {
$i += 1; $i += 1;
# disable the current key # disable the current key
$enabled->{$key} = 0; $enabled->{$key} = 0;
write_enabled_pkgs($index, $enabled); write_enabled_pkgs($index, $enabled, $tmpname);
if (check()) { if (check($wantedexit, @checkcmd)) {
# the error we want to see is still there so we keep this key disabled # the error we want to see is still there so we keep this key disabled
} else { } else {
# the error vanished # the error vanished
@ -150,6 +163,9 @@ sub delete_field {
my $enabled = shift; my $enabled = shift;
my $id_to_key = shift; my $id_to_key = shift;
my $field = shift; my $field = shift;
my $tmpname = shift;
my $wantedexit = shift;
my @checkcmd = @_;
# we extract the array of enabled indices for better progress reporting # we extract the array of enabled indices for better progress reporting
# later on # later on
my $numpkgs = scalar keys %{$enabled}; my $numpkgs = scalar keys %{$enabled};
@ -178,8 +194,8 @@ sub delete_field {
my $fieldvalue = $pkg->{$field}; my $fieldvalue = $pkg->{$field};
# disable the current key # disable the current key
delete $pkg->{$field}; delete $pkg->{$field};
write_enabled_pkgs($index, $enabled); write_enabled_pkgs($index, $enabled, $tmpname);
if (check()) { if (check($wantedexit, @checkcmd)) {
# the error we want to see is still there so we keep this field deleted # the error we want to see is still there so we keep this field deleted
} else { } else {
# the error vanished # the error vanished
@ -190,59 +206,135 @@ sub delete_field {
} }
sub main { sub main {
my $desc = $ARGV[0]; my @srcbinlisttype = ();
if (not defined($desc)) {
die "need a Packages file"; # 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";
}
} }
# now we now which parts are the actual input file names
my $key_func = sub { my @srcbinlistcontent = splice @ARGV, 0, (scalar @srcbinlisttype);
return $_[0]->{Package} . ' ' . $_[0]->{Version} . ' ' . $_[0]->{Architecture}; # the rest is the command to execute
}; my @execcmd = @ARGV;
my $i = 0;
my $index = Dpkg::Index->new(get_key_func=>$key_func); my @tmpfiles = ();
foreach my $val (@execcmd) {
$index->load($desc); if ($val eq '__src__') {
my %allowed_fields = ( $val = "src.$i.tmp";
'Version' => 1, push @tmpfiles, $val;
'Package' => 1, $i += 1;
'Architecture' => 1, }
'Depends' => 1, if ($val eq '__bin__') {
# 'Multi-Arch' => 1, # not needed with only one architecture $val = "bin.$i.tmp";
'Provides' => 1, push @tmpfiles, $val;
'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;
$i += 1; $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); my @data = ();
iterate_pkgs($index, \%enabled, \%id_to_key); foreach( 0 .. $#srcbinlistcontent ) {
delete_field($index, \%enabled, \%id_to_key, 'Depends'); my $f = $srcbinlistcontent[$_];
delete_field($index, \%enabled, \%id_to_key, 'Pre-Depends'); my $t = $srcbinlisttype[$_];
delete_field($index, \%enabled, \%id_to_key, 'Conflicts'); my $r = $tmpfiles[$_];
delete_field($index, \%enabled, \%id_to_key, 'Breaks');
delete_field($index, \%enabled, \%id_to_key, 'Provides'); 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 # somehow, calling randomize_pkgs might remove build-essential
#randomize_pkgs($index, \%enabled, \%id_to_key); #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(); main();