#!/usr/bin/perl
# SPDX-License-Identifier: MIT
# SPDX-FileCopyrightText: 2024 Helmut Grohne <helmut@subdivi.de>

sub check_merged {
	my $affected=0;
	foreach my $dir (qw(bin lib lib32 lib64 libo32 libx32 sbin)) {
		if (-l "/$dir") {
			my $target = readlink("/$dir");
			if ($target ne "usr/$dir") {
				$affected += 1;
				print("Warning: /$dir points to $target instead of usr/$dir.\n");
			}
		} elsif (-d "/$dir") {
			$affected += 1;
			print("Warning: /$dir is a directory, should be a symlink.\n");
		}
	}
	return $affected;
}

sub check_package {
	my ($pkgdata, $diversions, $diverters) = @_;
	return unless ($pkgdata->{Status}->[0] eq "installed");
	my $package = $pkgdata->{Package}->[0];
	my $affected = 0;
	foreach my $filename (@{$pkgdata->{Files}}) {
		if ($package ne $diverters->{$filename}) {
			$filename = $diversions->{$filename} // $filename;
		}
		$filename =~ s{^(/usr)/}{/};
		my $prefix = $1 or "";
		next unless ($filename =~ m{^/(bin|lib|lib32|lib64|libo32|libx32|sbin)/});
		next if (-e "/usr$filename" || -l "/usr/$filename");
		print("Warning: $prefix$filename is supposedly installed by $package, but actually missing.\n");
		$affected = 1;
	}
	print("Try `apt reinstall $package` to fix the problem.\n") if $affected;
	return $affected;
}

sub check_dpkg_database {
	open(my $divert, "-|", "dpkg-divert --list")
		or die "failed to query dpkg for diversions: $!";
	my %diversions, %diverters;
	while (my $line = <$divert>) {
		$line =~ m/^diversion of (.*) to (.*) by (.*)/ or next;
		$diversions{$1} = $2;
		$diverters{$1} = $3;
	}

	open(my $dpkg, "-|", "dpkg-query -f 'Package: \${Package}\\nStatus: \${db:Status-status}\\nFiles:\\n\${db-fsys:Files}\\n' -W")
		or die "failed to query dpkg for files: $!";

	my %data;
	my $field;
	my @values;
	my $affected = 0;
	while (my $line = <$dpkg>) {
		chomp $line;
		if ($line eq '') {
			$data{$field} = [@values] if (defined $field);
			$affected += check_package(\%data, \%diversions, \%diverters) if %data;
			%data = ();
			$field = undef;
			@values = ();
		} elsif ($line =~ /^\s+(.*)/) {
			die "invalid continuation" unless (defined $field);
			push @values, $1;
		} elsif ($line =~ /^([^:]+):\s*(.*)/) {
			$data{$field} = [@values] if (defined $field);
			$field = $1;
			@values = ($2,);
		} else {
			die "invalid input line";
		}
	}
	close($dpkg);
	$affected += check_package(\%data, \%diversions, \%diverters) if %data;
	return $affected;
}

exit(1) if (check_merged() > 0);
exit(1) if (check_dpkg_database() > 0);

__END__

=head1 NAME

usr-move-analyze.pl - Locate expected problems arising from Debian's /usr-move in the current installation

=head1 SYNOPSIS

usr-move-analyze.pl

=head1 DESCRIPTION

It query the B<dpkg> database for all known files and checks whether those that should exist actually do exist.
Only files potentially affected by aliasing problems are actually checked.
If missing files are encountered, reinstalling the owning package usually fixes the symptom.

The tool can be run as non-root user, but some packages such as mariadb-server install files with strict permissions.
In the event that a file cannot be read by the calling user, it will be reported as missing.

=head1 LIMITATIONS

Users can configure B<--path-exclude> options via F</etc/dpkg/dpkg.cfg>.
Such options are not considered.
Files removed using this exclusion mechanism are reported as missing even though that is expected.
Usually, the mechanism is used for locales, which happen to not be affected by aliasing problems and therefore are not reported.

=cut