#!/usr/bin/perl

=head1 NAME

grip-overridearch.pl - sanitise Arch: all packages that depend on Arch: any

=cut

use strict;
use warnings;
use File::Basename;
use Debian::Packages::Compare;

use vars qw/ %tasks %overrides $uri $deb $z @list $suite 
 $prog $our_version $base $grip_name $skip $file @archlist
 %matches /;
 
=head1 Synopsis

 grip-overridearch.pl -s|--suite STRING -b|--base-path PATH [--grip-name STRING]
 grip-overridearch.pl -?|-h|--help|--version

 Commands:
 -s|--suite STRING:        Name of the distribution to override [required]
 -b|--base-path PATH:      path to the top level repository directory [required]

 -?|-h|--help|--version:   print this help message and exit

 Options:
   --grip-name STRING:     alternative name for the grip repository

The script expects to find a suitably formatted architecture-override
file in the repository configuration:

 $base_path/$grip_name/conf/override.architectures

=cut

$prog = basename ($0);
$our_version = &scripts_version();
$grip_name = "grip";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit (0);
	}
	elsif (/^(-b|--base-path)$/) {
		$base = shift;
	}
	elsif (/^(-s|--suite)$/) {
		$suite = shift;
	}
	elsif (/^(--grip-name)$/) {
		$grip_name = shift;
	}
	else {
		die "$prog: Unknown option $_.\n";
	}
}

die "$prog: ERR: Please specify an existing directory for the base-path.\n"
	if (not defined $base);

$base .= '/' if ("$base" !~ m:/$:);
die "$prog: ERR: Please specify an existing directory for the base-path: $base\n"
	if (not -d $base);

die ("$prog: ERR: Specify a distribution name, not a codename. e.g. testing, not lenny.\n")
	if ((not defined $suite) or 
	($suite =~ /etch|sid|lenny|squeeze/));

die ("$prog: ERR: Cannot find Grip configuration directory.\n")
	if (not -d "${base}${grip_name}/conf/");

=head1 Description

The list of packages and "broken" architectures needs to be identified
the hard way until such time as a resolution is found for the problem
outlined on debian-devel:
L<http://lists.debian.org/debian-devel/2009/01/msg00289.html>

This script will use a file in the repository F<conf/> directory which
looks like an override file but is not handled by reprepro itself.
Quoting dato: L<http://lists.debian.org/debian-devel/2009/01/msg00312.html>

 ... the only use for "Architecture: all [i386 amd64]" or
 "Install-Architecture: i368 amd64" would be as a hint to dak (and other
 tools) that the package is known not to be installable anywhere else,
 and hence should not be put in other Packages.gz files. That's *all*
 that matters AIUI.

Until the tools can be adapted to use such syntax, this script removes
the specified listings from the relevant Packages files by calling the
relevant remove option for the tools, after the event.

So if $package_name represents the name of the binary package that is
Architecture: all but which depends on a package that only exists on 
selected architectures, the format for the override file is:

 Package: $package_name
 Architecture: all [i386 amd64]

e.g.

 Package: debian-edu-profile-udeb
 Architecture: all [i386 amd64]

This happens because F<debian-edu-profile-udeb> depends on 
dmidecode-udeb L<http://packages.debian.org/sid/dmidecode-udeb> which
in turn is only available on x86 architectures:

 $ reprepro -b /opt/reprepro/filter/ list unstable dmidecode-udeb
 u|sid|main|i386: dmidecode-udeb 2.9-1
 u|sid|main|amd64: dmidecode-udeb 2.9-1

When edos-debcheck parses the Packages file, it finds that reprepro and
other repository tools list debian-edu-profile-udeb in the Packages
files for all supported architectures (like arm, armel, mips etc.) so
it tries to satisfy the dependencies - and fails because dmidecode is
not available. The solution is to remove the listing for the
Architecture: all package from all Packages files that do not contain
the necessary dependencies - identified by running edos-debcheck against
the Packages files and adding packages to the override.arch file until
edos-debcheck stops complaining.

This is not peculiar to this package or even just udebs, it is also a
problem with packages like acpi-support-base.

=cut

=head1 Removing all binaries

It is also possible to remove all binaries for a specific package
(leaving only the source and other binaries built from that source
package) by specifying an empty list of allowed architectures:

 Package: lsb
 Architectures: all [ ]

Note that the space is optional. This can be useful when the binary
package with the same name as the source package has a lot of
unwanted dependencies (C<lsb> is a perfect example of this
problem).

=cut

&set_base($base);

my $a = &get_archlist ($suite, $grip_name);
die ("Unable to obtain list of supported architectures.\n")
	if (not defined $a);

$file = "${base}$grip_name/conf/override.architectures";
print "Checking for $file\n";
if (not -f $file)
{
	print "Nothing to do, cannot find override.architectures.\n$file\n";
	exit 0;
}

open (OVR, $file) or die ("Cannot read $file: $!\n");
@list=<OVR>;
close (OVR);

my $package;
foreach my $line (@list)
{
	if ($line =~ /^Package: (.*)$/)
	{
		$package = $1;
		next;
	}
	next if not defined ($package);
	$overrides{$package}=$1 if ($line =~ /^Architecture: (.*)$/);
	undef ($package);
}

foreach $package (sort keys %overrides)
{
	my $parse = $overrides{$package};
	my %include=();
	if ($parse =~ /^all \[(.*)\]$/)
	{
		my @i=();
		@i = split(' ', $1) if (defined $1);
		foreach my $allow (@i)
		{
			$matches{$allow}++;
		}
	}
	foreach my $arch (@$a)
	{
		# always leave source intact
		next if ($arch eq 'source');
		if (not exists ($matches{$arch}))
		{
			print "Removing $package from $arch.\n";
			system "reprepro -v -A $arch -b $base/$grip_name remove $suite $package";
		}
	}
	%matches = ();
}

sub scripts_version {
	my $query = `dpkg-query -W -f='\${Version}' emdebian-grip-server`;
	(defined $query) ? return $query : return "";
}

sub usageversion
{
	print(STDERR <<END)
$prog - sanitise Arch: all packages that depend on Arch: any
version $our_version

Syntax: $prog -s|--suite STRING -b|--base-path PATH [--grip-name STRING]
        $prog -?|-h|--help|--version

Commands:
-s|--suite STRING:        Name of the distribution to override [required]
-b|--base-path PATH:      path to the top level grip directory [required]

-?|-h|--help|--version:   print this help message and exit

Options:
   --grip-name STRING:    alternative name for the grip repository

The script expects to find a suitably formatted architecture-override
file in the repository configuration:

 \$base_path/\$grip_name/conf/override.architectures

END
	or die "$0: failed to write usage: $!\n";
}

=head1 Copyright and Licence

 Copyright (C) 2007-2009  Neil Williams <codehelp@debian.org>

 This package is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation; either version 3 of the License, or
 (at your option) any later version.
 
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program.  If not, see <http://www.gnu.org/licenses/>.

=cut
