#!/usr/bin/perl

# Copyright (C) 2009-2010  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/>.

use IO::File;
use File::Basename;
use POSIX qw(locale_h);
use Locale::gettext;
use strict;
use warnings;
use Config::Auto;
use vars qw/ $host $mirror $suite $config_str $dir %suites $arch @touch
 $dpkgdir $etcdir $sourcesname $ourversion $progname @files $msg
 @dirs @source_list $vendor $preserve $clean $build $ignore_status
 $defaultcomponents $configfile $config %config/;

setlocale(LC_MESSAGES, "");
textdomain("xapt");

$progname = basename($0);
$ourversion = &scripts_version();
$configfile = "/etc/xapt/xapt.conf";

if (-x $configfile) {
    $config = Config::Auto::parse($configfile);
}
$mirror = $config{'mirror'} || "http://cdn.debian.org/debian/";
$defaultcomponents = $config{'defaultcomponents'} || "main contrib non-free";

$dir = "/var/lib/xapt/";
%suites  = ();
$etcdir = "etc/xapt/"; # sources
# use the real system status information.
# we'd only have to copy it otherwise.
$dpkgdir = "/var/lib/dpkg/";        # state

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
	&usageversion();
		exit 0;
	}
	elsif (/^(-M|--mirror)$/) {
		$mirror = shift(@ARGV);
	}
	elsif (/^(-S|--suite)$/) {
		$suite = shift(@ARGV);
	}
	elsif (/^(-V|--vendor)$/) {
		$vendor = shift(@ARGV);
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift (@ARGV);
	}
	elsif (/^(--ignore-status)$/) {
		$ignore_status++;
	}
	elsif (/^(-k|--keep-cache)$/) {
		$preserve = 1;
	}
	elsif (/^(-c|--clean-cache)$/) {
		$clean = 1;
	}
	elsif (/^(-b|--build-only)$/) {
		$build = 1;
	}
	else {
		die "$progname: "._g("Unknown option")." $_.\n";
	}
}

# imply -k if -b in use.
$preserve = 1 if (defined $build);

# no point building if clean is also set.
if ((defined $build) and (defined $clean))
{
	printf( _g("%s: Illogical options set.\n"), $progname);
	printf( _g("%s: --build-only cannot be used with --clean-cache\n"),
		$progname);
	exit 4;
}

if (defined $clean)
{
	printf( _g("%s: Cleaning %s* \n"), $progname, $dir);
	system ("rm -rf ${dir}*");
	printf( _g("%s: Done.\n\n"), $progname);
	exit 0;
}

@files = @ARGV;

if (scalar @files == 0)
{
	my $msg = sprintf(_g("ERROR: Please specify some packages for %s to convert.\n"), $progname);
	warn ($msg);
	&usageversion;
	exit (0);
}

if (not defined $arch)
{
	$arch = `debconf-show dpkg-cross 2>/dev/null|cut -d: -f2`;
	chomp ($arch) if (defined $arch);
	undef ($arch) if (defined $arch and $arch =~ /None/);
}
# don't default arch? Complain instead?
$arch = "armel" if (not defined $arch);
my $msg = sprintf(_g("ERROR: %s: misconfiguration, '%s' missing.\n"),
	$progname, $dir);
die ($msg)
	if (not -d "$dir");
system ("mkdir -p ${dir}${etcdir}sources.list.d/");
system ("mkdir -p ${dir}${etcdir}preferences.d/");

$sourcesname = "sources.list.d/xapt.sources.list";
unlink ("${dir}${etcdir}${sourcesname}")
	if (-f "${dir}${etcdir}${sourcesname}");

mkdir "$dir/lists" if (not -d "$dir/lists");
mkdir "$dir/lists/partial" if (not -d "$dir/lists/partial");
mkdir "$dir/archives" if (not -d "$dir/archives");
mkdir "$dir/output" if (not -d "$dir/output");
mkdir "$dir/archives/partial" if (not -d "$dir/archives/partial");
@dirs = qw/ alternatives info parts updates/;
@touch = qw/ available diversions statoverride status lock/;

&prepare_sources_list;
foreach my $line (@source_list)
{
	chomp ($line);
	next if ($line =~ /^#/);
	next if ($line =~ /^$/);
	my @a = split (/ /, $line);
	$suites{$a[2]}++;
}
if (defined $suite)
{
	my @a=();
	push @a, "deb $mirror $suite $defaultcomponents";
	@source_list=();
	@source_list=@a;
}

unlink "${dir}${etcdir}${sourcesname}";
open (SOURCES, ">${dir}${etcdir}${sourcesname}")
	or die _g("Cannot open sources list")." $!";
foreach my $line (@source_list)
{
	chomp ($line);
	next if ($line =~ /^#/);
	next if ($line =~ /^$/);
	$line =~ s/^ +//g;
	print SOURCES "$line\n";
}
close SOURCES;
$host=`dpkg-architecture -qDEB_HOST_ARCH`;
chomp ($host);
$config_str = '';
$config_str .= " -o Apt::Get::Download-Only=true";
if (($arch ne $host) or (defined $ignore_status)) {
	$dpkgdir = "${dir}/${arch}/dpkg/";
	mkdir "$dir/$arch";
	mkdir "$dir/$arch/dpkg";
	system ("touch ${dir}/${arch}/dpkg/status");
	$config_str .= " -y -o Apt::Architecture=$arch";
} else {
	$config_str .= " --force-yes -y --reinstall -o Dir=$dir";
}
$config_str .= " -o Apt::Install-Recommends=false";
$config_str .= " -o Dir::Etc=${dir}${etcdir}";
$config_str .= " -o Dir::Etc::TrustedParts=/etc/apt/trusted.gpg.d";
$config_str .= " -o Dir::Etc::Trusted=/etc/apt/trusted.gpg"; 
$sourcesname = "sources.list.d/xapt.sources.list";
$config_str .= " -o Dir::Etc::SourceList=${dir}${etcdir}$sourcesname";
$config_str .= " -o Dir::State=${dir}";
$config_str .= " -o Dir::State::Status=${dpkgdir}status";
$config_str .= " -o Dir::Cache=${dir}";

# bug - keeps complaining of a duplicate source list.
print "apt-get $config_str update\n";
system ("apt-get $config_str update 2>/dev/null");
my $str = join (" ", @files);
print "apt-get $config_str install $str\n";
system ("apt-get $config_str install $str");
$msg = _g("Cannot read");
opendir (DEBS, "${dir}archives/") or die ("$msg ${dir}archives/ : $!\n");
my @list = grep(/\.deb$/, readdir DEBS);
closedir (DEBS);
chdir ("${dir}output/");
foreach my $pkg (@list)
{
	system ("dpkg-cross -A -a $arch -b ${dir}archives/$pkg");
	unlink ("${dir}archives/$pkg");
}

system ("dpkg -i ${dir}output/*.deb")
	if ((scalar @list > 0) and (not defined $build) and ($host ne $arch));

system ("rm -rf ${dir}*") if (not defined $preserve);

exit 0;

sub prepare_sources_list
{
	# collate all available/configured sources into one list
	if (-e "/etc/apt/sources.list") {
		open (SOURCES, "/etc/apt/sources.list")
			or die _g("cannot open apt sources list.")." $!";
		@source_list = <SOURCES>;
		close (SOURCES);
	}
	if (-d "/etc/apt/sources.list.d/") {
		opendir (FILES, "/etc/apt/sources.list.d/")
			|| die "cannot open apt sources.list directory $!";
		my @files = grep(!/^\.\.?$/, readdir FILES);
		foreach my $f (@files) {
			next if ($f =~ /\.ucf-old$/);
		        next if ($f =~ /.*~/);
		        unless ($f =~ /\.list$/) {
			    print "skipping $f\n";
			    next;
			} 
			open (SOURCES, "/etc/apt/sources.list.d/$f") or
				die "cannot open /etc/apt/sources.list.d/$f $!";
			while(<SOURCES>) {
				push @source_list, $_;
			}
			close (SOURCES);
		}
		closedir (FILES);
	}
}

sub usageversion {
	printf STDERR (_g("
%s version %s

Usage:
 %s [-M|--mirror] [-S|--suite] [-k|--keep-cache] install PACKAGES ...
 %s [-M|--mirror] [-S|--suite] [-k|--keep-cache] build-dep PACKAGES ...
 %s -c|--clean-cache
 %s -?|-h|--help|--version

Either install PACKAGES and their dependencies, or the build-dependecies of PACKAGES

Commands:
 -c|--clean-cache:        Remove any downloaded cache files and exit.

Options:
 -b|--build-only:         Get and process the packages, do not install
                           (implies -k)
 -M|--mirror:             A Debian mirror with the requested package(s)
 -S|--suite:              Which suitename (testing, maverick) to use for the package(s)
 -k|--keep-cache:         Preserve the downloaded cache files to use again.
 -a|--arch ARCHITECTURE:  Download selected architecture only, not install.
    --ignore-status:      Ignore currently installed packages

xapt tidies up after itself by removing all temporary data and
packages after installation, unless the --keep-cache option is used.
(Converted packages are not preserved.)

The processed archives will be in /var/lib/xapt/archives/ before
being converted with dpkg-cross and installed using dpkg. Using
--build-only implies --keep-cache.

"), $progname, $ourversion, $progname, $progname, $progname);
}

sub scripts_version {
	my $query = `dpkg-query -W -f='\${Version}' xapt 2>/dev/null`;
	(defined $query) ? return $query : return "2.2.4";
}

sub _g {
	return gettext(shift);
}

=pod

=head1 NAME

xapt - convert Debian packages to cross versions on-the-fly

=head1 Synopsis

 $ sudo xapt foo bar baz

 $ sudo xapt -M http://ftp.fr.debian.org/debian/ foo bar baz
 
 $ sudo xapt --clean-cache

=head1 Description

Downloading the Packages files can take a reasonable amount of time, so
to grip a number of packages, either specify all packages in one command
or use the C<--keep-cache> option for each run and use the
C<--clean-cache> option at the end.

Note also that, in common with the rest of Emdebian processing,
Install-Recommends is always turned off, so if you need a package that
is only recommended by packages in the list given to C<xapt>, that
package will need to be added to the list explicitly.

=head1 Limitations

Installing any package from repositories outside the normal apt sources
(especially if those packages are subsequently modified by dpkg-cross)
will list those packages as "local or obsolete" in package managers.
Converted packages cannot be upgraded without repeating the call to 
C<xapt> because C<apt-get> does not know about the renaming of the
package by C<dpkg-cross> when downloading the packages. This can cause
problems if dependencies of such packages need to be upgraded. It is
possible that the main system C<apt> will try to remove these local
packages in order to proceed with the main system upgrade.

The best option is to use C<xapt> inside a disposable chroot.
