#!/usr/bin/perl

# this script adds Architecture and ABI fields to the /var/lib/dpkg/status file


# ---------------------------------------------------------------------------
# global constants

my @tagOrder = qw ( Package Essential Status Priority Section Installed-Size 
	Origin Maintainer Bugs Source Architecture ABI Version Config-Version 
	Replaces Provides Depends Pre-Depends Recommends Suggests Conflicts 
	Enhances Conffiles Filename Size MD5sum Description );

my @lines = ();




# ---------------------------------------------------------------------------

sub arch_from_exec 
{
	my ($arch) = @_;

	if ($arch =~ m/x86-64/) {
		return "amd64";

	} elsif ($arch =~ m/((i|80)?[3456]|x)86/) {
		return "i386";

	} else {
		die "*** unknown architecture '$arch'\n";
	}
}

sub arch_from_archive 
{
	my ($file) = @_;

	die "*** don't know how to guess architecture for archive $file\n";

	return ();
}

my %abi_of_arch = ();
sub get_abi_of_arch
{
	my ($arch) = @_;

	return $abi_of_arch{$arch} if defined $abi_of_arch{$arch};

	my $abi = `dpkg-subarchitecture -a$arch -qABI`;
}

sub find_arch_and_abi
{
	my ($pkg) = @_;

	my ($arch, $abi) = ($$pkg{Architecture}, $$pkg{ABI});

	return if (defined $arch);

	return if ($$pkg{Status} =~ m/purge/ or $$pkg{Status} =~ m/not-installed/);

	my @files = `dpkg -L $$pkg{Package} | grep -E '/(lib|bin)'`;

	my @libs = ();

	FILE_LOOP:
	foreach my $file (@files) {

		chomp $file;

		push @libs, $file if ( $file =~ m,/lib.*\.(so\.?|a$), );

		next FILE_LOOP if ( not -f $file );
		next FILE_LOOP if ( $file !~ m/(lib|bin)/ );

		my $info = `file -L -b $file`;
		chomp $info;

		if ( $info =~ m/^[^,]*executable,\s*([^,]+)(,.*)$/ ) {

			my $file_arch = arch_from_exec ($1);

			((not defined $arch) or ($file_arch == $arch))
			or die "*** package ".$$pkg{Package}." has multiple archs";
			
			$arch = $file_arch;

			last FILE_LOOP;

		} elsif ( $info =~ m/^[^,]*(shared object|relocatable),\s*([^,]+)(,.*)$/ ) {

			my $file_arch = arch_from_exec ($2);

			((not defined $arch) or ($file_arch == $arch))
			or die "*** package ".$$pkg{Package}." has multiple archs";
			
			$arch = $file_arch;

			$abi = get_abi_of_arch ($arch);

			last FILE_LOOP;

		} elsif ( $info =~ m/^[^,]*ar archive(,.*)$/ ) {

			$arch = arch_from_archive ($file);

			last FILE_LOOP;
		}

	}

	if ( $arch !~ m/^$/ ) {
		$$pkg{Architecture} = $arch;

		$$pkg{ABI}=$abi if (defined $abi);

		return;
	}

	if ( @libs ) {

		my $guess = ();

		foreach my $lib (@libs) {

			if ( $lib =~ m/^(\/usr)?\/lib\/lib/ ) {
				$guess = "i386";

			} elsif ( $lib =~ m/^(\/usr)?\/lib64\/lib/ ) {
				$guess = "amd64";

			} elsif ( $lib = m/^\/usr\/lib[a-z0-9]+\.so/ ) {
				$guess = "i386";

			}
		}

		if ( not defined $guess ) {

			die "*** " . $$pkg{Package} . " has libs but no known Architecture\n"
				. ( join "\n", @libs ) . "\n";
		}

		warn "*** " . $$pkg{Package} . " guessed Architecture == $guess\n";

		$$pkg{Architecture} = $guess;
		$$pkg{ABI} = "strict";

		return;
	}

	$$pkg{Architecture} = "all";
}

sub output_pkg
{
	my ($pkg) = @_;

	foreach my $tag (@tagOrder) {

		if (defined $$pkg{$tag}) {
			my $val = $$pkg{$tag};
			if ($val =~ m/^\n/s) {
				print "$tag:" . $val . "\n";
			} else {
				print "$tag: " . $val . "\n";
			}
		}
	}
	print "\n";
}


# ---------------------------------------------------------------------------
# main

# read all the lines
@lines = <STDIN>;

# setup loop variables
my %pgk = ();		# hold all tags for a package
my $lastTag;		# used to append to the end of a multi-line value


# loop over all lines
foreach my $line (@lines) {

	chomp $line;

	if ( $line =~ m/^$/ ) {

		find_arch_and_abi (\%pkg);

		output_pkg (\%pkg);

		#exit (0);

		%pkg = ();
		$lastTag = ();

	} elsif ($line =~ m/^ .+$/) {

		($lastTag) ||
			die "*** line starts with a space but no tag "
				. "is being parsed yet\n$line\n";

		$pkg{$lastTag} .= "\n$line";

	} elsif ($line =~ m/^([A-Z][A-Za-z0-9-_]+)\s*:\s*(.*)$/) {

		my ($tag, $val) = ($1, $2);

		$lastTag = $tag;

		$pkg{$tag} = $val;

	} else {

		die "*** invalid line format\n$line\n";

	}
}