#!/usr/bin/perl -w

#  emdebuild -- Emdebian version of debuild
#
# Checks if a package is emdebianised and runs em_make if not.
# Otherwise, updates emdebian-rules.patch,
# rebuilds the package using dpkg-buildpackage -sa -rfakeroot -a$arch
# and generates a debuild-style build log.
#
#  Copyright 2006-2007 Neil Williams <codehelp@debian.org>
#  Copyright 1998-2006 Craig Small <csmall@debian.org>
#  Copyright 1999-2003 Julian Gilbey <jdg@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/>.
#

# note: running debian/rules alone is unsupported due to the cross-build.

# Most debuild options are not supported - in particular, lintian and linda are not
# supported.

use Carp;
use Cwd;
use Debian::Debhelper::Dh_Lib;
use Debian::DpkgCross;
use Emdebian::Tools;
use File::HomeDir;
use Text::Diff;
use Text::Wrap;
use Term::ANSIColor qw(:constants);
use strict;
use warnings;
use vars qw/@packages $username $email $date $native $emdebvers $emN
$addsource $progname $arch $verbose @options $dpkg_extra $conf $home
$changes $ourversion $emvers $increment $source $vers $svnci $dosign
$onlysvn *BUILD *OLDOUT *OLDERR %archtable $numchecks $omitarchcheck
$host /;

$ourversion = &tools_version();
$progname = basename($0);

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

Usage:
 emdebuild [-a|--arch ARCH] [-n|--next] [--svn] [--sign] [-v|--verbose] [-q|--quiet]
 emdebuild [--svn-only] [-v|--verbose] [-q|--quiet]
 emdebuild --build-dep
 emdebuild -?|-h|--help|--version

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross)
 -n|--next:           Increment the emdebian version before building.
    --svn:            Build package and commit changes to emdebian patches
    					to emdebian SVN if successful (requires developer access).
    --svn-only:       Commit changes to emdebian patches to emdebian SVN.
    --sign:           Use 'debsign' on the .changes file.
 -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

emdebuild is the emdebian version of debuild. After a Debian
package has been 'emdebianised' with em_make, emdebuild provides
a convenient wrapper around dpkg-buildpackage.

emdebuild needs to be run in the source directory of the package.

By default, emdebuild cross-builds the package for the dpkg-cross
default architecture. Specify other architectures with -a|--arch.
Ensure the current toolchain is installed for the chosen architecture.

Only automated builds would normally use --quiet, most users are
advised to use --verbose.

If the source is prepared using 'emsource', changes to the emdebian
patch files can be committed to emdebian svn using the --svn option.

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

$verbose = 1;
$increment = 0;
$numchecks = 0;
my $dpkg_opts_var = 'DEBUILD_DPKG_BUILDPACKAGE_OPTS';
my $dpkg_options = " noudeb nodocs nocheck";
$svnci = "false";
# This is NOT the apt-cross or dpkg-cross dir, just for .devscripts.
$home = File::HomeDir->my_home;
$home = cwd if (!$home);
&read_config();
$arch = &get_architecture();
$addsource = "";
$dosign = "false";
$onlysvn = "false";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion;
		exit( 0 );
	}
	elsif (/^(--build-dep|--build-deps)$/) {
		&crossbuilddeps;
		exit (0);
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-n|--next)$/) {
		$increment = 1;
	}
	elsif (/^(--svn)$/) {
		$svnci = "true";
	}
	elsif (/^(--sign)$/) {
		$dosign = "true";
	}
	elsif (/^(--svn-only)$/) {
		$onlysvn = "true";
	}
}

my $target_gnu_type = &check_arch($arch);
if ((not defined $arch)||($arch eq "")||(not defined $target_gnu_type))
{
	warn (RED, "\n$progname: Cannot determine the architecture to build.", RESET, "\n\n");
	&usageversion;
	exit (1);
}

$host = `dpkg-architecture -qDEB_HOST_GNU_CPU`;
$host =~ s/_/-/;
chomp($host);
$omitarchcheck = ($host eq $arch) ? 1 : 0;
my $omitmsg = "$arch is the host architecture, omitting the architecture ";
$omitmsg .= "checks for this build.\n";
print GREEN, wrap('','',$omitmsg), RESET unless ($omitarchcheck == 0);

my @config_files = ('/etc/devscripts.conf', "$home/.devscripts");
$dpkg_extra = "";
foreach $conf (@config_files)
{
	my $val;
	next if (! -f $conf);
	print CYAN, "Reading devscripts configuration in $conf.\n", RESET if ($verbose >= 3);
	open (CONF, $conf) or warn "Cannot read $conf: $!\n";
	@options=<CONF>;
	close CONF;
	foreach $val (@options)
	{
		if ($val =~ /^$dpkg_opts_var="(.*)"\n$/)
		{
			$dpkg_extra .= " " . $1;
		}
	}
}

print CYAN, "Checking for debian/control\n", RESET if ($verbose >= 2);
&check_emdebian_control;
my $cachefile = "emdebian-${target_gnu_type}.cache.patch";
if ($onlysvn eq "true")
{
	# exit the working directory first.
	chdir ("../") if ( -f "debian/control");
	# cannot pass $build here - determining the build log filename
	# may involve changing the patch files or emdebian version.
	# globbing may be unreliable.
	&handle_svn('',$cachefile);
	exit;
}
&init;
@packages = getpackages();
$native = isnative($dh{MAINPACKAGE});
my $package = $dh{MAINPACKAGE};
my $parse = `parsechangelog`;
$parse =~ /Source: (.*)\n/;
$source = $1;
$source = $dh{MAINPACKAGE} if (!$source);
$parse =~ /(Version: .*)\n/;
my $deb_version = $1;
print GREEN, "Building '$source' for $arch on $host.\n", RESET if ($verbose >= 1);

$emvers = &extract_emdebversion($deb_version);

if ($emvers eq "")
{
	# run em_make via the emdebian-tools package.
	my $maker = ($verbose >= 2) ? "em_make -v -a $arch" : "em_make -a $arch";
	( -f "/usr/bin/em_make") ? system "$maker" :
		die (RED, "Please run em_make before emdebuild.", RESET, "\n");
	$emvers = &extract_emdebversion($deb_version);
}
if ($emvers eq "em1")
{
	my $orig_msg = "New emdebian release detected, using '-sa' to include .orig.tar.gz\n";
	print GREEN, wrap('','',$orig_msg), RESET if ($verbose >=2);
	$addsource = '-sa';
}

if ($increment)
{
	print GREEN, "Incrementing emdebian version.\n", RESET if ($verbose >= 2);
	$vers = emdeb_versionstring("next");
	system "debchange -p -v $vers \"New emdebian release.\"";
}

# update the patches to reflect any manual changes.
# this includes copying patches added to debian/patches
&create_patches($source);

# ensure any hand-edited cache file is preserved - debian/rules will need it.
if (-f "${target_gnu_type}.cache")
{
	print CYAN, "Protecting cache file ${target_gnu_type}.cache . . \n", RESET if ($verbose >=2);
	my $file = "${target_gnu_type}.cache";
	# protect the cache file
	chmod 0444, $file;
	my $cwd = cwd;
	my $working = basename($cwd);
	chdir ("../$source.old/");
	# ensure the patch works from an empty cache file in .old
	open (CPY, ">$file") or die "Cannot write ../$source.old/$file: $!";
	close CPY;
	chdir ("../");
	my $diff = diff "$source.old/$file", "$working/$file", { STYLE => "Unified" };
	open (PATCHFILE, ">emdebian-$file.patch") or warn ("Cannot open emdebian-$file.patch : $!\n");
	print PATCHFILE $diff;
	close (PATCHFILE);
	chdir ("$cwd");
	print GREEN, "$file backed up to ../$source.old/\n", RESET if ($verbose >=2);
}

$emvers = &emdeb_versionstring("next") if ($increment);
$emvers = &emdeb_versionstring("") if (!$increment);
$changes = "${source}_${emvers}_${arch}.changes\n";
# noepoch = version without epoch and colon
my $noepoch = "";
if ($emvers =~ /^[0-9]?:.*/)
{
	$emvers =~ /^[0-9]?:(.*)/;
	$noepoch = $1;
	$changes = "${source}_${noepoch}_${arch}.changes\n";
}
my $build="${source}_${emvers}_${arch}.build";
print CYAN, "Logging build messages to ../$build\n", RESET if ($verbose >= 2);

# setup gccross here.
my $dpkgcrosspath = "/usr/share/dpkg-cross/bin";
my $crossprefix = &check_arch($arch);
my $crossbin = `mktemp -d -t gccross.XXXXXXXXXX`;
chomp($crossbin);
print GREEN, "Using gccross symlinks in $crossbin.\n", RESET if ($verbose >= 2);
my $path = $ENV{PATH};
$ENV{PATH} = "$dpkgcrosspath:$path";
my @pdirs = split (/:/, $ENV{PATH});
foreach my $d (@pdirs)
{
	next if (-l "$d");
	my @pathfiles = ();
	next unless ( -d $d);
	opendir (PDIR, $d) or warn ("unable to read $d");
	@pathfiles=grep(!/^\.\.?$/, readdir PDIR);
	closedir (PDIR);
	foreach my $file (@pathfiles)
	{
		next if ("$file" eq "gccross");
		next if ( not -x "$d/$file");
		next if ( -z "$d/$file");
		next if ( -d "$d/$file");
		if ($file =~ /^$crossprefix\-(gcc|cpp|c\+\+|g\+\+|cc|CC)(\-[.0-9]+)*/)
		{
			print GREEN, "symlinking $file to gccross\n", RESET if ($verbose >= 3);
			system ("ln -s $dpkgcrosspath/gccross $crossbin/$file\n")
		}
	}
}
$path = $ENV{PATH};
$ENV{PATH} = "$crossbin:$path";
$ENV{USRLIBDIR}="/usr/$crossprefix/lib";
my @librarypaths = qw( /lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64
	/emul/ia32-linux/lib /emul/ia32-linux/usr/lib );
my @shlibdeps = ( "${crossprefix}/lib", "/usr/${crossprefix}/lib",
	"/${crossprefix}/lib32", "/usr/${crossprefix}/lib32",
	"/${crossprefix}/lib64", "/usr/${crossprefix}/lib64",
	"/emul/ia32-linux/lib", "/emul/ia32-linux/usr/lib" );
my $libpath = join (":", @librarypaths) . join (":", @shlibdeps);
$ENV{LD_LIBRARY_PATH}.="$libpath";
# work around for packages that are Architecture: all with a .pc file
# (like gnome-mime-data) by checking /usr/share/pkgconfig/ too.
$ENV{PKG_CONFIG_LIBDIR}="/usr/$crossprefix/lib/pkgconfig/:/usr/share/pkgconfig/";
$ENV{CONFIG_SITE}="/etc/dpkg-cross/cross-config.$arch";
$path = $ENV{PATH};
$ENV{PATH}="$path:/usr/$crossprefix/bin/";
print GREEN, "PATH reset to $ENV{PATH}\n", RESET if ($verbose >= 2);
system ("dpkg-architecture -a$arch");

# Always create .build logs, emulate how debuild works
# dpkg-buildpackage doesn't log by default!
# from debuild:
# Start by duping STDOUT and STDERR
open OLDOUT, ">&STDOUT" or croak "cannot duplicate stdout: $!\n";
open OLDERR, ">&STDERR" or croak "cannot duplicate stderr: $!\n";
open BUILD, "| tee ../$build" or croak "could not open pipe to tee $build: $!";
close STDOUT;
close STDERR;
open STDOUT, ">&BUILD" or croak "cannot reopen stdout: $!";
open STDERR, ">&BUILD" or croak "cannot reopen stderr: $!";
# prepare the dpkg-buildpackage command and environment
my $cmd .= "DEB_BUILD_OPTIONS='$dpkg_options' dpkg-buildpackage ";
$cmd .= "-a$arch $addsource -rfakeroot -d $dpkg_extra -uc -us\n";
my $msg = "Building ${source} ${emvers} for ${arch} with $cmd";
print CYAN, wrap('','',$msg), RESET if ($verbose >= 2);
# build the package here:
my $exitval = 0;
# comment out the next line for quick debugging.
$exitval = system "$cmd";
# return things to normal before aborting with any dpkg errors
close STDOUT;
close STDERR;
close BUILD;
open STDOUT, ">&OLDOUT";
open STDERR, ">&OLDERR";
`rm -rf $crossbin`;
exit $exitval if ($exitval);

chmod 0644, "${target_gnu_type}.cache" if (-f "${target_gnu_type}.cache");

#  RUN BASIC CHECKS
print CYAN, "Running build checks ....\n", RESET;

# check that we actually packaged binaries for the right arch, for
# /usr/bin at least. (Faulty toolchains could cause these errors
# as well as incomplete changes to debian/rules.)
opendir(CH, "debian/");
my @dirs=grep(/[^\.?\.]/, readdir(CH));
closedir(CH);

print GREEN, wrap ('','',"Checking if ELF executables were built for: $arch\n"), RESET
	if ((scalar @dirs) > 0) && ($omitarchcheck == 1) && ($verbose >= 2);
foreach my $d (@dirs)
{
	my $hostc = 0;
	my $target = 0;
	my $c = 0;
	my @f = ();
	next unless ( -d "debian/$d");

	# use ^ to demarcate the array as it cannot be in a package name
	my @checkdirs=qw^ bin/ usr/bin/ usr/sbin/ sbin/^;
	foreach my $check_dir (@checkdirs)
	{
		next unless ( -d "debian/$d/$check_dir");
		opendir(BIN, "debian/$d/$check_dir") or next;
		@f=grep(/[^\.?\.]/, readdir(BIN));
		closedir(BIN);
		foreach my $binfile (@f)
		{
			next unless ( -f "debian/$d/$check_dir/$binfile");
			my $res = `file debian/$d/$check_dir/$binfile`;
			next if ($res !~ /ELF/);
			$c++;
			print GREEN, wrap('','', "\tdebian/$d/${check_dir}${binfile}\n"), RESET
				if ($verbose >= 2);
			$target++ if ($res =~ /$arch/ig);
			$hostc++ if ($res =~ /$host/ig);
			$numchecks++;
		}
	}
	if ($c ne $target)
	{
		print (RED, "ERROR: $hostc of $c files found for the wrong architecture: $host!\n", RESET) if ($verbose >= 2);
		print (RED, "$target of $c files found for: $arch\n", RESET) if ($verbose >= 2);
		die (RED, "FAIL: /usr/bin or /bin/ contain files for the wrong architecture!", RESET, "\n");
	}
	print CYAN, "Architecture check successful. $c files for $arch.\n", RESET
		if (($c > 1) and ($verbose >= 2));
	print CYAN, "Architecture check successful. One file for $arch.\n", RESET
		if (($c == 1) and ($verbose >= 2));
	$numchecks++;
}

# run basic checks on the maintainer scripts
my @fail=();
opendir (MAINT, "debian") or die ("Cannot open debian directory\n");
my @maint=grep(/.*(post|pre)(inst|rm)$/, readdir (MAINT));
closedir (MAINT);
foreach my $mscript (@maint)
{
	$numchecks++;
	print CYAN, "Checking debian/$mscript ....\n", RESET if ($verbose >= 2);
	open (SCRIPT, "debian/$mscript") or die ("Cannot read debian/$mscript\n");
	while (<SCRIPT>)
	{
		# ignore any commented lines.
		next if (/^\s*#/);
		# add new tests here
		push @fail, "$mscript is a perl script.\n" if m:#!/usr/bin/perl.*:;
		push @fail, "$mscript calls install-info.\n" if /install-info/;
		push @fail, "$mscript calls update-alternatives (perl).\n" if /update-alternatives/;
		push @fail, "$mscript tries to process a manpage.\n" if m:/usr/share/man/man1/:;
	}
}
if (scalar @fail > 0)
{
	my $failstr = join ("", @fail);
	die (RED, "FAIL: $failstr", RESET, "\n");
}

# check contents of locale package(s) contain at least one correct mo file
opendir(CH, "../");
my @binpkg=grep(/^${source}\-locale\-.*\_${emvers}\_all.deb$/,readdir(CH));
closedir(CH);
foreach my $binpackage (@binpkg)
{
	next if $binpackage !~ /^${source}\-locale\-(.*)\_${emvers}\_all.deb$/;
	my $lang = $1;
	print CYAN, "checking $lang\n", RESET if ($verbose >= 2);
	my $a = $lang;
	$lang =~ s/[-]/_/;
	$lang =~ s/[+]/@/;
	$lang =~ s/\/.*//;
	$a =~ s/\/.*//;
	my $contents = `dpkg -c ../$binpackage`;
	# some locales use ucfirst after @, some do not. Use 'i' in the match.
	die (RED, "FAIL: Translation check failed for $lang - check 'dpkg -c ../$binpackage'", RESET, "\n")
		if ($contents !~ m:./usr/share/locale/${lang}/LC_MESSAGES/.*\.mo:i);
}
print GREEN, "locale check successful for $source $emvers\n", RESET if ($verbose >= 2);
$numchecks++;
print CYAN, "$numchecks checks successful.\n", RESET if ($numchecks > 1);
print CYAN, "One check successful.\n", RESET if ($numchecks == 1);

open (CHG, "../$changes") or die ("FAILED: unable to read ../$changes: $!\n");
open (BUILD, ">>../$build") or die ("Cannot append .changes to .build: $!\n");
print BUILD "\n";
# add test results to build log too.
print BUILD "$numchecks checks successful.\n" if ($numchecks > 1);
print BUILD "One check successful.\n" if ($numchecks == 1);
my $dir = cwd;
$dir .= "/../$changes";
print (GREEN, "Changes file: " . &Cwd::realpath($dir), RESET);
while(<CHG>) {
	print $_;
	print BUILD $_;
}
print GREEN, "\nSuccessful build.\n\n", RESET;
print BUILD "\nSuccessful build.\n\n";
close BUILD;
close CHG;

chdir ("../");
system "debsign $changes" if ($dosign eq "true");
&handle_svn($build, $cachefile) if ($svnci eq "true");
# advise a manual check as there is no lintian support yet.
chomp($changes);
my $manual_check = "Please check the package manually before uploading. e.g.\n";
$manual_check .= "'debc -a $arch ../${changes}'\n'deb-gview ../${changes}'.\n";
print CYAN, $manual_check, RESET if ($verbose >= 2);
exit 0;

sub handle_svn
{
	# $build contains the name of the build log, if any.
	my $build = $_[0];
	my $cachefile = $_[1];
	print CYAN, "Checking in emdebian patch files . . \n", RESET if ($verbose >= 1);
	# Include all available patch files.
	my @patchfiles = glob ('emdebian-*.patch');
	my @debpatch = glob ('debian-patch*');
	push @patchfiles, @debpatch;
	my @svnadds=();
	my @svncommits=();
	my $status = `svn status . | grep ?`;
	foreach my $f (@patchfiles)
	{
		push (@svnadds, $f) if $status =~ /\Q$f\E/;
	}
	$status = `svn status .`;
	foreach my $f (@patchfiles)
	{
		push (@svncommits, $f) if $status =~ /\Q$f\E/;
	}
	my $addnum = scalar @svnadds;
	my $commitnum = scalar @svncommits;
	if (@svnadds)
	{
		print GREEN, "Adding $addnum patch files to SVN . . \n", RESET if ($verbose == 1);
		print GREEN, "Adding patch files: ", @svnadds, "\n", RESET if ($verbose >= 2);
		my $add = join(' ', @svnadds);
		system ("svn -q add $add");
	}
	if (@svncommits)
	{
		print GREEN, "Commit $commitnum patch files into SVN . . \n", RESET if ($verbose == 1);
		print GREEN, "Committing patch files: ", @svncommits, "\n", RESET if ($verbose >= 2);
		system ("svn ci -q -m \"automated patch file checkin\" @svncommits");
	}
	return if ($build eq '');
	# check if build log is already in svn for this arch and this version.
	my $check = `svn list $build 2>/dev/null`;
	if ($check eq '')
	{
		print GREEN, "Adding build log '$build' to SVN . . \n", RESET if ($verbose >= 2);
		system ("svn -q add $build");
		# Disallow updated build logs for the same arch and version.
		# only the first successful build of this version on this arch is held in SVN.
		print CYAN, "Checkin build log '$build' into SVN . . \n", RESET if ($verbose >= 2);
		system ("svn ci -q -m \"automated build log checkin\" $build");
	}
}

sub crossbuilddeps
{
	my $line = "";
	print CYAN, "Checking for debian/control\n", RESET if ($verbose >= 2);
	&check_emdebian_control;
	print GREEN, "Checking for Build-Cross-Depends\n", RESET if ($verbose >= 2);
	unless (-f "debian/xcontrol")
	{
		print CYAN, "Nothing to do.\n", RESET if ($verbose >= 1);
		return;
	}
	open (XC, "<debian/xcontrol");
	my @xc=<XC>;
	close (XC);
	foreach my $dep (@xc)
	{
		$dep =~ s/^Build-Cross-Depends: //i;
		$dep =~ s/,/ /g;
		$dep =~ s/  / /g;
		chomp($dep);
		$line .= " $dep";
	}
	chomp ($line);
	print GREEN, wrap('','',"Installing $line with apt-cross.\n"), RESET;
	print CYAN, "Enter your sudo password if prompted.\n", RESET if ($verbose >= 2);
	my $v = "-v" if ($verbose >= 2);
	$v = "-q" if ($verbose < 1);
	system ("apt-cross $v -i $line");
}
