#!/usr/bin/perl
#
#  apt-cross -- apt support for cross compiling
#  Copyright (C) 2006  Wookey <wookey@debian.org>
#  Copyright (C) 2006  Hector Oron <hector.oron@gmail.com>
#  Copyright (C) 2006  Neil Williams <codehelp@debian.org>
#
#  This program 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 2 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, write to the Free Software
#  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#

use File::Basename;
use LWP::Simple;
use File::HomeDir;
use strict;
use vars qw ($file $archivename $verbose $deb $package $suite $source $mirror $dpkg_cross_dir @source_list $debsize @debs $debcache $arch %package_list $result $mtime $time_now $m $check @contents $dir @dirs @touch $print $dpkg_cmd $retval $mode $progname $APTCROSSVERSION $keepdeps $home $dpkg_statfile @removedeps $removedeps @install_list $depend_root $pkg );

require "dpkg-cross.pl";

$APTCROSSVERSION = "0.0.5";
$dpkg_statfile = "/var/lib/dpkg/status";

$home = File::HomeDir->my_home;
$dpkg_cross_dir = "$home/.dpkg-cross";
if (not -d $dpkg_cross_dir) {
	mkdir $dpkg_cross_dir;
}

sub usageversion {
    print(STDERR <<END)
apt-cross version $APTCROSSVERSION

Usage:
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] --install|-i <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] --build|-b <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] --get|-g <packages...>
 apt-cross [--remove|--purge|-r] <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] [--show|-s] <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] [--list|-l] <packages...>
 apt-cross [-a|--arch ARCH] [-S|--suite SUITE] [-m|--mirror MIRROR] [--update|-u]

Options:
 -a|--arch ARCH:      set architecture (default: defined in configuration file)
 -S|--suite SUITE:    set the Debian suite (stable, testing, unstable [default])
 -m|--mirror MIRROR:  set the Debian mirror to use to retrieve packages
                      (default: first usable mirror in /etc/apt/sources.list)
 -v|--verbose:        be verbose
 -q|--quiet:          be quiet

apt-cross provides apt functionality for getting, building and installing 
libraries and header files for cross-compiling using dpkg-cross. apt-cross
will search for and download missing dependencies of the requested package
before making the requested package and dependencies available for 
installation via dpkg-cross.

apt-cross is intended to make it easier to locate, download, install and
update your cross-compiling libraries, directly from the Debian archives.

apt-cross is not intended to handle applications or Architecture: all packages
like foo-common or libfoo-common. apt-cross can download and build the cross-
compiling version of those packages but does not install them - you can do that
with dpkg-cross -A if necessary but not all such packages can be installed in
that way.

By default, apt-cross uses your /etc/apt/sources.list to find the latest
debian package file for the architecture specified (default is arm) and in 
the suite specified (default is unstable). Alternatively, you can specify
a different mirror. Downloaded files can be passed to dpkg-cross using 
the -b or -i commands to apt-cross. If the local file is missing or out 
of date, a new one will be downloaded automatically.

To force an update of the cache, use apt-cross --update. Note that all sources
for this suite on this arch will be removed before the package cache is updated.
If /etc/apt/sources.list does not contain a source for this suite, the updated
cache for this suite will be empty. Use -m|--mirror to specify a source to be
added to whatever sources are available for this suite in /etc/apt/sources.list.

END
        || die "$progname: failed to write usage: $!\n";
}

$mode = "";
$verbose = 1;
$suite = "unstable";
$mirror = "";
%package_list = qw//;
$retval = 0;
$depend_root = 0;
my @rotor = qw ( - \ | / );
my $rotorcount = 0;

while( @ARGV ) {
    $_= shift( @ARGV );
    last if m/^--$/;
    if (!/^-/) {
        unshift(@ARGV,$_);
		last;
    }
	elsif (/^(-h|--help|--version)$/) {
		&usageversion;
		exit( 0 );
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-S|--suite)$/) {
		$suite = shift(@ARGV);
	}
	elsif (/^(-m|--mirror)$/) {
		$mirror = shift(@ARGV);
	}
	elsif (/^(-i|--install)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "install";
	}
	elsif (/^(-g|--get)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "get";
	}
	elsif (/^(-r|--remove|--purge)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "remove";
	}
	elsif (/^(-s|--status)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "status";
	}
	elsif (/^(-l|--list)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "list";
	}
	elsif (/^(-b|--build)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "build";
	}
	elsif (/^(-u|--update)$/) {
		die "$progname: Only one action can be specified!\n" if $mode;
		$mode = "update";
	}
	else {
		&usageversion;
		die "$progname: Unknown option $_.\n";
	}
}

# called after a mode has been set to check the rest of ARGV.
sub check_args()
{
	if ((/^(-i|--install)$/) || (/^(-g|--get)$/) || (/^(-r|--remove|--purge)$/) ||
		(/^(-s|--status)$/) || (/^(-l|--list)$/) || (/^(-b|--build)$/) || 
		(/^(-u|--update)$/)) {
		if ($mode) {
			&usageversion;
			die "$progname: Only one action can be specified! mode=$mode\n";
		}
	}
}

# read in dpkg-cross default arch
read_config("all");
setup();

if (!$mode || (!@ARGV && $mode ne "list" && $mode ne "update")) {
	&usageversion;
	die "$progname: Too few arguments.\n"
}

if ($mode eq "get") {
	&cross_get;
	&download_arch_packages;
	exit 0;
}

if ($mode eq "update")
{
	&force_update;
	exit 0;
}

if ($mode eq "status") {
	&setup_config;
	&update_sources;
	# returns status of all available cross-compiled packages.
	&show_cross;
}
elsif ($mode eq "list") {
	&setup_config;
	&update_sources;
	# more like apt-cache pkgnames for cross-compiled packages
	my @list = `apt-cache -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite pkgnames`;
	@list = sort (@list);
	foreach $pkg (@list)
	{
		chomp ($pkg);
		if (!($pkg =~ /$arch-cross$/)) { next; }
		print "$pkg\n";
	}
}
elsif ($mode eq "remove") {
	$dpkg_cmd = "--purge";
}
elsif ($mode eq "install") {
	# Checks to see if the install has already been done
	&cross_get;
	&check_depends;
}
elsif ($mode eq "build") {
	&cross_get;
	&download_arch_packages;
	&request_build;
}

if ($dpkg_cmd) {
	&check_args;
	my $cmdline = "dpkg $dpkg_cmd " .
		          join( " ", map( rewrite_pkg_name($_), @ARGV ));
	print "Calling $cmdline\n" if $verbose >= 2;
	system( $cmdline );
	$retval = $? >> 8;
}
exit $retval;

sub rewrite_pkg_name {
        my $name = shift;

        $name .= "-$arch-cross" if $name !~ /-\Q$arch\E-cross$/;
        return $name;
}

sub cross_get()
{
		$print = "Arch:     $arch\nSuite:    $suite\n";
		foreach (@ARGV) {
			&check_args;
			# hash: key is package name, value is .deb filename (later)
			$package_list{$_}='';
			$print .= "Package:  $_\n";
		}
		print $print if ($verbose >= 2);
		&setup_config;
		&update_sources;
}

sub force_update()
{
	if ($mirror) {
		print "Updating $suite on $arch using $mirror\n" if $verbose >= 2;
	}
	else {
		print "Updating $suite on $arch using /etc/apt/sources.list\n" if $verbose >= 2;
	}
	unlink ("$dpkg_cross_dir/sources.$suite");
	unlink ("$dpkg_cross_dir/apt.conf-$suite");
	unlink ("$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch");
	&setup_config;
	&update_sources;
}

sub setup_config()
{
	@dirs = qw/ alternatives info parts updates/;
	@touch = qw/ diversion statoverride status lock/;
	#set up necessary dirs for cross-dpkg database
	if (not -e "$dpkg_cross_dir/$suite") {
		mkdir "$dpkg_cross_dir/$suite";
	}
	if (not -e "$dpkg_cross_dir/$suite/lists") {
		mkdir "$dpkg_cross_dir/$suite/lists";
	}
	if (not -e "$dpkg_cross_dir/$suite/lists/partial") {
		mkdir "$dpkg_cross_dir/$suite/lists/partial";
	}
	if (not -e "$dpkg_cross_dir/$suite/archives") {
		mkdir "$dpkg_cross_dir/$suite/archives";
	}
	if (not -e "$dpkg_cross_dir/$suite/archives/partial") {
		mkdir "$dpkg_cross_dir/$suite/archives/partial";
	}
	foreach $dir (@dirs) {
		if (not -d "$dpkg_cross_dir/$dir") {
			mkdir "$dpkg_cross_dir/$dir";
		}
	}
	foreach $file (@touch) {
		utime(time, time, "$dpkg_cross_dir/$file") or ( 
			open(F, ">$dpkg_cross_dir/$file") && close F )
	}
	#make apt-conf file and sources files
	if (not -e "$dpkg_cross_dir/apt.conf-$suite") {
		print "recreating $dpkg_cross_dir/apt.conf-$suite\n" if $verbose >= 2;
		open (CONF, ">$dpkg_cross_dir/apt.conf-$suite") || die "Cannot open $!";
		print CONF<<END;
Dir "$dpkg_cross_dir/"
{
  Etc "$dpkg_cross_dir/"
  {
    SourceList "sources.$suite";
  };
  State "$suite/";
  Cache "$suite/";
};
END
		close CONF;
	}
	#check if $mirror is missing from the file.
	if (-e "$dpkg_cross_dir/sources.$suite") {
		open (SOURCES, "/etc/apt/sources.list") || die "cannot open $!";
		@source_list = <SOURCES>;
		close (SOURCES);
		open (SOURCES, "$dpkg_cross_dir/sources.$suite") || die "Cannot open $!";
		@contents=<SOURCES>;
		$check = join (@contents);
		close (SOURCES);
		if ((!$check =~ /$mirror/) &&($mirror)) {
			# if it is missing, append it.
			open (SOURCES, ">>$dpkg_cross_dir/sources.$suite") || die "Cannot open $!";
			print SOURCES<<END;
deb $mirror $suite main
deb-src $mirror $suite main
END
			close SOURCES;
			# update using the amended file.
			# NOTE: use of fakeroot means that if 'sudo' has not been cached,
			# the underlying dpkg will report a nuisance message that can be ignored.
			print "Updating cache of available $arch packages in $suite\n" if ($verbose >= 2);
			$result = `apt-get -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite -s update 2>&1`;
			utime(time, time, "$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") 
				or ( open(F, ">$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") && close F )
		}
	}
	# create sources file for this suite.
	else { #file is missing, so create new.
		print "recreating $dpkg_cross_dir/sources.$suite\n" if $verbose >= 2;
		if ($mirror) {
			print "Adding $mirror to $dpkg_cross_dir/sources.$suite\n" if $verbose >= 2;
			open (SOURCES, ">>$dpkg_cross_dir/sources.$suite") || die "Cannot open $!";
			print SOURCES<<END;
deb $mirror $suite main
deb-src $mirror $suite main
END
			close SOURCES;
		}
		open (SOURCES, "/etc/apt/sources.list") || die "cannot open $!";
		@source_list = <SOURCES>;
		close (SOURCES);
		open (SOURCES, ">>$dpkg_cross_dir/sources.$suite") || die "Cannot open $!";
		foreach $source (@source_list) {
			while($source =~ /^deb (.*) $suite/g) {
				$m = $1;
				$m =~ s/\n$//;
				if ($m ne "") {
					print SOURCES<<END;
deb $m $suite main
deb-src $m $suite main
END
				}
				close SOURCES;
			}
		}
		# update using the new file.
		# NOTE: use of fakeroot means that if 'sudo' has not been cached,
		# the underlying dpkg will report a nuisance message that can be ignored.
		$result = `apt-get -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite 		-update 2>&1`;
		utime(time, time, "$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") 
		or ( open(F, ">$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") && close F )
	}
}

sub update_sources()
{
	#start by downloading sources, but only if not already done this 24hrs
	$mtime = (stat ("$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch"))[9];
	$time_now = time();
	if ($time_now - $mtime > 86400) {
		# NOTE: use of fakeroot means that if 'sudo' has not been cached,
		# the underlying dpkg will report a nuisance message that can be ignored.
		$result = `apt-get -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite -s update 2>&1`;
		utime(time, time, "$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") 
			or ( open(F, ">$dpkg_cross_dir/.aptupdate-stamp-$suite-$arch") && close F )
	}
  #this doesn't work - but should - needs bug filing
  #               (cd $native_dir && sudo aptitude -o   Apt::Architecture=$arch  \
  #                  -o Apt::Dir="/var/emdebian/tools/apt/" \
  #                  -o Apt::Dir::Etc="/var/emdebian/tools/apt/" \
  #                  -o Apt::Dir::Etc::SourceList="sources.$suite" \
  #                  -o Apt::Dir::State=$suite/ \
  #                  -o Apt::Dir::Cache=$suite/ \
  #                  download $packages
}

sub download_arch_packages
{
	my $filename;
	my $version;
	# if $mirror is not defined:
	open (SOURCES, "/etc/apt/sources.list") || die "cannot open $!";
	@source_list = <SOURCES>;
	close (SOURCES);
	foreach $package (keys %package_list)
	{
#		$debcache=`fakeroot apt-cache -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite madison $package`;
#		$debcache =~ /.{13}(.{11})\| (\S*) (\S*)/;
		$debcache=`fakeroot apt-cache -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite show $package`;
		$debcache =~ /Version: (.*)\n/g;
		$version = $1;
		$debcache =~ /Filename: (.*)\n.*Size: (.*)\n/g;
		$filename = $1;
		$filename =~ s/\s//g;
		$debsize = $2;
		$debsize =~ s/\s//g;
		if ($filename eq "") {
			print "No file found! Trying next source.\n" if ($verbose >= 2);
			next;
		}
		$file = basename($filename);
		if ($file eq "") { next; }
		my $installed = `dpkg-cross -l $package 2> /dev/null`;
		print "Checking if $package is installed . . ." if ($verbose >= 3);
		if ($installed =~ /ii\s*([a-zA-Z0-9\.\-]*)-$arch-cross\s*([a-z0-9\-\~\.]*)\s*.*/)
		{
			if (($package eq $1) && ($version eq $2))
			{
				my $log = " yes.\n$package-$arch-cross is already installed at ";
				$log .= "the newest version available in $suite.\n";
				print $log if ($verbose >= 2);
				next;
			}
		}
		print " no.\n" if ($verbose >= 3);
		push (@debs, $file);
		if ((-e $file) && (-s $file == $debsize)) {
			print "File '$file' already exists, skipping download.\n" if ($verbose >= 2);
			next;
		}
		# if $mirror is defined: ($archivename = $mirror)
		if ($mirror ne "") {
			$archivename = $mirror;
			print "Filename: $file\n" if ($verbose >= 2);
			$package_list{"$package"} = $file;
			open (LOCAL, ">$file") || die "cannot open local file $!";
			$deb = get("$archivename/$filename");
			print LOCAL $deb;
			close (LOCAL);
			print "Mirror:   $archivename\n" if ($verbose >= 2);
			return;
		}
		# if $mirror is not defined:
		foreach $source (@source_list)
		{
			while($source =~ /^deb (.*) $suite/g) {
				$archivename = $1;
				$archivename =~ s/\n$//;
				print "Filename: $file\n" if ($verbose >= 2);
				$package_list{"$package"} = $file;
				open (LOCAL, ">$file") || die "cannot open local file $!";
				$deb = get("$archivename/$filename");
				print LOCAL $deb;
				close (LOCAL);
			}
			if (-s $file) { last; }
		}
		print "Mirror:   $archivename\n" if ($verbose >= 2);
	}
}

sub request_install
{
	my $count = @debs;
	if ($count == 0) { return; }
	print "Converting $count packages:\n" if $verbose >= 3;
	foreach $package ( @debs ) {
		if ($package eq "") { next; }
		if (not -r $package) {
			warn "$progname: cannot access $package: $!\n";
			next;
		}
		push @install_list, $package;
	}
	my $list = join ' ', @install_list;
	if ($list eq "") { return; }
	if ($verbose >= 2) {
		print "Calling 'dpkg-cross -v -A -i' for $list\n";
		$result = system ("sudo dpkg-cross -v -A -i $list");
	} else {
		$result = system ("sudo dpkg-cross -i $list");
	}
	return if ($result);
	# remove downloaded file now that it is installed.
	foreach my $file (@install_list)
	{
		print ("Success. Removing temporary archive: $file\n") if ($verbose >= 2);
		unlink ($file);
	}
}

sub request_build
{
	my $count = @debs;
	if ($count == 0) { return; }
	foreach $package ( @debs ) {
		if ($package eq "") { next; }
		if (not -r $package) {
			warn "$progname: cannot access $package: $!\n";
			next;
		}
		if ($verbose >= 2) {
			print "Calling 'dpkg-cross -v -b' for $package\n";
			$result = `dpkg-cross -v -b $package`;
			print $result;
		} else {
			$result = `dpkg-cross -b $package`;
		}
	}
}

# This is slow because the cache has to be queried one package at a time.
# (Can't tell in advance which packages to query.)
sub check_depends
{
	my @depend;
	my $exists, my $pkg;
	my $num, my $old, my $log = "";
	$depend_root++;
	foreach $package (keys %package_list)
	{
		print "checking $package dependencies . . . \n" if ($verbose >= 2);
		$old = keys %package_list;
		$debcache=`fakeroot apt-cache -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite depends $package`;
		print $debcache if ($verbose >= 3);
		$_ = $debcache;
		@depend = m/Depends: <?(.*)>?/g;
		foreach $check (@depend)
		{
			chomp ($check);
			if ($rotorcount > 4) { $rotorcount = 0; }
			print "Checking dependencies: $rotor[$rotorcount]\r" if ($verbose == 1);
			$check =~ s/<|>//g;
			print "$package depends on $check" if ($verbose >= 2);
			if ($verbose >= 2) { $exists = `dpkg-cross -v -l $check 2&> /dev/null`; }
			else { $exists = `dpkg-cross -l $check 2&> /dev/null`; }
			if ($exists =~ /ii\s*([a-zA-Z0-9\.\-]*)-$arch-cross\s*([a-z0-9\-\~\.]*)\s*.*/)
			{
				print ", installed ($2) : OK\n" if ($verbose >= 2);
			}
			else
			{
				$log = " - adding to installation list.\n";
				print $log if ($verbose >= 2);
				$package_list{$check} = $check;
			}
			$rotorcount++;
		}
		$num = keys %package_list;
		if ($num > $old) { &check_depends; }
	}
	$depend_root--;
	if ($depend_root == 0)
	{
		print "\n" if ($verbose == 1);
		my $c = keys (%package_list);
		print "One package to install.\n" if (($c == 1) && ($verbose >= 1));
		print "$c packages to install.\n" if (($c > 1) && ($verbose >= 1));
		if ($verbose >= 3)
		{
			my @f = keys (%package_list);
			my $s = join (' ' , @f);
			print "Installing: $s\n";
		}
		&download_arch_packages;
		&request_install;
	}
	return;
}

sub show_cross
{
	foreach $pkg (@ARGV)
	{
		if (!($pkg =~ /$arch-cross$/)) {
			$pkg = $pkg . "-$arch-cross";
		}
		system "apt-cache -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite show $pkg";
	}
}
