#!/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 Term::ANSIColor qw(:constants);
use Config::IniFiles;
use vars qw/ $host $mirror $suite $config_str $dir $arch @touch $minver
 $dpkgdir $etcdir $ourversion $progname @files $msg $type $noauth
 @dirs @source_list $vendor $preserve $clean $build $ignore_status
 $components $configfile $config %config %keys $section $key $value
 $vendor_name @list @crossdata $installed $checknewer $multiarch /;

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

$progname = basename($0);
$ourversion = &scripts_version();
$dir = "/var/lib/xapt/";
$vendor="default";
$configfile = "/etc/xapt.d/default.conf";
$vendor = "debian";
$etcdir = "etc/xapt/"; # sources below /var/lib/xapt/
# use the real system status information.
# we'd only have to copy it otherwise.
$dpkgdir = "/var/lib/dpkg/";        # state
# min ver of dpkg-cross for -m support
$minver = "2.6.3~";

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 (/^(-m|--multiarch)$/) {
		$multiarch++;
		my $cmd = 'dpkg-query -W -f \'${Version}\' dpkg-cross';
		$installed = `$cmd 2>/dev/null`;
		my $res = system ("dpkg --compare-versions $installed '>=' $minver");
		$res /= 256;
		if ($res > 0) {
			undef $multiarch;
			warn sprintf (_g("Error: Multi-Arch support needs dpkg-cross (>= %s). Found %s"), $minver, $installed)."\n";
		}
	} elsif (/^(-a|--arch)$/) {
		$arch = shift;
	} elsif (/^(-S|--suite)$/) {
		$suite = shift(@ARGV);
	} elsif (/^(-V|--vendor)$/) {
		$vendor = shift(@ARGV);
	} elsif (/^(--check-newer)$/) {
		$checknewer++;
	} elsif (/^(-a|--arch)$/) {
		$arch = shift (@ARGV);
	} elsif (/^(--no-auth)$/) {
		$noauth = " -o Apt::Get::AllowUnauthenticated=true";
	} elsif (/^(--ignore-status)$/) {
		$ignore_status++;
	} elsif (/^(-k|--keep-cache)$/) {
		$preserve = 1;
	} elsif (/^(-c|--clean-cache)$/) {
		$clean = 1;
	} elsif (/^(-b|--build-only)$/) {
		$build = 1;
	} else {
		&usageversion;
		die RED, "$progname: "._g("Unknown option")." $_.", RESET, "\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)) {
	print RED;
	printf(_g("%s: Illogical options set.\n"), $progname);
	print RESET;
	printf( _g("%s: --build-only cannot be used with --clean-cache\n"), $progname);
	exit 4;
}

if (defined $clean) {
	print GREEN;
	printf( _g("%s: Cleaning %s* \n"), $progname, $dir);
	print RESET;
	system ("rm -rf ${dir}*");
	print GREEN;
	printf( _g("%s: Done.\n\n"), $progname);
	print RESET;
	exit 0;
}
if (-f "/usr/bin/dpkg-vendor") {
	$vendor_name = `dpkg-vendor --vendor $vendor --query vendor`;
	chomp ($vendor_name);
	$vendor_name = lc($vendor_name);
} else {
	$vendor_name = "debian";
}
die (RED, sprintf(_g("Cannot read /etc/xapt.d/%s.conf"), $vendor_name), RESET, "\n")
	if (not -r "/etc/xapt.d/$vendor_name.conf");
$configfile = "/etc/xapt.d/$vendor_name.conf";
$config     = new Config::IniFiles( -file => $configfile );
$mirror     = $config->val(lc($vendor_name), 'mirror') if (not defined $mirror);
$suite      = $config->val(lc($vendor_name), 'suite') if (not defined $suite);
$components = $config->val(lc($vendor_name), 'components');
$noauth     = " -o Apt::Get::AllowUnauthenticated=true "
	if ($config->val(lc($vendor_name), 'noauth') eq 'true');
if ((not defined $checknewer) and (defined $config->val(lc($vendor_name), "checknewer"))) {
	$checknewer++ if ($config->val(lc($vendor_name), "checknewer") eq 'true');
}
$mirror     = "http://cdn.debian.net/debian/" if ($mirror eq '');
$components = "main contrib non-free" if ($components eq '');
undef ($suite) if ($suite eq '');

@files = @ARGV;

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

if (not defined $arch) {
	$arch = `debconf-show dpkg-cross 2>/dev/null|cut -d: -f2`;
	if (defined $arch) {
		chomp ($arch);
		$arch =~ s/^ +//;
		undef ($arch) if ($arch =~ /None/);
	}
}
$arch = "armel" if (not defined $arch);
my $msg = sprintf(_g("ERROR: %s: misconfiguration, '%s' missing.\n"),
	$progname, $dir);
die (RED, $msg, RESET) if (not -d "$dir");
system ("mkdir -p ${dir}${etcdir}sources.list.d/");
system ("mkdir -p ${dir}${etcdir}preferences.d/");
unlink ("${dir}${etcdir}sources.list") if (-f "${dir}${etcdir}sources.list");
system ("rm -f ${dir}${etcdir}sources.list.d/*");
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/;

if (defined $suite) {
	unlink "${dir}${etcdir}sources.list.d/xapt.list";
	open (SOURCES, ">${dir}${etcdir}sources.list.d/xapt.list")
		or die RED, _g("Cannot open sources list")." $!", RESET, "\n";
	print SOURCES "deb $mirror $suite $components\n";
	close SOURCES;
} else {
	&prepare_sources_list;
}
$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 .= " -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 .= $noauth if (defined $noauth);
$config_str .= " -o Dir::Etc::Trusted=/etc/apt/trusted.gpg"; 
$config_str .= " -o Dir::Etc::SourceList=${dir}${etcdir}sources.list";
$config_str .= " -o Dir::Etc::SourceParts=${dir}${etcdir}sources.list.d/";
$config_str .= " -o Dir::State=${dir}";
$config_str .= " -o Dir::State::Status=${dpkgdir}status";
$config_str .= " -o Dir::Cache=${dir}";

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 (RED, "$msg ${dir}archives/ : $!", RESET, "\n");
@list = grep(/\.deb$/, readdir DEBS);
closedir (DEBS);
chdir ("${dir}output/");
my $support = (defined $multiarch) ? '-M' : '';
foreach my $pkg (@list) {
	system ("dpkg-cross -A $support -a $arch -b ${dir}archives/$pkg");
	unlink ("${dir}archives/$pkg") if (not defined $preserve);
}
opendir (DEBS, "${dir}output/") or die (RED, "$msg ${dir}output/ : $!", RESET, "\n");
@list = grep(/\.deb$/, readdir DEBS);
closedir (DEBS);
if (defined $checknewer) {
	print GREEN;
	printf (_g("\nINF: Checking against currently installed cross packages....\n"));
	print RESET;
	foreach my $crosspkg (@list) {
		my $cmd = 'dpkg-deb -W --showformat \'${Package}\n${Version}\n\''." ${dir}output/$crosspkg\n";
		@crossdata = `$cmd`;
		chomp(@crossdata);
		# crossdata[0] is package name, crossdata[1] is candidate version
		my $pkgname = $crossdata[0];
		my $candidate = $crossdata[1];
		if (($candidate =~ /^$/) or ($pkgname =~ /^$/)) {
			print "error\n";
			next;
		}
		$cmd = 'dpkg-query -W -f \'${Version}\' '.$pkgname;
		$installed = `$cmd 2>/dev/null`;
		next if ($installed =~ /^$/);
		chomp ($installed);
		$cmd = "dpkg --compare-versions $installed '>=' $candidate";
		my $retval = system ($cmd);
		$retval /= 256;
		if ($retval == 0) {
			print GREEN;
			printf (_g("INF: Skipping installation of %s - newer or same version already installed (%s).\n"), $crosspkg, $installed);
			print RESET;
			unlink "${dir}output/$crosspkg";
		}
		@crossdata=();
	}
	@list=();
	opendir (DEBS, "${dir}output/") or die ("$msg ${dir}output/ : $!\n");
	@list = grep(/\.deb$/, readdir DEBS);
	closedir (DEBS);
}
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 {
	# copy existing sources into our directories
	if (-e "/etc/apt/sources.list") {
		open (SOURCES, "/etc/apt/sources.list")
			or die (RED, _g("cannot open apt sources list.")." $!", RESET, "\n");
		@source_list = <SOURCES>;
		close (SOURCES);
		open (SOURCES, ">${dir}${etcdir}sources.list")
			or die (RED, _g("cannot open apt sources list.")." $!", RESET, "\n");
		print SOURCES @source_list;
		close (SOURCES);
	}
	@source_list=();
	if (-d "/etc/apt/sources.list.d/") {
		opendir (FILES, "/etc/apt/sources.list.d/") or
			die (RED, _g("cannot open apt sources.list directory"), "$!", RESET, "\n");
		my @files = grep(!/^\.\.?$/, readdir FILES);
		foreach my $f (@files) {
			# just skip some obvious backups
			next if ($f =~ /\.ucf-old$/);
			next if ($f =~ /.*~/);
			open (SOURCES, "/etc/apt/sources.list.d/$f") or
				die (RED, _g("cannot open apt sources list.")." $!", RESET, "\n");
			@source_list=<SOURCES>;
			close (SOURCES);
			open (SOURCES, ">${dir}${etcdir}sources.list.d/$f") or
				die (RED, _g("cannot open apt sources list.")." $!", RESET, "\n");
			print SOURCES @source_list;
			close (SOURCES);
		}
		closedir (FILES);
	}
	@source_list=();
}

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

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

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 suite to use for the package(s)
 -k|--keep-cache:         Preserve the downloaded cache files to use again.
 -a|--arch ARCHITECTURE:  Specify the architecture to download or install.
    --ignore-status:      Ignore currently installed packages (native)
    --check-newer:        Check if the same or newer version of the cross
                          package is installed and skip installation.
 -m|--multiarch:          Convert Multi-Arch packages to old dpkg-cross
                           paths. Requires dpkg-cross (>= %s)

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 archives will be downloaded into /var/lib/xapt/archives/ before
being converted with dpkg-cross and installed using dpkg. Using
--build-only implies --keep-cache. Converted packages are created in
/var/lib/xapt/output/

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

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.

=head1 Checking existing cross packages

C<xapt>, by default, will not check to see if a particular cross package
is already installed at a newer or equal version which can cause cross
packages to be downgraded. To turn on this check, either use the
C<--check-newer> option or set C<checknewer> to true in the vendor
configuration file in F</etc/xapt.d/>.

=head1 Using SecureApt 

If your apt sources include a repository which does not use SecureApt,
disable authentication in the vendor configuration file in F</etc/xapt.d/>
Set noauth=true.

=head1 Multiarch behaviour

By default <dpkg-cross> does nothing with packages from Debian which already
support Multi-Arch - the package is simply copied to the current work
directory, if it does not already exist. Any package containing a Multi-Arch: 
field in DEBIAN/control is skipped in this manner.

C<xapt> uses the --multiarch option can pass the --convert-multiarch
option down to dpkg-cross to instead force the generation of a 
-<arch>-cross package with the files moved into the conventional 
dpkg-cross locations.

C<xapt> will check for dpkg-cross version 2.6.3 or higher when this
option is set and report an error (unsetting the option) if a suitable
version is not found.

=cut
