#!/usr/bin/perl -w
#
#  emchain -- toolchain builder for cross compiling
#  Copyright (C) 2006, 2007  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 File::Basename;
use Text::Wrap;
use Config::Auto;
use Debian::DpkgCross;
use Cache::Apt::Package;
use Cache::Apt::Config;
use Cache::Apt::Lookup;
use Term::ANSIColor qw(:constants);
use Emdebian::Tools;
use strict;
use warnings;
use vars qw/ $verbose $dpkg_cross_dir $suite $arch $line $aptcmd
$skip_gcc $skip_binutils $skip_libc $host $gcc_latest $gcc_vers
$gcc_pkg_v $binutils_vers $libc_latest $libc_vers $libc_pkg_v
$binutils_dir $gcc_dir $dev $binutils_deb @glibc_list @glibc_list2
@glibc_list3 $check $glibc_count $home $ourversion $progname $logfile
$date $log $cmdline $status $environ $result $workdir $msg
*OLDOUT *OLDERR $forcing $arglog/;

$ourversion = &tools_version();
$progname = basename($0);
$verbose = 1;
$forcing = 0;
$suite = &get_targetsuite();
# read in dpkg-cross default arch
&read_config();
$arch = &get_architecture();
$dpkg_cross_dir = &get_aptcross_dir();
$workdir = &get_workdir;
$workdir = "." if ($workdir eq "");
$msg = &check_workdir($workdir);
die $msg if ($msg ne "");
chdir ("$workdir") if ($workdir ne ".");
chdir ("emchain") if ( -d "emchain");
$date = `date +%F`;
$date =~ s/\n//;

## Pseudo-code:
# $ apt-get source gcc-3.4 binutils libc
# $ cd binutils-2.17
# $ TARGET=$target_gnu_type fakeroot debian/rules binary-cross (replace arch by arm, alpha,...)
# dpkg -i built-package
# apt-cross -i libdb1-compat libc6 libc6-dev linux-kernel-headers
# $ export GCC_TARGET=$arch
# $ export DEB_CROSS_INDEPENDENT=yes (for gcc-4.1 and later).
# $ cd gcc-3.4-3.4.2
# $ debian/rules control
# $ dpkg-buildpackage -b -rfakeroot

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

Usage:
 emchain [-a|--arch ARCH] [-w|--workdir] [-l|--log] [-v|--verbose] [-q|--quiet] [-f|--force]
 emchain -?|-h|--help|--version

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross).
 -w|--workdir DIR:    override the current working directory setting .
 -f|--force:          continue the build even if the upstream native build has failed.
 -l|--log:            write a logfile in the working directory.
 -v|--verbose:        be verbose (repeat for more verbosity).
 -q|--quiet:          be quiet [default]
 -?|-h|--help:        print this usage message and exit
 --version:           print this usage message and exit

emchain implements the EmdebianSlind toolchain build process for
the latest versions of gcc, binutils and libc. To build toolchains
for older compilers, see the Emdebian website: www.emdebian.org

emchain uses dpkg-cross and apt-cross to determine the latest
versions of toolchain packages, downloads the source for each missing
package, builds the package using EmdebianSlind options and commands,
installs the cross-built packages and toolchain packages.

emchain needs to be run from a consistent working directory so that it
can check if new versions need to be downloaded. If an existing working
directory has not been specified using debconf, the current directory
will be used.

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

$arglog = 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 (/^(-w|--workdir)$/) {
		$workdir = shift(@ARGV);
		chdir ("$workdir");
	}
	elsif (/^(-l|--log)$/) {
		$arglog = 1;
	}
	elsif (/^(-f|--force)$/) {
		$forcing = 1;
	}
}

$msg = "$progname: no default architecture found.\n";
$msg .= "Please use '$progname --arch ARCH'.\n";
die $msg if ((!$arch)||($arch eq ""));

$logfile = "emchain-" . $arch . "-" . $date . ".log" if ($arglog == 1);

if ($verbose >= 2)
{
	print CYAN, "Building toolchain in '" . cwd . "'\n", RESET;
	print CYAN, "Options used:\n", RESET;
	print CYAN, "verbose=$verbose\n", RESET;
	print GREEN, "forcing=YES\n", RESET if ($forcing != 0);
	(defined $logfile) ? print CYAN, "logging to $logfile\n", RESET :
		print CYAN, "not logging output.\n", RESET;
}
if (!&check_arch($arch)){
	$msg = (qq;Error: dpkg-cross does not currently support "$arch".;);
	die RED, "\n$msg\n", RESET;
}

if ($logfile)
{
	open OLDOUT, ">&STDOUT" or die "cannot duplicate stdout: $!\n";
	open OLDERR, ">&STDERR" or die "cannot duplicate stderr: $!\n";
	open BUILD, "| tee $logfile" or die "could not open pipe to tee $logfile: $!";
	close STDOUT;
	close STDERR;
	open STDOUT, ">&BUILD" or die "cannot reopen stdout: $!";
	open STDERR, ">&BUILD" or die "cannot reopen stderr: $!";
	print "emchain $ourversion build log.\t$date\tArchitecture: $arch\n\n";
}

my $target_gnu_type = &check_cache_arch($arch);
&setup_config;
$msg = "Checking apt-cross $suite cache for $arch.\n";
print CYAN, $msg, RESET if ($verbose >= 2);
&check_update($verbose);

# prepare variable names.
$skip_gcc = 0;
$skip_binutils = 0;
$skip_libc = 0;
$host = &host_arch("binutils");
$gcc_latest =  &find_latest_gcc("gcc", $arch, $suite);
if ($gcc_latest eq "0")
{
	print (RED, qq/Warning: $progname cannot find a native gcc package for $arch.\n/, RESET);
	print (GREEN, qq/$progname will try to build a toolchain from scratch using cache values for $host.\n/, RESET);
	$msg = "Refreshing apt-cross $suite cache for $host.\n";
	print CYAN, $msg, RESET if ($verbose >= 2);
	&use_hostsources;
	my $config = &init_host_cache(2);
	&cache_update($config);
	$gcc_latest = &find_latest_gcc("gcc", $host, $suite);
	$binutils_vers = &cache_version("binutils", $host);
	$libc_latest = &find_latest_libc("libc", $host, $suite);
	$gcc_vers = "gcc-" . $gcc_latest;
	# BUG $host should always work.
	my $bugmsg = "Internal error: Please rerun emchain with the --verbose --log options and ";
	$bugmsg .= " file a bug report against emdebian-tools with the results attached.";
	die (RED, wrap('','',$bugmsg), RESET) if ($gcc_vers eq "gcc-0");
	$gcc_pkg_v = &cache_version($gcc_vers, $host);
	$libc_vers = "libc" . $libc_latest;
	$libc_pkg_v = &cache_version($libc_vers, $host);
	$binutils_dir = &split_debian($binutils_vers);
	$gcc_dir = &parse_gcc_dir($host);
}
else
{
	$binutils_vers = &cache_version("binutils", $arch);
	$libc_latest = &find_latest_libc("libc", $arch, $suite);
	$gcc_vers = "gcc-" . $gcc_latest;
	$gcc_pkg_v = &cache_version($gcc_vers, $arch);
	$libc_vers = "libc" . $libc_latest;
	$libc_pkg_v = &cache_version($libc_vers, $arch);
	$binutils_dir = &split_debian($binutils_vers);
	$gcc_dir = &parse_gcc_dir($arch);
}
$dev = $libc_vers . "-dev";
$binutils_deb = "binutils-${target_gnu_type}_${binutils_vers}_${host}.deb";
@glibc_list=qw//;
@glibc_list2=qw//;
@glibc_list3=qw//;
$glibc_count = 0;
&check_source_version("binutils");
&check_source_version("linux-kernel-headers");
&check_source_version($libc_vers);
&check_source_version($gcc_vers);

$log = "\nThis is emchain $ourversion.\n Toolchain builder for cross compiling.\n\n";
print CYAN, $log, RESET if ($verbose >= 3);
$log = "Using : \n";
# catch errors where package-version does not match the unpacked directory name.
if(! -d "$gcc_dir")
{
	opendir(DIR, ".") or die ("Cannot open current directory: $!");
	my @dirs=readdir(DIR);
	closedir(DIR);
	foreach my $f (@dirs)
	{
		if ((-d $f) && ($f =~ /^$gcc_dir.*/) && (-d "$f/debian"))
		{
			$gcc_dir = $f;
		}
	}
}
$log .= "$gcc_vers ($gcc_pkg_v) in $gcc_dir/\n";
$log .= "binutils $binutils_vers in binutils-$binutils_dir/\n";
$log .= "$libc_vers v$libc_pkg_v\n";
print CYAN, $log, RESET if ($verbose >= 2);

# apt-get source will skip existing downloads if up to date.
$log = "Running apt-get source . . . \n";
print GREEN, $log, RESET if ($verbose >= 2);
if ($verbose < 2) { $aptcmd = "apt-get -q"; }
else { $aptcmd = "apt-get"; }
&set_suite($suite);
&check_cache_arch($arch);
my $config = &init_cache(0);
my $emp = AptCrossPackage->new();
$emp->Package($gcc_vers);
$emp = &lookup_pkg($emp);
my $gcc_src = $$emp->Version;
$log = "$aptcmd source $gcc_vers=$gcc_src binutils=$binutils_vers glibc=$libc_pkg_v";
print CYAN, "$log\n", RESET if ($verbose >= 2);
my $exitval = system "$log";
# catch all in case there was an unknown error.
exit($exitval) if ($exitval != 0);

print GREEN, "Running sudo - enter your sudo password if prompted.\n", RESET;

if (! -f $binutils_deb) {
	my $dir = &get_src_dir("binutils");
	my $cwd = cwd;
	chdir ($dir);
	&check_emdebian_control();
	print CYAN, "Building $binutils_deb in $cwd/$dir\n", RESET if ($verbose >= 2);
	system ("TARGET=$target_gnu_type fakeroot debian/rules binary-cross");
	chdir ("../");
	system ("sudo dpkg -i $binutils_deb") if ($forcing == 0);
}
# apt-cross also skips download/conversion of existing debs
# but does not skip installation. :-(
if ($verbose < 2) { $aptcmd = "apt-cross -i"; }
else { $aptcmd = "apt-cross -v -i"; }
# check with dpkg-cross --status for Status: install ok installed\n
$cmdline = &check_cross("libdb1-compat");
$cmdline .= &check_cross("$libc_vers");
$cmdline .= &check_cross("$dev");
$cmdline .= &check_cross("linux-kernel-headers");
# only run cmdline if there is something for apt-cross to do
if (($cmdline ne "") && ($forcing == 0))
{
	system("sudo $aptcmd -a $arch $cmdline");
}
$log = "";

push @glibc_list, "gcc-${gcc_latest}-${target_gnu_type}-base_${gcc_pkg_v}_${host}.deb";
push @glibc_list, "libstdc++${libc_latest}-${arch}-cross_${gcc_pkg_v}_all.deb";
push @glibc_list, "gcc-${gcc_latest}-${target_gnu_type}_${gcc_pkg_v}_${host}.deb";
push @glibc_list, "cpp-${gcc_latest}-${target_gnu_type}_${gcc_pkg_v}_${host}.deb";
push @glibc_list, "libgcc1-${arch}-cross_${gcc_pkg_v}_all.deb";
$glibc_count += scalar @glibc_list;

foreach $check (@glibc_list) {
	$log = "checking for $check\n";
	print CYAN, $log, RESET if ($verbose >= 3);
	if (-f $check) {
		$skip_gcc++;
	}
	else {
		$log = "missing $check\n";
		print CYAN, $log, RESET if ($verbose >= 2);
	}
}

push @glibc_list2, "g++-${gcc_latest}-${target_gnu_type}_${gcc_pkg_v}_${host}.deb";
push @glibc_list2,
	"libstdc++${libc_latest}-${gcc_latest}-dev-${arch}-cross_${gcc_pkg_v}_all.deb";

$glibc_count += scalar @glibc_list2;
foreach $check (@glibc_list2) {
	$log = "checking for $check\n";
	print CYAN, $log, RESET if ($verbose >= 3);
	if (-f $check) {
		$skip_gcc++;
	}
	else {
		$log = "missing $check\n";
		print CYAN, $log, RESET if ($verbose >= 2);
	}
}

push @glibc_list3,
	"libstdc++${libc_latest}-${gcc_latest}-pic-${arch}-cross_${gcc_pkg_v}_all.deb";
push @glibc_list3,
	"libstdc++${libc_latest}-${gcc_latest}-dbg-${arch}-cross_${gcc_pkg_v}_all.deb";

$glibc_count += scalar @glibc_list3;
foreach $check (@glibc_list3) {
	$log = "checking for $check\n";
	print CYAN, $log, RESET if ($verbose >= 3);
	if (-f $check) {
		$skip_gcc++;
	}
	else {
		$log = "missing $check\n";
		print CYAN, $log, RESET if ($verbose >= 2);
	}
}

if ($skip_gcc < $glibc_count) {
	die ("Cannot find $gcc_dir\n") if ( not -d "$gcc_dir");
	chdir ($gcc_dir);
	$environ = "GCC_TARGET=$arch DEB_CROSS=yes";
	system ("$environ debian/rules control");
	$log = "Building gcc in $gcc_dir . . . (this will take a while)\n";
	print GREEN, $log, RESET if ($verbose >= 2);
	$result = 0;
	$result = system "$environ dpkg-buildpackage -b -uc -us -rfakeroot";
	if ($result != 0) {
		print RED, "$progname: Build failed.", RESET;
		($logfile) ? print GREEN, " See $logfile for more info.\n", RESET : print "\n";
		if ($logfile)
		{
			close STDOUT;
			close STDERR;
			close BUILD;
			open STDOUT, ">&OLDOUT";
			open STDERR, ">&OLDERR";
		}
		die ("\n");
	}
	chdir ("../");
	foreach $result (@glibc_list)
	{
		$log = "$progname: Failed to create $result package\n";
		if (! -r $result)
		{
			if ($logfile)
			{
				close STDOUT;
				close STDERR;
				close BUILD;
				open STDOUT, ">&OLDOUT";
				open STDERR, ">&OLDERR";
			}
			die ($log);
		}
	}
	foreach $result (@glibc_list2)
	{
		$log = "$progname: Failed to create $result package\n";
		if (! -r $result)
		{
			if ($logfile)
			{
				close STDOUT;
				close STDERR;
				close BUILD;
				open STDOUT, ">&OLDOUT";
				open STDERR, ">&OLDERR";
			}
			die ($log);
		}
	}
	foreach $result (@glibc_list3)
	{
		$log = "$progname: Failed to create $result package\n";
		if (! -r $result)
		{
			if ($logfile)
			{
				close STDOUT;
				close STDERR;
				close BUILD;
				open STDOUT, ">&OLDOUT";
				open STDERR, ">&OLDERR";
			}
			die ($log);
		}
	}
	$log = "$gcc_vers ($gcc_pkg_v) built successfully.\n";
	print GREEN, $log, RESET if ($verbose >= 2);
	print CYAN, "Packages built when using --force are not installed automatically.", RESET if ($forcing == 1);
	if ($forcing == 0)
	{
		my $install = (join (' ', @glibc_list));
		$log = `sudo dpkg -i $install`;
		print $log if ($verbose >= 3);
		$install = (join (' ', @glibc_list2));
		$log = `sudo dpkg -i $install`;
		print $log if ($verbose >= 3);
		$install = (join (' ', @glibc_list3));
		$log = `sudo dpkg -i $install`;
		print $log if ($verbose >= 3);
	}
}
if ($logfile)
{
	close STDOUT;
	close STDERR;
	close BUILD;
	open STDOUT, ">&OLDOUT";
	open STDERR, ">&OLDERR";
}

# end : show confirmation.
die ("Force used! Toolchain might not be usable!\n") if ($forcing == 1);
print GREEN, "\nSuccess! \nInstalled toolchains:\n\n", RESET;
my $all_vers = $gcc_vers;
$all_vers =~ s/gcc/'\?\?\?'/;
$all_vers .= "* 'libstdc*' 'libc6*' 'libgcc1*' 'linux-kernel-headers*'";
my $success = `dpkg -l 'binutils*' $all_vers`;
my @s = split (/\n/, $success);
foreach my $s (@s)
{
	if ($s =~ /^ii +(.*)/)
	{
		print "$1\n";
	}
}
print "\n";
exit 0;

# subroutines.
sub check_cross()
{
	# needs a versioned check!
	# TODO the format has changed!
	$log = "checking dpkg-cross status for $_[0] on $arch . . . ";
	$status = `apt-cross -a $arch -s $_[0]`;
	if ((!$status =~ /Status: install ok installed\n/g) || (!$status))
	{
		$log .= "\n$_[0] cross-build not installed yet. Installing ...\n";
		print $log if ($verbose >= 2);
		return "$_[0] ";
	}
	else {
		$log .= "installed ok.\n$status";
	}
	print $log if ($verbose >= 2);
	return "";
}

sub split_debian()
{
	return "" if (!$_[0]);
	$_[0] =~ /([0-9\.a-z]*)-[0-9].*/;
	return $1;
}

sub cache_version()
{
	my $result;
	if ($forcing == 0)
	{
		$result = &binlookup($_[0]);
		return $result->{VerStr};
	}
	else
	{
		$result = `apt-cache show $_[0] 2>/dev/null`;
	}
	$result =~ /Version: (.*)/g;
	return $1;
}

sub check_source_version()
{
	# check the SOURCE version of the main apt cache
	my $main_src = `apt-cache showsrc $_[0] 2>/dev/null`;
	return if (!$main_src);
	$main_src =~ /Version: (.*)\n/g;
	$main_src = $1;

	# compare with the BINARY version of the arch selected.
	my $cross_src = &binlookup($_[0]);
	my $cross_ver = $cross_src->{VerStr};
	if ($main_src ne $cross_ver) {
		my $msg = "\n$progname: Error. Mismatch in source versions\n";
		$msg .= "$arch does not appear to have built version $main_src of $_[0] successfully yet.";
		$msg .= " Therefore it is unlikely that $progname will be able to build a usable cross-compiler";
		$msg .= " using the current upstream source of $_[0]. Only version $cross_ver is available on";
		$msg .= " $arch and $progname is unable to proceed.\n";
		$msg .= "Please run $progname again when the $arch port has updated.\n";
		if ($logfile)
		{
			close STDOUT;
			close STDERR;
			close BUILD;
			open STDOUT, ">&OLDOUT";
			open STDERR, ">&OLDERR";
		}
		($forcing == 0) ? die (RED, wrap('','',$msg), RESET, "\n")
			: print CYAN, wrap('','',"$msg\nForce enabled, trying to continue ...\n"), RESET;
		print GREEN, "Forced packages will not be installed by $progname.\n", RESET
			if ($forcing == 1);
	}
}

sub parse_gcc_dir()
{
	my $result;
	my $r;
	my $dir;
	if ($forcing == 0)
	{
		$result = &binlookup($gcc_vers);
		$dir = $result->{VerStr};
	}
	else
	{
		$result = `apt-cache show $gcc_vers 2>/dev/null`;
		return "" if (!$result);
		$r = $result;
		$r =~ /Version: (.*)\n/g;
		$dir = $1;
	}
	my $dsc = "${gcc_vers}_${dir}.dsc";
	$dsc =~ s/\n//;
	my $pat = "${gcc_vers}_.*orig\.tar.*";
	my $orig;
	if ( -f $dsc)
	{
		open (F, "$dsc");
		while(<F>)
		{
			if (/$pat/)
			{
				$orig = $_;
			}
		}
	}
	if (defined $orig)
	{
		$orig =~ s/\.orig\.tar\..*//;
		$orig =~ s/.* //;
		$orig =~ s/\_/\-/;
		$orig =~ s/\n//;
		return $orig if (-d $orig);
	}
	# less favourable method.
	if (! -d $dir) {
		$r = $result;
		$r =~ /Source: $gcc_vers \((.*)\)\n/;
		my $t = &split_debian($1);
		if (-d "$gcc_vers-$t") {
			return "$gcc_vers-$t"
		}
	}
	return "$gcc_vers-$dir";
}

sub get_src_dir()
{
	my $pkg=$_[0];
	my $res = &binlookup($pkg);
	my $dir = $res->{VerStr};
	$dir =~ s/-.*\n?$//;
	return "$pkg-$dir";
}
