#!/usr/bin/perl
#
#  emsetup -- Check system for emdebian setup
#
#  based on em_make and emchain
#
#  Checks for previous apt-get operations on the emdebian
#  repository and checks for the presence of a usable toolchain,
#  before using debconf to ask the user to complete their setup.
#
#  Copyright (C) 2006-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/>.
#

use Cwd;
use File::HomeDir;
use Debian::Debhelper::Dh_Lib;
use Debian::DpkgCross;
use Cache::Apt::Lookup;
use Cache::Apt::Config;
use Cache::Apt::Package;
use Emdebian::Tools;
use Term::ANSIColor qw(:constants);
use Text::Wrap;
use Config::Auto;
use warnings;
use strict;
use vars qw($unstable $testing $stable @ret $suite $arch $status
$progname $verbose $dry $chain_msg $available $report_only
$no_upstream $yes $deb_host_gnu_type $justget $distro_id );

my $ourversion = &tools_version();

&read_config();
$arch = &get_architecture();
$verbose = 1;
$dry = 0;
$yes = "";
$report_only = 0;
$no_upstream = 0; # set if no pre-built toolchain exists.
$progname = basename($0);

# recommend emchain if necessary.

$chain_msg = "If you do not wish to use the emdebian toolchain repository or if a toolchain ".
"for your chosen target architecture is not yet available for your host architecture, ".
"please consider using emchain (part of emdebian-tools) to build a cross-building ".
"toolchain that fits your needs.\n\n";

sub usageversion {
	print(STDERR <<END)
$progname version $ourversion

Usage:
 emsetup [-a|--arch ARCH] [-s|--simulate] [-v|--verbose] [-q|--quiet] [-y|--yes]
 emsetup [-a|--arch ARCH] --report
 emsetup -?|-h|--help|--version

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross)
 -s|--simulate:       Do a dry-run, do not change anything.
    --report:         Report on the installed toolchain.
 -y|--yes:            Proceed with toolchain installation without confirmation.
    --download VER:   Just download available packages
 -v|--verbose:        Increase verbosity (max: 3).
 -q|--quiet:          Reduce verbosity.
 -?|-h|--help:        print this usage message and exit.
 --version:           print this usage message and exit.

emsetup checks your system for emdebian compatibility and support.

emsetup should NOT be run under sudo, outside of a chroot.

If a compatible toolchain is already installed, emsetup does nothing. If
a toolchain is available for your host architecture to build the specified
target architecture, it will be installed for you using sudo.

To see what emsetup would do without changing your existing system, use
--simulate.

To see which packages emsetup has checked, use --report.

If a possible toolchain exists for a slightly old version of gcc,
--download can be used to just get the available packages so that
you can try and force the dependencies with dpkg.

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

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit( 0 );
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-s|--simulate)$/) {
		$dry = 1;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(--report)$/) {
		$report_only = 1;
	}
	elsif (/^(-y|--yes)$/) {
		$yes = "--yes";
	}
	elsif (/^(--download)$/) {
		$justget = shift;
		die (RED, "$progname: --download option needs a version of ".
			"gcc, e.g. '4.2'", RESET, "\n") if (not defined ($justget));
	}
	else {
		die "$progname: Unknown option $_.\n";
	}
}

# support native builds
if (not defined $arch or $arch eq "")
{
	$arch = `dpkg-architecture -qDEB_HOST_ARCH_CPU`;
	chomp ($arch);
	print RED, "Note: Could not determine the default architecture.\n";
	print GREEN, "Assuming native: $arch", RESET, "\n";
	print GREEN, "Please use $progname --arch if this is not what you intended.\n"
		if ($verbose >= 1);
}

die(RED, "Could not determine the default architecture, please use $progname --arch", RESET, "\n") if (!$arch);
die(RED, qq;\nError: dpkg-cross does not currently support "$arch";, RESET, "\n") if (!&check_arch($arch));

# Try to determine the current target suite.
$suite = &get_targetsuite();
my $target_gnu_type = &check_cache_arch($arch);

$distro_id = `lsb_release -is`;
chomp($distro_id);
if ($distro_id !~ /^Debian$/)
{
	die RED, wrap('','',"emdebian-tools works best in a genuine Debian environment. ".
	"You can create a suitable environment using debootstrap. ".
	"See emdebian-tools (1) for more information.\n"), RESET, "\n";
}

my %src=();
my %bin=();
if (-e "/etc/apt/sources.list")
{
	open (SOURCES, "/etc/apt/sources.list") or die "cannot open apt sources list. $!";
	my @s = <SOURCES>;
	close (SOURCES);
	foreach my $line (@s)
	{
		chomp ($line);
		$src{$line}++ if ($line =~ /^deb-src/);
		$bin{$line}++ if ($line =~ /^deb /);
	}
	# if there are no entries in $src and only one in $deb, add a $src
	print GREEN, "Checking for suitable apt sources.\n", RESET if ($verbose >= 1);
	if (scalar (keys %bin) == 1 and scalar (keys %src) == 0)
	{
		my @b = keys %bin;
		my $newsrc = $b[0];
		chomp($newsrc);
		$newsrc =~ s/^deb/deb-src/;
		# if we have permission, make the change automatically.
		if (-w "/etc/apt/sources.list")
		{
			print CYAN, "Found a debootstrap sources list with no deb-src\n",
				"Adding $newsrc.\n", RESET;
			open (SOURCES, ">>/etc/apt/sources.list")
				or die "cannot open apt sources list. $!";
			print SOURCES "$newsrc\n";
			close (SOURCES);
			system ("apt-get update");
		}
		# if not, tell the user.
		else
		{
			die RED, "No suitable sources! Need to add $newsrc.\n", RESET;
		}
	}
}

# gpg needs a home directory for SUDO_USER
# this check can only really be expected to work in a debootstrap.
my $sudo_user = $ENV{"SUDO_USER"};
my $user = $ENV{"USER"};
print GREEN, "Checking for /home/$sudo_user and $user permissions\n", RESET
	if (defined $sudo_user);
if (defined $sudo_user and not -d "/home/$sudo_user")
{
	if ($user eq "root" and -d "/home/")
	{
		mkdir "/home/$sudo_user";
		# this changes the apt_crossdir so refresh.
		system ("apt-cross -a $arch -v -u 2>/dev/null");
		system ("apt-cross -a $arch -v -c");
	}
}

# ensure the main system apt cache is up to date
print GREEN, wrap('','',"Updating main system apt cache (enter your sudo password if prompted).\n"),
	RESET if ($verbose >= 1);
system ("sudo apt-get update");
my @policy = `LANG=C apt-cache policy emdebian-tools`;
my $installed;
my $candidate;
foreach my $pol_line (@policy)
{
	chomp ($pol_line);
	if ($pol_line =~ /Installed:\s*(.*)$/) { $installed = $1; }
	if ($pol_line =~ /Candidate:\s*(.*)$/) { $candidate = $1; }
}
if ((not defined ($installed)) or (not defined($candidate))
	or ($installed ne $candidate))
{
	my $aptagent = &get_aptagent();
	print RED, wrap('','',"A newer version of emdebian-tools has been found ($candidate). ".
	"Upgrading emdebian-tools $installed using '$aptagent install emdebian-tools'.\n"), RESET;
	print GREEN, wrap('','',"Updates of emdebian-tools often change the dependencies and simply using ".
	"'$aptagent upgrade' again may fail due to missing packages. Once the new version is installed, ".
	"please run $progname again.\n"), RESET
		if ($verbose >= 2);
	system ("sudo $aptagent -y install emdebian-tools");
	exit (0);
}

&check_multilib();

# ensure that the apt-cross setup is complete
# without forcing an update.
my $q = "";
$q = "-v" if ($verbose >= 1);
$q = '-q' if ($verbose < 1);
print CYAN, "Checking apt cache data is up to date ...\n", RESET;
my $val = &get_primary;
&set_mirror("ftp://$val/debian") if (defined $val);
&check_update($verbose);
&check_hostconfig;

my $hostcheck = &host_arch;
if (($arch eq $hostcheck) or (($arch eq "i386") and ($hostcheck eq "amd64")) or
(($arch eq "amd64") and ($hostcheck eq "i386")))
{
	print GREEN, wrap('','', "The requested cross building architecture ",
	"($arch) does not need a toolchain to build on host ($hostcheck).\n",
	"Nothing more to do. See emsetup (1).\n"), RESET, "\n";
	exit(0);
}

if (defined ($justget))
{
	&download($justget);
	exit (0);
}

if ($report_only == 1)
{
	&report_env($chain_msg);
	exit(0);
}

print CYAN, "Dry run only.\n", RESET if (($dry >= 1) && ($verbose >= 1));

# If a toolchain is found stop immediately; if the user can create a
# toolchain themselves, they don't need setup help.
# add an OK here if arch = target
my $gcc_latest = &find_latest_gcc ($arch, $suite);
my $gcc_vers = "gcc-" . $gcc_latest;
my $list = &prepare_checklist ($arch, $target_gnu_type);
my $string = join (' ', @$list);
my $success = "true";
foreach my $res (sort @$list)
{
	my $retval = `dpkg-query -W -f='\${Package} \${Status}' $res 2>/dev/null`;
	chomp ($retval);
	$success = "false" if ($retval ne "$res install ok installed");
}

if($success eq "true")
{
	print GREEN, "\nSetup appears OK for Emdebian. Nothing to do.\n\n",
		RESET if ($verbose >=1);
	exit(0);
}

my $report = `LANG=C apt-cache policy ${gcc_vers}-${target_gnu_type} 2>/dev/null|grep Installed:`;
chomp ($report);
$report =~ s/^ +//;
&install_toolchain($list) if ($report =~ /^Installed: \(none\)$/);

my $host = &host_arch();
my $msg = "Unable to find a suitable toolchain to build '$arch' targets on '$host'.\n";
print RED, $msg, RESET;
print CYAN, "Please consider using emchain to build your own toolchain.\n", RESET if ($verbose >= 1);
print GREEN, wrap('','',$chain_msg), RESET if ($verbose >= 2);
if ($verbose >= 1)
{
	my $list = ($no_upstream == 0) ? &prepare_checklist($arch, $target_gnu_type)
		: &prepare_checklist($host, $target_gnu_type);
	print CYAN, "Packages required for '$arch' on '$host':\n", RESET;
	my $listmsg="";
	foreach my $pkg (@$list)
	{
		$listmsg .= "$pkg ";
	}
	print GREEN, wrap('','',$listmsg), RESET;
	print "\n";
}
print CYAN, "\nOnce a suitable toolchain can be installed, setup will be complete.\n", RESET;
print CYAN, "Use '$progname --report' to check just the toolchain.\n", RESET if ($verbose >= 2);

# return zero to retain chroot integrity.
exit 0;

sub report_env
{
	my $val = &get_primary;
	&set_mirror("ftp://$val/debian") if (defined $val);
	&check_update($verbose);
	my $host = &host_arch();
	# $suite must be defined.
	die ("Undefined $suite!") if (not defined $suite);
	print GREEN, "Reporting on $suite and $arch\n", RESET if ($verbose >= 1);
	$gcc_latest = &find_latest_gcc ($arch, $suite);
	my $gcc_vers = "gcc-" . $gcc_latest;
	my $report = `apt-cache policy ${gcc_vers}-${target_gnu_type} 2>/dev/null`;
	if (!$report)
	{
		my $msg = "Unable to find a suitable toolchain to build '$arch' targets on '$host'.\n";
		print RED, $msg, RESET;
		print CYAN, "Please consider using emchain to build your own toolchain.\n", RESET if ($verbose >= 1);
		print GREEN, wrap('','',$_[0]), RESET if ($verbose >= 2);
		# set nonzero so that scripts can use --report to check chroot suitability.
		exit 1;
	}
	my $msg = "An Emdebian toolchain to build $arch using gcc-${gcc_latest} ";
	$msg .= "is available for $host in $suite\n";
	print GREEN, wrap('','',$msg), RESET if ($verbose >= 1);
	print CYAN, "Checking if toolchain packages are already installed ...\n", RESET if ($verbose >= 1);
	my $list = &prepare_checklist($arch, $target_gnu_type);
	my $string = join (' ', @$list);
	my $success = "true";
	foreach my $res (sort @$list)
	{
		my $retval = `dpkg-query -W -f='\${Package} \${Status}' $res 2>/dev/null`;
		chomp ($retval);
		$success = "false" if ($retval ne "$res install ok installed");
	}
	if ($success eq "true")
	{
		print CYAN, "dpkg -l $string 2>/dev/null\n", RESET if ($verbose >= 2);
		print GREEN, "\nSetup appears OK for Emdebian. Report follows:\n\n", RESET if ($verbose >=1);
		# the output doesn't optimise nicely - separate parsing would be needed
		# to only get the first line of the Description, dpkg-query outputs
		# the entire short+long description. For now, use the dpkg -l default.
		system ("dpkg -l $string 2>/dev/null");
		return;
	}
	if ($success eq "false")
	{
		# just show the errors.
		system ("dpkg-query -W -f=' \${Package}' $string 1>/dev/null");
		print RED, "Emdebian toolchain for $arch on $host is available but not installed.\n", RESET;
		print CYAN, wrap('','',"Searched for: $string\n"), RESET if ($verbose >= 2);
		print GREEN, "Testing installability with edosdebcheck, please wait . . . \n", RESET;
		print CYAN, wrap('','',"If any tests report a failure, please ask on the ",
			"debian-embedded mailing list: http://lists.debian.org/debian-embedded/",
			'debian-embedded@lists.debian.org. ',"See also 'man 1 emsetup'\n"), RESET;
		&run_edoscheck($string, $suite);
		print GREEN, "Use '$progname -a $arch' to install the $arch toolchain for $host.\n", RESET;
	}
}

sub install_toolchain
{
	my $host = &host_arch();
	my $install = "";
	$list = shift;
	foreach my $pkg (@$list)
	{
		$install .= " $pkg";
	}
	my $aptagent = &get_aptagent;
	$aptagent = "apt-get" if (!$aptagent);
	if ($dry >= 1)
	{
		print CYAN, "An emdebian toolchain is available to build '$arch' on '$host'.\n", RESET;
		print GREEN, "sudo $aptagent install $yes $install\n", RESET if ($verbose >= 2);
		return;
	}
	my $msg = "Running sudo $aptagent install - enter your sudo password if prompted.\n";
	print GREEN, $msg, RESET if ($verbose >=1);
	system "sudo $aptagent install $yes $install";
	# return zero to retain chroot integrity.
	exit 0;
}

sub check_hostconfig
{
	my $retval = 0;
	$retval = system("hostname -f 1>/dev/null");
	return if ($retval == 0);
	my $hostmsg = qq/$progname: Unable to determine fully qualified hostname. /;
	die RED, $hostmsg, RESET, "\n" if ($verbose == 1);
	$hostmsg .= "Please check your /etc/hosts file. See emsetup (1) ";
	$hostmsg .= "for more information.";
	die RED, wrap('','',$hostmsg), RESET, "\n";
}

sub check_multilib
{
	my $our_arch = `dpkg-architecture -qDEB_BUILD_ARCH`;
	chomp ($our_arch);
	return if ($our_arch !~ /^amd64$/);
	my @policy = `LANG=C apt-cache policy libc6-dev-i386`;
	my $installed;
	my $candidate;
	foreach my $pol_line (@policy)
	{
		chomp ($pol_line);
		if ($pol_line =~ /Installed:\s*(.*)$/) { $installed = $1; }
		if ($pol_line =~ /Candidate:\s*(.*)$/) { $candidate = $1; }
	}
	if ((not defined ($installed)) or (not defined($candidate))
		or ($installed ne $candidate))
	{
		my $aptagent = &get_aptagent();
		print GREEN, wrap('','',"Adding libc6-dev-i386.\n"), RESET
			if ($verbose >= 2);
		system ("sudo $aptagent -y install libc6-dev-i386");
		exit (0);
	}
}

sub run_edoscheck
{
	my $list = $_[0];
	my $suite = $_[1];
	my $dpkg_cross_dir = &get_cachedir;
	my $host = &host_arch();
	my %files=();
	opendir (PKG, "$dpkg_cross_dir/$suite/lists") or die ("Unable to check for packages files\n");
	my @pkgfiles=grep(!/^\.\.?/, readdir PKG);
	closedir (PKG);
	foreach my $file (@pkgfiles)
	{
		next unless $file =~ /_debian_dists_${suite}_main_binary-${host}_Packages$/;
		# only have one debian mirror and the emdebian one.
		$files{'debian'} = $file if ($file !~ /emdebian/);
		$files{'emdebian'} = $file if ($file =~ /www\.emdebian\.org/);
	}
	return if (not defined $files{'debian'} and not defined $files{'emdebian'});
	# cat the two packages files together, pass to edos-debcheck $string < file 2>/dev/null
	my $edosfile = `mktemp -t emsetupedos.XXXXXX`;
	chomp($edosfile);
	my $path = "$dpkg_cross_dir/$suite/lists/" . $files{'debian'};
	open (DEB, ">$edosfile") or die ("Unable to open temporary file\n");
	open (LIST, "<$path") or die ("Unable to open package list.\n");
	my @list=<LIST>;
	print DEB @list;
	close (LIST);
	@list = ();
	$path = "$dpkg_cross_dir/$suite/lists/" . $files{'emdebian'};
	open (LIST, "<$path") or die ("Unable to open package list.\n");
	@list=<LIST>;
	print DEB @list;
	close (LIST);
	close (DEB);
	system ("edos-debcheck $list < $edosfile 2>/dev/null");
	unlink($edosfile);
}

sub download
{
	my $get = shift;
	my $count = 0;
	my $available = "true";
	# set libc_latest
	my $report = `apt-cache policy gcc-${get}-${target_gnu_type} 2>/dev/null`;
	die (RED, "gcc-$get was not found in the apt cache.", RESET, "\n") if (!$report);
	&set_suite($suite);
	&check_cache_arch($arch);
	my $config = &init_host_cache(0);
	&force_update;
	push my @list, "gcc-${get}-${target_gnu_type}-base";
	push @list, "gcc-${get}-${target_gnu_type}";
	push @list, "cpp-${get}-${target_gnu_type}";
	push @list, "g++-${get}-${target_gnu_type}";
	my $location = &get_workdir . "/download";
	mkdir $location if (! -d $location );
	chdir ($location);
	foreach my $name (@list)
	{
		my $emp = AptCrossPackage->new();
		$emp->Package("$name");
		my $empref = &lookup_pkg($emp);
		my $file = $$empref->Filename;
		next if (not defined $file);
		system ("wget -N http://buildd.emdebian.org/debian/$file\n");
		print GREEN, "$progname: http://buildd.emdebian.org/debian/$file.\n", RESET;
		$count++;
	}
	if ($count == 4)
	{
		print CYAN, wrap ('','',"Download of gcc-${get} is complete.\n"), RESET;
		my $libc = &find_latest_libc($arch, $suite);
		push my @list, "libc${libc}";
		push @list, "libc${libc}-dev";
		push @list, "libstdc++${libc}";
		push @list, "libstdc++${libc}-${get}-dev";
		push @list, "libstdc++${libc}-${get}-pic";
		push @list, "libgcc1";
		my $val = &get_primary;
		my $mirror = "";
		$mirror = "-m ftp://$val/debian" if (defined $val);
		print GREEN, "Downloading other packages with apt-cross $mirror.\n", RESET;
 		system ("apt-cross -a $arch $mirror -u");
		foreach my $add (@list)
		{
			system ("apt-cross -a $arch $mirror -f -g $add");
		}
		print GREEN, wrap ('','',"gcc-${get} downloaded to $location for manual ".
			"installation, maybe using 'sudo dpkg --force-depends'.\n"), RESET;
		print GREEN, wrap ('','',"Remember to use 'dpkg-cross' for the other packages " .
			"in the toolchain, see dpkg-cross (1) for how to use --exclude.\n"), RESET;
		print RED, "You are now 'on your own'. :-)\n\n", RESET;
		opendir (LIST, $location);
		my @chain = grep(!/^\.\.?/, readdir LIST);
		closedir LIST;
		foreach my $file (@chain)
		{
			print $location . "/" . $file . "\n";
		}
	}
	# the downloaded files need processing with dpkg-cross
	# the versions also mismatch when the repository ones
	# would work! (patches welcome)
	# also fix --report to find these toolchains or wait until
	# we have a gcc-cross meta-package.
}