#!/usr/bin/perl
#
# dpkg-buildpackage wrapper -- extended sematics of -a option
#
# Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>, 4 Feb 97
# This is free software; see the GNU General Public Licence
# version 2 or later for copying conditions.  There is NO warranty.

#
# general code to set up dpkg-cross configuration
#
$conffile = "/etc/dpkg/cross-compile";
($progname = $0) =~ s,.*/,,;
@intern_vars = qw( crossbase crossprefix crossdir crossbin crosslib crossinc
				   crossinfo maintainer default_arch );
# avoid warnings about unused variables:
$crossbase = $crossprefix = $crossdir = $crossbin = $crosslib =
$crossinc = $crossinfo = $crossroot = "";
$maintainer = "";
$default_arch = "";

%std_comp = (CC       => "gcc",
			 GCC      => "gcc",
			 CXX      => "g++",
			 IMAKECPP => "cpp");

%std_binu = (LD       => "ld",
			 AS       => "as",
			 AR       => "ar",
			 RANLIB   => "ranlib",
			 STRIP    => "strip");

$signcommand = (-e "$ENV{'HOME'}/.gnupg/secring.gpg") ? "gpg" : "pgp";
@ADD_ARGS = ( );

# scan arguments for the ones we're interested in
foreach $arg ( @ARGV ) {
	usage() if $arg =~ /^-h/;
	if ($arg =~ /^-a/) {
		$arch = $';
		$do_setup = 1;
	}
	elsif ($arg =~ /^-p/) {
		$signcommand = $';
	}
	elsif ($arg =~ /^-k/) {
		$signkey = $';
	}
	elsif ($arg =~ /^-m/) {
		$opt_maintainer = $';
	}
	elsif ($arg =~ /^-sgpg/) {
		$signinterface = "gpg";
	}
	elsif ($arg =~ /^-spgp/) {
		$signinterface = "pgp";
	}
	elsif ($arg =~ /^-[bB]/) {
		$binaryonly = 1;
	}
}
$signinterface ||= $signcommand;

# determine package name
get_package_data()
	|| die "$progname: cannot determine name of current package\n";
setup_cross_env() if $do_setup;
chop( $arch = `dpkg --print-architecture` ) if !$arch;

# some versions of dpkg-buildpackage always sign the .dsc file, even
# if they didn't generate it... save the current one, if it exists
if ($binaryonly) {
	$dsc_file = "../$package"."_$version.dsc";
	if (-e $dsc_file) {
		rename( $dsc_file, "$dsc_file.saved" )
			|| warn "Cannot rename $dsc_file: $!\n";
		system "cp $dsc_file.saved $dsc_file";
	}
	else {
		# no .dsc -> create one, else another error from dpkg-buildpackage...
		system "echo x >$dsc_file";
	}
}
	
# ...and call the real dpkg-buildpackage
# it's just a bit trick to reset $0 for it, so it doesn't call itself
# "dpkg-buildpackage.orig" :-) Supplying a different $0 on exec
# doesn't work, beacuse it's a shell script, and the shell sets $0 to
# the name of the file it interprets. So we have to use the feature
# that after -c STRING, you can set all arguments, even $0
my $rv = system "/bin/sh", "-c", ". /usr/bin/dpkg-buildpackage.orig",
				"dpkg-buildpackage", @ARGV, @ADD_ARGS;

if ($rv == 0) {
	# merge the new .changes file with a maybe already existing one
	merge_changes();
}
else {
	$rv = (($rv & 0xff) == 0) ? ($rv >> 8) : 128+($rv & 0x7f);
}

# restore .dsc file
if ($binaryonly) {
	unlink $dsc_file;
	rename( "$dsc_file.saved", $dsc_file ) if -e "$dsc_file.saved";
}

exit $rv;


sub usage {
	# print original message
	system "dpkg-buildpackage.orig -h";
	# and our comments...
	print STDERR <<'EOF';

dpkg-cross cross-compiling extension: Use of -a option sets several
environment variables for cross compiling. See
/usr/doc/dpkg-cross/README.debian for more information.
EOF
	exit 0;
}


sub setup_cross_env {
	my( $var, $pkghashref, %set );
	
	# read and process config file
	read_config();
	setup();

	# check for old installation
	if (-d $crossinfo) {
		print STDERR "This is an old-style (dpkg-cross 0.x) installation.\n";
		print STDERR "Please convert with dpkg-cross-convert first!\n";
		exit 1;
	}
	
	# put $ARCH into environment
	$set{'ARCH'} = $arch;

	# also set new dpkg-architecture env vars
	$set{'DEB_HOST_ARCH'} = $arch;
	$set{'DEB_HOST_GNU_CPU'} = $arch_cpu;
	$set{'DEB_HOST_GNU_SYSTEM'} = $arch_os;
	$set{'DEB_HOST_GNU_TYPE'} = "${arch_cpu}-${arch_os}";
	
	# append /usr/local/bin to $PATH, some binaries may be in there;
	# also append $crossbin, so that cross binaries can be found, but
	# native stuff still has precedence (if a package wants to compile
	# with 'gcc' a build tool that will be executed, for example)
	$set{'PATH'} = "$ENV{PATH}:/usr/local/bin:$crossbin";
		
	# set USRLIBDIR to $(CROSSLIB), for imake-generated Makefiles
	$set{'USRLIBDIR'} = $crosslib;

# The following stuff isn't needed anymore as MAKEFLAGS=-e isn't used anymore.
# I've kept it commented out for reference...
#	# remove MANPATH from the environment; for the user, it's a list
#	# of paths for man to search in. But in imake-generated Makefiles,
#	# a variable of the same name is used for the directory where to
#	# install manpages in. These are different things... Gives funny
#	# error messages like
#	#   install: /usr/man/preformat:/usr/man:/usr/local/man/man1/xxx.1x: \
#	#   no such file or directory
#	# (or something similar)
#	delete $ENV{'MANPATH'};
		
	# set CONFIG_SITE to /etc/dpkg/cross-config.linux, for
	# packages using GNU autoconf configure scripts
	$set{'CONFIG_SITE'} = "/etc/dpkg/cross-config.$arch_os";
		
	# set standard variables for compilers
	foreach $var ( keys %std_comp ) {
		$set{$var} = $crossprefix . $std_comp{$var};
	}
	
	# set standard variables for binutils (if different CPU)
	my $native_cpu = `dpkg --print-installation-architecture`;
	chomp $native_cpu;
	if ($arch_cpu ne $native_cpu) {
		foreach $var ( keys %std_binu ) {
			$set{$var} = $crossprefix . $std_binu{$var};
		}
	}
	
	# set variables specific for this package
	foreach $var ( keys %{ $pkgvars{$package} } ) {
		$set{$var} = $pkgvars{$package}{$var};
	}

#	# put $MAKEFLAGS into environment, to force env vars to override
#	# values defined in makefiles
#	$ENV{'MAKEFLAGS'} = "-e";

	my $makeflags = "w -- ";
	if (exists $ENV{'MAKEFLAGS'}) {
		$makeflags = $ENV{'MAKEFLAGS'};
		$makeflags .= " -- " if $makeflags !~ / -- /;
	}
	foreach (keys %set) {
		$makeflags .= " $_=$set{$_}";
	}
	$ENV{'MAKEFLAGS'} = $makeflags;
	
	# if a maintainer name is configured, then add a -m option
	if (!$opt_maintainer && $maintainer && $maintainer ne "CURRENTUSER") {
		push( @ADD_ARGS, "-m$maintainer" );
	}
}


sub get_package_data {
	
	open( PIPE, "dpkg-parsechangelog |" );
	while( <PIPE> ) {
		chomp($package = $') if /^Source:\s*/;
		chomp($version = $') if /^Version:\s*/;
	}
	close( PIPE );

	# strip epoch if present
	$version =~ s/^\d+://;
	return( $package && $version );
}


sub merge_changes {
	my( $changes_base, $this_changes, $other_changes, $new_changes, $i );
	my( @changes_files, @this_farchs, @other_farchs, @this_archs,
	    @other_archs, @this_files, @other_files, @new_farchs, @new_archs,
	    @new_files );
	
	$changes_base = "../$package" . "_$version";
	@changes_files = <${changes_base}_*.changes>;
	return if @changes_files < 2;
	warn "$progname: More than two .changes files; merge manually\n", return
		if @changes_files > 2;

	$this_changes = "$changes_base" . "_$arch.changes";
	$other_changes = (grep( $_ ne $this_changes, @changes_files ))[0];

	$this_changes =~ /_([^_]*)\.changes/;
	@this_farchs = split( /\+/, $1 );
	$other_changes =~ /_([^_]*)\.changes/;
	@other_farchs = split( /\+/, $1 );

	parse_changes( $this_changes, \@this_archs, \@this_files );
	parse_changes( $other_changes, \@other_archs, \@other_files );

	# new_farchs is union of other_farchs and this_farchs
	@new_farchs = @other_farchs;
	foreach $i ( @this_farchs ) {
		push( @new_farchs, $i ) unless grep( $i eq $_, @new_farchs );
	}

	# new_archs is union of other_archs and this_archs
	@new_archs = @other_archs;
	foreach $i ( @this_archs ) {
		push( @new_archs, $i ) unless grep( $i eq $_, @new_archs );
	}

	# new_files is union of other_files and this_files; if entries are in
	# both, the one from this_files is more recent and has precedence
	foreach $i ( @other_files ) {
		push( @new_files, $i ) unless
			grep( cfname($i) eq cfname($_), @this_files );
	}
	@new_files = ( @new_files, @this_files );

	$new_changes = $changes_base . "_" . join( '+', @new_farchs ) . ".changes";
	
	open( F, "<$this_changes" )
		|| die "$progname: Cannot open $this_changes: $!\n";
	open( O, ">$new_changes.new" )
		|| die "$progname: Cannot create $new_changes: $!\n";
	while( <F> ) {
	  got_line:
		if (/^--+BEGIN PGP SIGNED MESSAGE/) {
			$_ = <F>; # drop another line
			next;
		}
		elsif (/^--+BEGIN PGP SIGNATURE/ .. /^--+END PGP SIGNATURE/) {
			# omit
		}
		elsif (/^architecture:/i) {
			print O "Architecture: @new_archs\n";
		}
		elsif (/^files:/i) {
			print O "Files: \n", join( "\n", @new_files ), "\n";
			while( <F> ) { last unless /^ /; }
			goto got_line;
		}
		else {
			print O $_;
		}
	}
	close( F );
	close( O );

	unlink( @changes_files );
	rename( "$new_changes.new", $new_changes )
		|| warn "$progname: Cannot rename $new_changes.new: $!\n";
	
	print "Merged changes with $other_changes\n signfile $new_changes\n";
	my $usekey = $signkey || $opt_maintainer;
	$usekey = $maintainer if $maintainer && $maintainer ne "CURRENTUSER";
	if ($signinterface eq "gpg") {
		system "cat \"$new_changes\" | $signcommand ".
			   ($usekey ? "--local-user \"$usekey\" " : "").
			   "--clearsign --armor --textmode >\"$new_changes.asc\"";
	}
	else {
		system "$signcommand ".
			   ($usekey ? "-u \"$usekey\" " : "").
			   "+clearsig=on -fast <\"$new_changes\" >\"$new_changes.asc\"";
	}
	rename( "$new_changes.asc", "$new_changes" )
		|| warn "$progname: Cannot rename $new_changes.asc: $!\n";
}


sub parse_changes {
	my( $file,  $arch_ref, $files_ref ) = @_;
	my( $archs, @files, $in_files );
	
	open( F, "<$file" ) || die "$progname: Cannot open $file: $!\n";
	$archs = "";
	$in_files = 0;
	while( <F> ) {
		if ($in_files) {
			if (/^ /) {
				chomp $_;
				push( @files, $_ );
			}
			else {
				$in_files = 0;
			}
		}
		elsif (/^Files:/) {
			$in_files = 1;
		}
		elsif (/^Architecture:\s*(.+)\s*$/) {
			$archs = $1;
		}
	}
	close( F );
	$archs || die "$progname: $file has no architecture field!\n";

	@$arch_ref = split( /\s+/, $archs );
	@$files_ref = @files;
}


sub cfname {
	my( $line ) = @_;

	return( (split( /\s+/, $line ))[5] );
}


#
# general code to read dpkg-cross configuration
#

sub read_config {
	my $package;
	
	open( F, "<$conffile" ) || return;
	while( <F> ) {
		next if /^(\s*#|$)/;
		if (/\s*([\w\d_-]+)\s*=\s*(.*)\s*$/) {
			my($var, $val) = ($1, $2);
			if ($package) {
				${$pkgvars{$package}}{$var} = $val;
			}
			elsif ($var =~ /^crossroot-(\S+)$/) {
				$crossroot = $val if $1 eq $arch;
			}
			elsif (grep $_ eq $var, @intern_vars) {
				eval "\$$var = '$val'";
			}
			else {
				warn "$progname: Warning: definition of unknown variable ".
					 "$var in $conffile, line $.\n";
				next;
			}
		}
		elsif (/^\s*([\w\d.-]+):\s*$/) {
			$package = $1;
		}
		else {
			warn "$progname: unrecognized line in $conffile, line $.\n";
		}
	}
	close( F );
}


sub setup {
	my( $package, $var, $os );
	my @vars = ( "arch", @intern_vars );

	# finalize, no subst possible crossbase
	$crossbase ||= "/usr/local";
	# determine OS and CPU from $arch
	$arch_os = ($arch =~ /(^hurd-)|(-gnu$)/) ? "gnu" : "linux";
	($arch_cpu = $arch) =~ s/-?(hurd|gnu|linux)-?//;
	
	# set defaults for internal vars, if not set
	$crossprefix   ||= "${arch_cpu}-${arch_os}-";
	$crossdir      ||= "\$(CROSSBASE)/${arch_cpu}-${arch_os}";
	$crossbin      ||= "\$(CROSSDIR)/bin";
	if ($crossroot) {
		$crosslib  ||= "\$(CROSSROOT)/lib";
		$crossinc  ||= "\$(CROSSROOT)/usr/include";
		push( @vars, "crossroot" );
	}
	else {
		$crosslib  ||= "\$(CROSSDIR)/lib";
		$crossinc  ||= "\$(CROSSDIR)/include";
		$crossinfo ||= "\$(CROSSLIB)/dpkg-cross-info";
	}
	# and substitute references in them
	foreach $var ( @intern_vars ) {
		next if $var eq "crossbase" || $var eq "maintainer";
		subst( eval "\\\$$var", $var, @vars );
	}

	# substitute variable references in package var definitions
	foreach $package ( keys %pkgvars ) {
		foreach $var ( keys %{$pkgvars{$package}} ) {
			subst( \${$pkgvars{$package}}{$var}, $var, @vars );
		}
	}
}


sub subst {
	my $valref = shift(@_);
	my $varname = shift(@_);
	my @defined_vars = @_;
	my( $fulltext, $name, $newval );

	while( $$valref =~ /\$\((\w+)\)/ ) {
		$name = $1;
		if (grep "\U$_\E" eq $name, @defined_vars ) {
			$newval = eval "\"\$\L$name\E\"";
		}
		elsif (!($newval = $ENV{$name})) {
			warn "$progname: Cannot substitute \$($name) in definition ".
				 "of $varname\n";
			$newval = "";
		}
		$$valref =~ s/\$\($name\)/$newval/;
	}
}

