#!/usr/bin/perl
#
#  emchain -- toolchain builder for cross compiling
#  Copyright (C) 2006-2008  Neil Williams <codehelp@debian.org>
#  Copyright (c) 2007 Simon Richter <sjr@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 Text::Balanced qw(extract_bracketed);
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 $ignore
*OLDOUT *OLDERR $forcing $arglog $logdir $uclibc $uclibc_vers
$binutils_cross $binutils_pkg/;

$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");
$logdir = cwd;
$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]
 emchain [-a|--arch ARCH] [-w|--workdir] [-l|--log] [-v|--verbose] [-q|--quiet] -f|--force
 emchain [-a|--arch ARCH] [-w|--workdir] [-l|--log] [-v|--verbose] [-q|--quiet] -u|--uclibc
 emchain [-a|--arch ARCH] [-w|--workdir] [-l|--log] [-v|--verbose] [-q|--quiet] -i|--ignore
 emchain -?|-h|--help|--version

Commands:
 -f|--force:          continue the build even if the upstream native build has failed.
 -i|--ignore:         ignore the installed toolchain and build another one.
 -u|--uclibc:         attempt to create a uClibc toolchain link from the existing
                       gcc/eglibc toolchain. (Experimental!)

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross).
 -w|--workdir DIR:    override the current working directory setting .
 -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;
	}
	elsif (/^(-u|--uclibc)$/) {
		$uclibc = 1;
	}
	elsif (/^(-i|--ignore)$/) {
		$ignore = 1;
	}
}

$msg = "$progname: no default architecture found.\n";
$msg .= "Please use '$progname --arch ARCH'.\n";
die $msg if ((!$arch)||($arch eq ""));
my $target_gnu_type = &check_cache_arch($arch);
$logfile = "emchain-" . $arch . "-" . $date . ".log" if ($arglog == 1);
if (defined $logfile and -f $logfile and $arglog == 1)
{
	my $time = `date +%H-%M`;
	chomp ($time);
	$logfile = "emchain-" . $arch . "-" . $date . "-" . $time . ".log"
}
&set_verbose($verbose);

if (not defined $uclibc)
{
	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)! ",
		"Nothing to do. See emsetup (1).\n"), RESET, "\n";
		exit(0);
	}
}

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", RESET, "\n";
}

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";
}

&setup_config;
$msg = "Checking apt-cross $suite cache for $arch.\n";
print CYAN, $msg, RESET if ($verbose >= 2);
my $val = &get_primary;
&set_mirror("ftp://$val/debian") if (defined $val);
&check_update($verbose);

# prepare variable names.
$skip_gcc = 0;
$skip_binutils = 0;
$skip_libc = 0;
$host = &host_arch("binutils");
$gcc_latest =  &find_latest_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($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);
}

if (defined $uclibc)
{
	&uclibc_build_chain;
	exit (0);
}
elsif (not defined $ignore)
{
	my $check = &check_toolchains ($arch, $target_gnu_type);
	$msg = "$progname: You already have a usable toolchain installed ";
	$msg .= "for $arch on $suite using eglibc. Use '$progname -a $arch --ignore' ";
	$msg .= " if you want to build the toolchain again or ";
	$msg .= "'$progname -a $arch --uclibc' if you want the uClibc extension.\n";
	if ($check eq "true")
	{
		system ("emsetup -a $arch --report");
		warn RED, wrap('','',"\n$msg"), RESET, "\n";
		exit (1);
	}
}

$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 eglibc=$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");
	# Drop depends on gcc-*-TRIPLET-base
	open (CTRL, "debian/control") or die ("Cannot read debian/control!: $!\n");
	my @ctrl=<CTRL>;
	close (CTRL);
	my @out=();
	foreach my $deps (@ctrl)
	{
		$deps =~ s/gcc-${gcc_latest}-${target_gnu_type}-base \(= \${gcc:Version}\),//g;
		push @out, $deps;
	}
	open (CTRL, ">debian/control") or die ("Cannot write debian/control!: $!\n");
	print CTRL @out;
	close (CTRL);
	$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 $logdir/$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};
	$cross_ver =~ /(.*)(\+b.*$)/g; 
	$cross_ver = $1;
	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;
		if (! -d $dir)
		{
			$dir =~ s/-[0-9]+$//;
		}
	}
	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";
}

sub uclibc_add_alias
{
	$_ = shift;
	my $src = shift;
	my $tgt = shift;
	s/^(([^!{]*\|)*static-libgcc)((\|[^:|]*)*:)/$1|uclibc$3/;
	s/^(!static-libgcc:)(.*)$/$1\%{!uclibc:$2}/;
	my $ret;
	for(;;)
	{
		my @res = extract_bracketed($_, '{}', '[^{]*');
		if(!$res[0])
		{
			$ret .= $_;
			return $ret;
		}
		$ret .= $res[2];
		my $child = $res[0];
		$child =~ s/^{(.*)}$/$1/;
		$ret .= '{' . &uclibc_add_alias($child, $src, $tgt) . '}';
		$_ = $res[1];
	}
}

sub uclibc_munge_specs
{
	print GREEN, "Converting gcc specs for use with uClibc.\n", RESET
		if ($verbose >= 1);
	my @s = split(/\n/, shift);
	my @ret = ();
	foreach my $line (@s)
	{
		if($line =~ /^\*([0-9A-Za-z_]*):$/)
		{
			push @ret, $line;
			next;
		}
		$line =~ s/(\%{I\*[^}]*})/$1 \%{uclibc:-I\/usr\/$arch\/include}/g;
		$line =~ s/(\%{L\*[^}]*})/$1 \%{uclibc:-L\/usr\/$arch\/lib}/g;
		$line =~ s/((S|g|)crt(0|1|i|n)(.o|\%O))(\%s)?/\%{uclibc:\/usr\/$arch\/lib\/$1;:$1$5}/g;
		$line =~ s/(\/lib\/ld-linux.so.2)/\%{uclibc:\/lib\/ld-uClibc.so.0;:$1}/g;
		if($line =~ /static-libgcc/)
		{
			# "uclibc" behaves like "static-libgcc"
			$line = &uclibc_add_alias($line, 'uclibc', 'static-libgcc');
		}
		push @ret, $line;
	}
	return join("\n", @ret);
}

sub uclibc_translate_triplet
{
	my $glibc_triplet = shift;
	return undef unless (defined $glibc_triplet);
	my $uclibc_triplet = $glibc_triplet;
	$uclibc_triplet =~ s/([[:alnum:]]*)-([[:alnum:]]*)-gnu(.*)/$1-$2-uclibc$3/;
	return undef if($glibc_triplet eq $uclibc_triplet);
	return $uclibc_triplet;
}

# generate a fake binutils package with the correct target triplet
sub uclibc_build_binutils
{
	my $uclibc_target = shift;
	return unless (defined $uclibc_target);
	my $binutils_pkg = "binutils-${uclibc_target}";
	print GREEN, "Building $binutils_pkg for $uclibc_target\n", RESET
		if ($verbose >= 2);
	system ("mkdir -p debian/${binutils_pkg}/usr/bin");
	system ("mkdir -p debian/${binutils_pkg}/usr/share/doc/${binutils_pkg}");
	my (@binutils) = `dpkg -L binutils-${target_gnu_type}`;
	foreach my $file (@binutils)
	{
		chomp($file);
		next unless $file =~ m:/usr/bin/${target_gnu_type}:;
		$file =~ s:/usr/bin/${target_gnu_type}-::;
		print CYAN, "symlinking : $file\n", RESET if ($verbose >= 3);
		unlink ("debian/${binutils_pkg}/usr/bin/${uclibc_target}-$file") if
			(-f "debian/${binutils_pkg}/usr/bin/${uclibc_target}-$file");
		my $e = symlink $file, "debian/${binutils_pkg}/usr/bin/${uclibc_target}-$file";
	}
	$uclibc_vers = $binutils_vers;
	mkdir ("debian/${binutils_pkg}/DEBIAN");
	open (CTRL, ">debian/control");
	print CTRL &uclibc_control_info ("$binutils_pkg");
	close (CTRL);
	system ("dpkg-gencontrol -p${binutils_pkg} -Pdebian/${binutils_pkg} ".
		"-cdebian/control");
	system ("dpkg-deb --build debian/${binutils_pkg} ..");
	`rm -rf ./debian` if (-d "debian");
	# end of binutils package.
	if ( -f "$workdir/${binutils_pkg}_${binutils_vers}_all.deb")
	{
		print GREEN;
		system ("ls -l $workdir/${binutils_pkg}_${binutils_vers}_all.deb");
		print RESET."\n";
	}
}

sub uclibc_build_chain
{
	my $check = &check_toolchains($arch, $target_gnu_type);
	# mismatch of host arches. Make sure that this also catches non-ia32 mismatches
	if ($check ne "true" and $arch eq "i386") {# and `dpkg-architecture -qDEB_BUILD_ARCH -ei386 2> /dev/null`) {

		# check is true since in this particular case (where
		# dpkg-architecture -qDEB_BUILD_ARCH -ei386
		# or other -e ) we have to check for these packages instead:
		# gcc, binutils, etc. i.e. the native ones.
		$check = "true";
		# getting ugly. While distinct subarches, they are treated
		# the same for ia32.
		# See: COLUMNS=150 dpkg -l "gcc-???-i?86-linux-*" | awk '{if (/gcc/)print $2}'
		# gcc-4.2-i486-linux-gnu-base
		# gcc-4.3-i486-linux-gnu
		# gcc-4.3-i486-linux-uclibc
		# i.e. nothing for i386 (the primary arch name) but only for
		# subsrches! Thus prevent havoc:
		$arch="i486";
	}
	if ($check ne "true")
	{
	# need to identify the relevant gcc version from the installed toolchain.
		my @dpkg_gcc = `dpkg -l "gcc-???-$arch-linux-gnu"`;
		my %gcc_list=();
		my $choice = 0;
		foreach my $install (@dpkg_gcc)
		{
			next unless $install =~ /^ii/;
			$install =~ s/^ii\s+//;
			$install =~ s/ +/ /g;
			my @bits = split(/ /, $install);
			if ($bits[0] =~ /gcc-([0-9\.]+)\-${target_gnu_type}$/)
			{
				if ($1 > $choice)
				{
					$choice = $1;
					$gcc_list{$choice}=$bits[1];
				}
			}
		}
		die ("check_toolchains failed") if ($choice == 0);
		$gcc_latest = $choice;
		$gcc_pkg_v = $gcc_list{$choice};
		my @dpkg_binutils = `dpkg -l "binutils-$arch-linux-gnu"`;
		foreach my $install (@dpkg_gcc)
		{
			next unless $install =~ /^ii/;
			$install =~ s/^ii\s+//;
			$install =~ s/ +/ /g;
			my @bits = split(/ /, $install);
			$binutils_vers = $bits[1];
		}
		print "binutils_vers=$binutils_vers\n";
	}
	print CYAN, wrap ('','',"Creating uclibc toolchain packages for :",
		"$target_gnu_type in $workdir\n"), RESET if ($verbose >= 1);
	my $dir = "uclibc-${target_gnu_type}";
	mkdir ($dir) if (! -d "debian");
	chdir($dir);
	`rm -rf ./debian` if (-d "debian");
	my $uclibc_target = &uclibc_translate_triplet($target_gnu_type);
	my $gcc_package = "gcc-${gcc_latest}-${uclibc_target}";
	$binutils_pkg = "binutils-${uclibc_target}";
	my $gpp_package = "g++-${gcc_latest}-${uclibc_target}";
	# cross-gcc Depends:
	$binutils_cross = "binutils-${target_gnu_type}";
	# Check if we are doing a cross-compiler for a different libc or subarch
	my $host_arch = `dpkg-architecture -qDEB_BUILD_ARCH`;
	my $tgt_arch = $arch;
	$tgt_arch =~ s/i.86/i386/;
	chomp($host_arch);
	if ($host_arch eq $tgt_arch) {
		# Setup the Depends: field of the fake-gcc we are about to build
		# - We are using the same arch.
		# - Binutils is libc-agnostic
		# - Binutils can generate code for all subarches, so we
		#   can cater for the inexactness later on via flags.
		$binutils_cross = "binutils";
		$binutils_pkg   = "binutils";
	} else {
		# generate a faked package with the needed target triplet
		&uclibc_build_binutils(${uclibc_target});
	}
	print GREEN, "Building $gcc_package for $uclibc_target\n", RESET
		if ($verbose >= 2);
	system ("mkdir -p debian/${gcc_package}/usr/bin");
	system ("mkdir -p debian/${gcc_package}/usr/share/doc/${gcc_package}");
	my $gcc_shell = "debian/${gcc_package}/usr/bin/${uclibc_target}-gcc";
	open(GCC, ">$gcc_shell");
	print (GCC "#!/bin/sh\n");
	print (GCC "${target_gnu_type}-gcc -uclibc \"\$\$@\"\n");
	close (GCC);
	chmod (0755, $gcc_shell);
	my @search = `${target_gnu_type}-gcc -print-search-dirs`;
	my $target_compiler;
	foreach my $dir (@search)
	{
		next unless $dir =~ /^install: /;
		$dir =~ s/install: //;
		$target_compiler = $dir;
		chomp($target_compiler);
	}
	die unless (defined $target_compiler);
	print GREEN, "Creating target_compiler directory tree : $target_compiler\n",
		RESET if ($verbose >= 3);
	system ("mkdir -p debian/${gcc_package}/${target_compiler}");
	my $gccspecs = `$arch-linux-gnu-gcc -dumpspecs`;
	my $s = &uclibc_munge_specs($gccspecs);
	open (SPECS, ">debian/${gcc_package}/${target_compiler}/specs");
	print SPECS "$s\n";
	close (SPECS);
	mkdir ("debian/${gcc_package}/DEBIAN");
	open (PREINST, ">debian/${gcc_package}/DEBIAN/preinst") or die (
	"Cannot create debian/$gcc_package/DEBIAN/preinst: $!");
	print PREINST "#!/bin/sh\n";
	print PREINST "dpkg-divert --package ${gcc_package} --add --rename --divert ${target_compiler}specs.glibc ${target_compiler}specs\n";
	close (PREINST);
	chmod (0755, "debian/${gcc_package}/DEBIAN/preinst");
	open (POSTRM, ">debian/${gcc_package}/DEBIAN/postrm");
	print POSTRM "#!/bin/sh\n";
	print POSTRM "dpkg-divert --package ${gcc_package} --rename --remove ${target_compiler}specs\n";
	close (POSTRM);
	chmod (0755, "debian/${gcc_package}/DEBIAN/postrm");
	open (CTRL, ">debian/control");
	$uclibc_vers = $gcc_pkg_v;
	print CTRL &uclibc_control_info ("$gcc_package");
	close (CTRL);
	system ("dpkg-gencontrol -p${gcc_package} -Pdebian/${gcc_package} ".
		"-cdebian/control");
	system ("dpkg-deb --build debian/${gcc_package} ..");
	if ( -f "$workdir/${gcc_package}_${gcc_pkg_v}_all.deb")
	{
		print GREEN;
		system ("ls -l $workdir/${gcc_package}_${gcc_pkg_v}_all.deb");
		print RESET, "\n";
	}
}

sub uclibc_control_info
{
	my ($target, $target_gcc_vers, $target_arch, $std_ver);
	$std_ver = &get_standards_version;
#	echo >>debian/$(cross_package).substvars 'target:GCCVersion=$(shell dpkg -s
# gcc-4.1-$(glibc_target) | sed -ne "s/Version: //p")'
	$target = shift;
	$target_gcc_vers = $gcc_pkg_v;
#	$target_arch = "foo";
	my $maint = defined($ENV{DEBFULLNAME}) ? $ENV{DEBFULLNAME} : "Simon Richter";
	$maint .= defined($ENV{DEBEMAIL}) ? " <".$ENV{DEBEMAIL}.">" : '<sjr@debian.org>';
	print CYAN, "changelog maintainer : $maint\n", RESET if ($verbose >= 2);
	my $pkgpath = "debian/${target}";
	my $docpath = "/usr/share/doc/${target}/";
	unlink ("${pkgpath}${docpath}/changelog");
	unlink ("${pkgpath}${docpath}/copyright");
	&uclibc_changelog("$target");
	open (COPY, "<debian/changelog");
	my @c=<COPY>;
	close (COPY);
	open (CLOG, ">${pkgpath}${docpath}/changelog");
	print CLOG @c;
	close (CLOG);
	unlink ("${pkgpath}${docpath}/changelog.gz");
	`gzip -9 "${pkgpath}${docpath}/changelog"`;
	print CYAN, "Auto-generating copyright information.\n", RESET if ($verbose >= 2);
	open (COPY, ">${pkgpath}${docpath}/copyright");
	print COPY &uclibc_copyright;
	close (COPY);
	my $ctrl = qq%Source: ${target}
Section: devel
Priority: extra
Maintainer: $maint
Build-Depends: debhelper (>= 5)
Standards-Version: $std_ver

Package: ${target}
Architecture: all%;
	if ($target =~ /^binutils/)
	{
		$ctrl .= qq%
Depends: ${binutils_cross}
Description: binutils support for building against uClibc
 This package provides wrapper scripts for the toolchain, providing an
 alternate host triplet for building against uclibc.
%;
	}
	if ($target =~ /^gcc/)
	{
		$ctrl .= qq%
Depends: gcc-${gcc_latest}-${target_gnu_type} (= ${gcc_pkg_v}),
 libuclibc-dev-${arch}-cross, ${binutils_pkg}
Description: Toolchain alias for building against uclibc
 This package provides wrapper scripts for the toolchain, providing an
 alternate host triplet for building against uclibc.
%;
	}
	return $ctrl;
}

sub uclibc_changelog
{
	my $name = defined($ENV{DEBFULLNAME}) ? $ENV{DEBFULLNAME} : "Simon Richter";
	my $email .= defined($ENV{DEBEMAIL}) ? $ENV{DEBEMAIL} : 'sjr@debian.org';
	my $maint = "$name <$email>";
	my $cross_package = shift;
	# dch doesn't support entirely automated changelogs from new :-(
	open (CLOG, ">debian/changelog");
	print CLOG "$cross_package ($uclibc_vers) UNRELEASED; urgency=low\n\n";
	print CLOG "  * Automated package.\n\n";
	print CLOG " -- $maint  Sat, 29 Mar 2008 14:22:41 +0000\n";
	close (CLOG);
	# ensure the timestamp is updated.
	`DEBFULLNAME="$name" DEBEMAIL="$email" dch -r automated package`;
}

sub uclibc_copyright
{
	my $copy = qq%This package was automatically generated by emdebian-tools for use with uClibc.

Files: *
Licence: GPL-2+
Copyright: 2007-2008 Neil Williams <codehelp\@debian.org>
           2007-2008 Simon Richter <sjr\@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; version 2 dated June, 1991, or
   (at your option) any later version.

   This package 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 package; if not, write to the Free Software
   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
   MA 02110-1301, USA.

On Debian systems, the complete text of the GNU General
Public License can be found in `/usr/share/common-licenses/GPL-2'
%;
	return $copy;
}