josch/findarchwildcardproblems
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

use Dpkg::Index, field_list_src_dep, deps_parse and deps_iterate

Browse source
This commit is contained in:
josch 2015-05-22 08:46:07 +02:00
parent f89dba4b4d
commit fad7803bde
1 changed files with 21 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
findarchwildcardproblems.pl
View file

@ -8,41 +8,44 @@ use warnings;
# wildcard) in build dependencies, conflicts, the architecture field and in
# binary packages listed in the Package-List field
use Dpkg::Control;
use Dpkg::Compression::FileHandle;
use Dpkg::Deps;
use Dpkg::Deps qw(deps_parse deps_iterate);
use Dpkg::Index;
use List::MoreUtils qw{any};
use List::Util qw{first};
use Dpkg::Arch qw(debarch_is);
use Dpkg::Control::FieldsCore qw(field_list_src_dep);
my $desc = $ARGV[0]; # /home/josch/gsoc2012/bootstrap/tests/sid-sources-20140101T000000Z
if (not defined($desc)) {
die "need filename";
}
my $fh = Dpkg::Compression::FileHandle->new(filename => $desc);
my $key_func = sub {
return $_[0]->{Package} . '_' . $_[0]->{Version};
};
my $index = Dpkg::Index->new(get_key_func=>$key_func);
$index->load($desc);
my @debarches = ("amd64", "armel", "armhf", "hurd-i386", "i386", "kfreebsd-amd64", "kfreebsd-i386", "mips", "mipsel", "powerpc", "s390x", "sparc",
"alpha", "arm64", "hppa", "m68k", "powerpcspe", "ppc64", "sh4", "sparc64", "x32");
while (1) {
my $cdata = Dpkg::Control->new(type => CTRL_INDEX_SRC);
last if not $cdata->parse($fh, $desc);
foreach my $key ($index->get_keys()) {
my $cdata = $index->get_by_key($key);
my $pkgname = $cdata->{"Package"};
next if not defined($pkgname);
my @depfields = ('Build-Depends', 'Build-Depends-Indep', 'Build-Depends-Arch',
'Build-Conflicts', 'Build-Conflicts-Indep', 'Build-Conflicts-Arch');
# search for invalid arches in the dependency and conflict fields
my @depfields = field_list_src_dep();
foreach my $depfield (@depfields) {
my $dep_line = $cdata->{$depfield};
next if not defined($dep_line);
foreach my $dep_and (split(/\s*,\s*/m, $dep_line)) {
my @or_list = ();
foreach my $dep_or (split(/\s*\|\s*/m, $dep_and)) {
my $dep_simple = Dpkg::Deps::Simple->new($dep_or);
my $dep_iter = deps_parse($dep_line);
deps_iterate($dep_iter, sub {
my $dep_simple = shift;
my $depname = $dep_simple->{package};
next if not defined($depname);
return 1 if not defined($depname);
my $arches = $dep_simple->{arches};
next if not defined($arches);
return 1 if not defined($arches);
# find wildcards that do not match any existing architecture
foreach my $arch (@{$arches}) {
$arch =~ s/^!//;
@ -70,8 +73,8 @@ while (1) {
print "DD: $pkgname $arch $depname\n";
}
}
}
}
return 1;
});
}
# search for invalid arches in Architecture field
my $architecture = $cdata->{"Architecture"};