Dominique Leuenberger
b635702b67
The file names are generated out of the sha1sum of the file content. Thus we know if the file has the same name, it has the same content as well. Multiple packages are allowed to own the same file with the same content. This is already proven functional by the kernel being flavor:multiversion - the kernel can be installed in multiple versions already (which the checked never would have caught file conflicts for: we only check against current packages in the distro) Fixes issue #2350
371 lines
8.4 KiB
Perl
Executable File
371 lines
8.4 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
$| = 1;
|
|
use strict;
|
|
|
|
my %dirs;
|
|
my @dirs;
|
|
my %modes;
|
|
my @modes;
|
|
my @modes_type;
|
|
my @modes_ghost;
|
|
my %files;
|
|
my %filesc;
|
|
|
|
$dirs{'/'} = 0;
|
|
push @dirs, '/';
|
|
|
|
$modes{'40755 0 root:root'} = 0;
|
|
push @modes, '40755 0 root:root';
|
|
push @modes_type, 040000;
|
|
push @modes_ghost, 0;
|
|
|
|
my $pkg = '';
|
|
my $fls = 0;
|
|
my $prv = 0;
|
|
my $con = 0;
|
|
my $obs = 0;
|
|
|
|
my %con;
|
|
my %obs;
|
|
my %whatprovides;
|
|
|
|
die("Usage: findfileconflicts2 packages[.gz]\n") unless @ARGV == 1;
|
|
|
|
my @ftypes;
|
|
$ftypes[001] = 'p';
|
|
$ftypes[002] = 'c';
|
|
$ftypes[004] = 'd';
|
|
$ftypes[006] = 'b';
|
|
$ftypes[010] = '-';
|
|
$ftypes[012] = 'l';
|
|
$ftypes[014] = 's';
|
|
|
|
sub beautify_mode {
|
|
my @m = split(' ', $modes[$_[0]], 3);
|
|
my $fm = oct($m[0]);
|
|
my $ft = $fm & 0770000;
|
|
$fm &= ~0770000;
|
|
$ft = $ftypes[$ft >> 12 & 077] || '?';
|
|
|
|
my $rts = '';
|
|
my $rt = oct($m[1]);
|
|
$rts .= 'd' if $rt & 02;
|
|
$rts .= 'c' if $rt & 01;
|
|
$rts .= 'm' if $rt & 010;
|
|
$rts .= 'n' if $rt & 020;
|
|
$rts .= 'g' if $rt & 0100;
|
|
$rts .= 'l' if $rt & 0200;
|
|
$rts .= 'r' if $rt & 0400;
|
|
$rt &= ~0733;
|
|
$rts .= sprintf("%o", $rt) if $rt;
|
|
$rts .= ' ' if $rts;
|
|
return "$rts$ft".sprintf("%03o", $fm)." $m[2]";
|
|
}
|
|
|
|
print STDERR "scanning file list\n";
|
|
if ($ARGV[0] =~ /\.gz$/) {
|
|
open(FL, "-|", 'gunzip', '-dc', $ARGV[0]) || die("open $ARGV[0]: $!\n");
|
|
} else {
|
|
open(FL, '<', $ARGV[0]) || die("open $ARGV[0]: $!\n");
|
|
}
|
|
|
|
while(<FL>) {
|
|
chomp;
|
|
if ($fls) {
|
|
if ($_ eq '-Flx:') {
|
|
$fls = 0;
|
|
next;
|
|
}
|
|
my $lnk = '';
|
|
if (/^(12.*)( -> .*?)$/) {
|
|
$_ = $1;
|
|
$lnk = $2;
|
|
}
|
|
next unless /^(\d+ (\d+) \S+) (.*\/)(.*?)$/;
|
|
my $perms = $1;
|
|
my $n = $dirs{$3};
|
|
if (!defined($n)) {
|
|
$n = @dirs;
|
|
$dirs{$3} = $n;
|
|
$dirs[$n] = $3;
|
|
}
|
|
# ignore link targets and permissions of ghosts
|
|
if ((oct($2) & 0100) != 0) {
|
|
$lnk = '' if $lnk;
|
|
$perms =~ s/^100000/100644/;
|
|
}
|
|
my $m = $modes{"$perms$lnk"};
|
|
if (!defined($m)) {
|
|
$m = @modes;
|
|
$modes{"$perms$lnk"} = $m;
|
|
$modes[$m] = "$perms$lnk";
|
|
$modes_type[$m] = oct($perms) & 07770000;
|
|
$modes_ghost[$m] = oct($2) & 0100;
|
|
}
|
|
my $f = "$n/$4";
|
|
if (exists $files{$f}) {
|
|
$filesc{$f} ||= [ $files{$f} ];
|
|
push @{$filesc{$f}}, "$pkg/$m";
|
|
} else {
|
|
$files{$f} = "$pkg/$m";
|
|
}
|
|
next;
|
|
}
|
|
if ($prv) {
|
|
if ($_ eq '-Prv:') {
|
|
$prv = 0;
|
|
next;
|
|
}
|
|
s/ .*//; # no version stuff;
|
|
push @{$whatprovides{$_}}, $pkg;
|
|
next;
|
|
}
|
|
if ($con) {
|
|
if ($_ eq '-Con:') {
|
|
$con = 0;
|
|
next;
|
|
}
|
|
s/ .*//; # no version stuff;
|
|
s/^otherproviders\((.*)\)$/$1/;
|
|
push @{$con{$pkg}}, $_;
|
|
next;
|
|
}
|
|
if ($obs) {
|
|
if ($_ eq '-Obs:') {
|
|
$obs= 0;
|
|
next;
|
|
}
|
|
s/ .*//; # no version stuff;
|
|
push @{$obs{$pkg}}, $_;
|
|
next;
|
|
}
|
|
if (/^=Pkg: (.*)/) {
|
|
$pkg = $1;
|
|
my $n = $pkg;
|
|
$n =~ s/ .*//;
|
|
push @{$obs{$pkg}}, $n;
|
|
next;
|
|
}
|
|
if ($_ eq '+Con:') {
|
|
$con = 1 if $pkg;
|
|
next;
|
|
}
|
|
if ($_ eq '+Obs:') {
|
|
$obs = 1 if $pkg;
|
|
next;
|
|
}
|
|
if ($_ eq '+Prv:') {
|
|
$prv = 1 if $pkg;
|
|
next;
|
|
}
|
|
if ($_ eq '+Flx:') {
|
|
$fls = 1;
|
|
next;
|
|
}
|
|
}
|
|
close(FL) || die("close failed\n");
|
|
|
|
print STDERR "currently have ".@dirs." dirs and ".@modes." modes\n";
|
|
|
|
# connect dirs and add all dirs as files
|
|
print STDERR "connecting ".@dirs." directories\n";
|
|
my @implicit_conflicts;
|
|
for (@dirs) {
|
|
next unless /^(.*\/)(.*?)\/$/;
|
|
my $n = $dirs{$1};
|
|
if (!defined $n) {
|
|
$n = @dirs;
|
|
$dirs{$1} = $n;
|
|
$dirs[$n] = $1;
|
|
next;
|
|
}
|
|
my $f = "$n/$2";
|
|
next unless $files{$f};
|
|
my (undef, $m) = split('/', $files{$f}, 2);
|
|
next if $modes_type[$m] == 040000;
|
|
# whoa, have a conflict. search for other dirs
|
|
my $have_dir;
|
|
for my $pkg (@{$filesc{$f} || []}) {
|
|
(undef, $m) = split('/', $pkg, 2);
|
|
$have_dir = 1 if $modes_type[$m] == 040000;
|
|
}
|
|
next if $have_dir;
|
|
push @implicit_conflicts, $f;
|
|
}
|
|
print STDERR "now ".@dirs." directories\n";
|
|
|
|
# the old and fast way
|
|
#
|
|
#for my $f (@implicit_conflicts) {
|
|
# $filesc{$f} ||= [ $files{$f} ];
|
|
# push @{$filesc{$f}}, "implicit_directory 0 0 noarch pkg/0";
|
|
#}
|
|
|
|
if (@implicit_conflicts) {
|
|
print STDERR "have implicit conflicts, calculating dir owners\n";
|
|
my @pdirs; # parent dirs
|
|
for (@dirs) {
|
|
next unless /^(.*\/)(.*?)\/$/;
|
|
$pdirs[$dirs{$_}] = $dirs{$1};
|
|
}
|
|
my %baddir;
|
|
for (@implicit_conflicts) {
|
|
my ($n, $x) = split('/', $_, 2);
|
|
$baddir{$dirs{"$dirs[$n]$x/"}} = $_;
|
|
}
|
|
my $done;
|
|
while (!$done) {
|
|
$done = 1;
|
|
my $i = -1;
|
|
for (@pdirs) {
|
|
$i++;
|
|
next unless defined $_;
|
|
next unless $baddir{$_} && !$baddir{$i};
|
|
$baddir{$i} ||= $baddir{$_};
|
|
undef $done;
|
|
}
|
|
}
|
|
undef @pdirs;
|
|
# this is not cheap, sorry
|
|
my %baddir_pkgs;
|
|
for my $ff (keys %files) {
|
|
my ($n, undef) = split('/', $ff, 2);
|
|
next unless $baddir{$n};
|
|
for (@{$filesc{$ff} || [ $files{$ff} ]}) {
|
|
my ($pkg, undef) = split('/', $_, 2);
|
|
$baddir_pkgs{$baddir{$n}}->{"$pkg/0"} = 1;
|
|
}
|
|
}
|
|
for my $f (@implicit_conflicts) {
|
|
$filesc{$f} ||= [ $files{$f} ];
|
|
$baddir_pkgs{$f} ||= { "implicit_directory 0 0 noarch pkg/0" => 1 };
|
|
push @{$filesc{$f}}, sort keys %{$baddir_pkgs{$f}};
|
|
}
|
|
}
|
|
|
|
%files = (); # free mem
|
|
|
|
# reduce all-dir conflicts and trivial multiarch conflicts
|
|
print STDERR "reducing trivial conflicts\n";
|
|
for my $f (sort keys %filesc) {
|
|
my $allm;
|
|
my $allc = 1;
|
|
my $pkgn;
|
|
my $pl;
|
|
for my $pkg (@{$filesc{$f}}) {
|
|
my ($p, $m) = split('/', $pkg, 2);
|
|
die unless $p =~ /^([^ ]+) /;
|
|
$allm = $m unless defined $allm;
|
|
$allm = -1 if $allm != $m;
|
|
$pkgn = $1 unless defined $pkgn;
|
|
$allc = 0 if $pkgn ne $1;
|
|
$allc = 0 if $pl && $p eq $pl;
|
|
$pl = $p;
|
|
}
|
|
if ($allc) {
|
|
delete $filesc{$f};
|
|
next;
|
|
}
|
|
if (defined($allm) && $allm >= 0 && $modes_type[$allm] == 040000) {
|
|
delete $filesc{$f};
|
|
next;
|
|
}
|
|
}
|
|
|
|
print STDERR "checking conflicts\n";
|
|
my %pkgneeded;
|
|
my %tocheck;
|
|
my %tocheck_files;
|
|
for my $f (sort keys %filesc) {
|
|
my @p = sort(@{$filesc{$f}}); # normalize
|
|
$filesc{$f} = [ @p ];
|
|
s/\/.*// for @p;
|
|
$pkgneeded{$_} = 1 for @p;
|
|
my $pn = join("\n", @p);
|
|
$tocheck{$pn} ||= [ @p ];
|
|
push @{$tocheck_files{$pn}}, $f;
|
|
}
|
|
|
|
my %conflicts;
|
|
for my $pkg (sort keys %con) {
|
|
next unless $pkgneeded{$pkg};
|
|
for my $c (@{$con{$pkg}}) {
|
|
for my $p (@{$whatprovides{$c} || []}) {
|
|
next if $p eq $pkg;
|
|
$conflicts{"$pkg\n$p"} = 1;
|
|
$conflicts{"$p\n$pkg"} = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
for my $pkg (sort keys %obs) {
|
|
next unless $pkgneeded{$pkg};
|
|
for my $c (@{$obs{$pkg}}) {
|
|
for my $p (@{$whatprovides{$c} || []}) {
|
|
next if $p eq $pkg;
|
|
next unless $p =~ /^\Q$c\E /;
|
|
$conflicts{"$pkg\n$p"} = 1;
|
|
$conflicts{"$p\n$pkg"} = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
# let 32bit packages conflict with the i586 version
|
|
for my $pkg (sort keys %pkgneeded) {
|
|
next unless $pkg =~ /^([^ ]+)-32bit /;
|
|
my $n = $1;
|
|
for my $p (@{$whatprovides{$n} || []}) {
|
|
next unless $p =~ /^\Q$n\E .* i[56]86$/;
|
|
next if $p eq $pkg;
|
|
$conflicts{"$pkg\n$p"} = 1;
|
|
$conflicts{"$p\n$pkg"} = 1;
|
|
}
|
|
}
|
|
|
|
print STDERR "found ".(keys %tocheck)." conflict candidates\n";
|
|
print STDERR "checking...\n";
|
|
# now check each package combination for all candidates
|
|
for my $tc (sort keys %tocheck) {
|
|
my @p = @{$tocheck{$tc}};
|
|
while (@p) {
|
|
my $p1 = shift @p;
|
|
for my $p2 (@p) {
|
|
next if $conflicts{"$p1\n$p2"};
|
|
my @con;
|
|
for my $f (@{$tocheck_files{$tc}}) {
|
|
my @pp = grep {s/^(?:\Q$p1\E|\Q$p2\E)\///} map {$_} @{$filesc{$f}};
|
|
next unless @pp;
|
|
# ignore if (all directories or all ghosts or all links) and all same mode;
|
|
my %allm = map {$_ => 1} @pp;
|
|
my $info = '';
|
|
if (keys(%allm) == 1) {
|
|
my $m = (keys(%allm))[0];
|
|
# all modes/flags are the same
|
|
# no conflict if all dirs or all ghosts or all links
|
|
next if $modes_type[$m] == 040000 || $modes_type[$m] == 0120000 || $modes_ghost[$m] == 0100;
|
|
} else {
|
|
# don't report mode mismatches for files/symlinks that are not ghosts
|
|
for my $m (keys %allm) {
|
|
if (($modes_type[$m] != 0100000 && $modes_type[$m] != 0120000) || $modes_ghost[$m] == 0100) {
|
|
$info = ' [mode mismatch: '.join(', ', map {beautify_mode($_)} @pp).']';
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
# got one!
|
|
$f =~ /^(\d+)\/(.*)/;
|
|
push @con, "$dirs[$1]$2$info" unless "$dirs[$1]$2" =~ m{/etc/uefi/certs/.*crt};
|
|
}
|
|
next unless @con;
|
|
my @sp1 = split(' ', $p1);
|
|
my @sp2 = split(' ', $p2);
|
|
print "- between:\n";
|
|
print " - [$sp1[0], $sp1[1], $sp1[2], $sp1[3]]\n";
|
|
print " - [$sp2[0], $sp2[1], $sp2[2], $sp2[3]]\n";
|
|
print " conflicts: |-\n";
|
|
print " $_\n" for (@con);
|
|
}
|
|
}
|
|
}
|