#! /usr/bin/perl -w

# Perl version of Christoph Lameter's build program, renamed debuild.
# Written by Julian Gilbey, December 1998.

# Copyright 1999, Julian Gilbey
# 
# This program 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 2 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


# We will do simple option processing.  The calling syntax of this
# program is:
#
#   debuild [debuild-options] binary|binary-arch|binary-indep|clean ...
# or
#   debuild [debuild-options] [dpkg-buildpackage-options] [-L lintian-options]
#
# In the first case, debuild will simply run debian/rules with the
# given parameter.  Available options in this case are:
#   --no-conf, --noconf    No devscripts config files read
#   --rootcmd=<gain-root-command>
#   -r<gain-root-command>  Which program should be used to gain root
#                          access.  If this is not specified and debuild
#                          is not being run by root or setuid root,
#                          fakeroot will be used.  
#
#   --preserve-envvar=<envvar>
#   -e<envvar>             The environment variable envvar will not
#                          be removed during the environment purge.
#                          If envvar is PATH, then the PATH variable
#                          will not be touched.
#
#   --set-envvar=<envvar>=<value>
#   -e<envvar>=<value>     The environment variable envvar will be set
#                          to the requested value, and will not be
#                          removed during the environment purge.
#
#   --preserve-env
#   -E                     The environment (except for PATH) will not
#                          be touched: this is potentially quite harmful.
#
# In the second case, the behaviour is to run dpkg-buildpackage and
# then to run lintian on the resulting .changes file.  Lintian options
# may be specified after -L; all following options will be passed only
# to lintian.  The available debuild options are:
#   --no-lintian          Lintian will not be run, and all options after
#                         -L (if there is a -L option) will be ignored.
#                         If --no-lintian is not specified, but the
#                         lintian program is not installed, a warning
#                         will be issued.
#   --lintian             Lintian will be run
#
#   --no-conf, --noconf   
#   -e<envvar>, -E        As above.

# As this may be running setuid, we make sure to clean out the
# environment before we perform the build, subject to any -e or -E
# options.  Also wise for building the packages, anyway.
# We don't put /usr/local/bin in the PATH as Debian
# programs will presumably be built without the use of any locally
# installed programs.  This could be changed, but in which case,
# please add /usr/local/bin at the END so that you don't get any
# unexpected behaviour.

# We will try to preserve the locale variables, but if it turns out that
# this harms the package building process, we will clean them out too.
# Please file a bug report if this is the case!

#use strict;
use Cwd;
use 5.003;

($progname=$0) =~ s,.*/,,;

# Predeclare functions
sub fatal($);

sub usage
{
    print <<"EOF";
First usage method:
  $progname [debuild-options] binary|binary-arch|binary-indep|clean ...
    to run debian/rules with given parameter(s).  Options here are
        --no-conf, --noconf      Don\'t read devscripts config files;
                                 must be the first option given
        --rootcmd=<gain-root-command>, -r<gain-root-command>
                                 Command used to become root if $progname
                                 not setuid root; default=fakeroot

        --preserve-envvar=<envvar>, -e<envvar>
                                 Preserve environment variable <envvar>

        --preserve-env, -E       Preserve all environment vars (except PATH)

        --set-envvar=<envvar>=<value>, -e<envvar>=<value>
                                 Set environment variable <envvar> to <value>
                                 
Second usage method:
  $progname [debuild-options] [dpkg-buildpackage-options] [-L lintian-options]
    to run dpkg-buildpackage and then run lintian on the resulting
    .changes file.  Additional debuild option available in this case is:
        --no-lintian             Don\'t run lintian; ignore all options
                                 after -L
        --lintian                Do run lintian (default)
    For available dpkg-buildpackage and lintian options, see their
    respective manpages.

Also, --help or -h displays this message, --version shows version information.
EOF
}

sub version
{
    print <<"EOF";
This is $progname, from the Debian devscripts package, version ###VERSION###
This code is copyright 1999 by Julian Gilbey, all rights reserved.
Based on a shell-script program by Christoph Lameter.
This program comes with ABSOLUTELY NO WARRANTY.
You are free to redistribute this code under the terms of the
GNU General Public License, version 2 or later.
EOF
}

# Start by reading configuration files and then command line
# The next stuff is somewhat boilerplate and somewhat not.
# It's complicated by the fact that the config files are in shell syntax,
# and we don't want to have to write a general shell parser in Perl.
# So we'll get the shell to do the work.  Yuck.
# We allow DEBUILD_PRESERVE_ENVVARS="VAR1,VAR2,VAR3"
# and DEBUILD_SET_ENVVAR_VAR1=VAL1, DEBUILD_SET_ENVVAR_VAR2=VAR2.

# Set default values before we start
my $preserve_env=0;
my %save_vars;
my $root_command='fakeroot';
my $run_lintian=1;
my @dpkg_extra_opts;
my @lintian_extra_opts;

if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
    shift;
} else {
    my @config_files = ('/etc/devscripts.conf', '~/.devscripts');
    my %config_vars = (
		       'DEBUILD_PRESERVE_ENV' => 'no',
		       'DEBUILD_PRESERVE_ENVVARS' => '',
		       'DEBUILD_LINTIAN' => 'yes',
		       'DEBUILD_ROOTCMD' => 'fakeroot',
		       );
    my $dpkg_opts_var = 'DEBUILD_DPKG_BUILDPACKAGE_OPTS';
    my $lintian_opts_var = 'DEBUILD_LINTIAN_OPTS';

    my $shell_cmd;
    # Set defaults
    $shell_cmd .= qq[unset `set | grep "^DEBUILD_" | cut -d= -f1`;\n];
    foreach my $var (keys %config_vars) {
	$shell_cmd .= qq[$var="$config_vars{$var}";\n];
    }
    foreach my $var ($dpkg_opts_var, $lintian_opts_var) {
	$shell_cmd .= "$var='';\n";
    }
    $shell_cmd .= 'for file in ' . join(" ",@config_files) . "; do\n";
    $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
    # Read back values
    foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
    foreach my $var ($dpkg_opts_var, $lintian_opts_var) {
	$shell_cmd .= "eval set -- \$$var;\n";
	$shell_cmd .= "echo \">>> $var BEGIN <<<\";\n";
	$shell_cmd .= 'while [ $# -gt 0 ]; do echo $1; shift; done;' . "\n";
	$shell_cmd .= "echo \">>> $var END <<<\";\n";
    }
    # Not totally efficient, but never mind
    $shell_cmd .= 'for var in `set | grep "^DEBUILD_SET_ENVVAR_" | cut -d= -f1`; do ';
    $shell_cmd .= 'eval echo $var=\$$var; done;' . "\n";
    # print STDERR "Running shell command:\n$shell_cmd";
    my $shell_out = `/bin/sh -c '$shell_cmd'`;
    # print STDERR "Shell output:\n${shell_out}End shell output\n";
    my @othervars;
    (@config_vars{keys %config_vars}, @othervars) = split /\n/, $shell_out, -1;

    # What did we find?
    $preserve_env = $config_vars{'DEBUILD_PRESERVE_ENV'} eq 'yes' ? 1 : 0;
    if ($config_vars{'DEBUILD_PRESERVE_ENVVARS'} ne '') {
	my @preserve_vars = split /\s*,\s*/,
	    $config_vars{'DEBUILD_PRESERVE_ENVVARS'};
	@save_vars{@preserve_vars} = (1) x scalar @preserve_vars;
    }
    $run_lintian = $config_vars{'DEBUILD_LINTIAN'} eq 'no' ? 0 : 1;
    $root_command = $config_vars{'DEBUILD_ROOTCMD'};

    # Now parse the opts lists
    if (shift @othervars ne ">>> $dpkg_opts_var BEGIN <<<") {
	die "debuild: internal error: dpkg opts list missing proper header\n";
    }
    while (($_ = shift @othervars) ne ">>> $dpkg_opts_var END <<<"
	   and @othervars) {
	push @dpkg_extra_opts, $_;
    }
    if (! @othervars) {
	die "debuild: internal error: dpkg opts list missing proper trailer\n";
    }

    if (shift @othervars ne ">>> $lintian_opts_var BEGIN <<<") {
	die "debuild: internal error: lintian opts list missing proper header\n";
    }
    while (($_ = shift @othervars) ne ">>> $lintian_opts_var END <<<"
	   and @othervars) {
	push @lintian_extra_opts, $_;
    }
    if (! @othervars) {
	die "debuild: internal error: lintian opts list missing proper trailer\n";
    }

    # And what is left should be any ENV settings
    foreach my $envvar (@othervars) {
	$envvar =~ /^DEBUILD_SET_ENVVAR_([^=]*)=(.*)$/ or next;
	$ENV{$1}=$2;
	$save_vars{$1}=1;
    }
}


# Check @ARGV for -e and -E options.  Not very efficient, but it will
# do for the time being.
my (@NEW_ARGV, $arg);
@save_vars{qw(TERM HOME LOGNAME PGPPASS PGPPATH GNUPGHOME
	      FAKEROOTKEY LANG)} = (1) x 8;
{
    no locale;
    while ($arg=shift) {
	if ($arg =~ /^(-e|--preserve-envvar|--set-envvar)$/) {
	    $_=shift;
	    if ($arg ne '--set-envvar' && /^\w+$/) {
		$save_vars{$_}=1;
		next;
	    }
	    elsif ($arg ne '--preserve-envvar' && /^(\w+)=(.*)$/) {
		$ENV{$1}=$2;
		$save_vars{$_}=1;
		next;
	    }
	}
	$arg =~ /^-e(\w+)$/ and $save_vars{$1}=1, next;
	if ($arg =~ /^-e(\w+)=(.*)$/) {
	    $ENV{$1}=$2;
	    $save_vars{$1}=1;
	    next;
	}
	$arg =~ /^--preserve-envvar=(\w+)$/ and $save_vars{$1}=1, next;
	if ($arg =~ /^--set-envvar=(\w+)=(.*)$/) {
	    $ENV{$1}=$2;
	    $save_vars{$1}=1;
	    next;
	}
	# -e is now a valid dpkg-buildpackage option, but the two uses
	# will never interfere
	$arg eq '-e' and
	    warn "Ignoring -e option: $arg" .
		($arg eq '-e' ? " $_" : ''), next;
	$arg =~ /^--(preserve|set)-envvar/ and
	    warn "Ignoring $arg option: $arg" .
		($arg eq '--preserve-envvar' ? " $_" : ''), next;
	$arg =~ /^(-E|--preserve-env)$/ and $preserve_env=1, next;
	$arg eq '--no-lintian' and $run_lintian=0, next;
	$arg eq '--lintian' and $run_lintian=1, next;
	$arg eq '--rootcmd' and $root_command=shift, next;
	$arg =~ /^-rootcmd=(.*)/ and $root_command=$1, next;
	$arg eq '-r' and $root_command=shift, next;
	$arg =~ /^-r(.*)/ and $root_command=$1, next;
	$arg =~ /^(-h|--help)$/ and usage(), exit 0;
	$arg eq '--version' and version(), exit 0;
	if ($arg =~ /^--no-?conf$/) {
	    die "--noconf must be the first option given to debuild\n";
	}
	# Not a debuild option, so give up.
	push(@NEW_ARGV, $arg), last;
    }
}

unshift(@ARGV,@NEW_ARGV);

if ($save_vars{'PATH'}) {
    # Untaint PATH.  Very dangerous in general, but anyone running this
    # as root can do anything anyway.
    $ENV{'PATH'} =~ /^(.*)$/;
    $ENV{'PATH'} = $1;
} else {
    $ENV{'PATH'} = "/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11"
}
$save_vars{'PATH'}=1;
$ENV{'TERM'}='dumb' unless exists $ENV{'TERM'};

unless ($preserve_env) {
    foreach my $var (keys %ENV) {
	delete $ENV{$var} unless
	    $save_vars{$var} or $var =~ /^(LC|DEB)_[A-Z_]+$/;
    }
}

umask 022;

until (-e "debian/rules")
{
    chdir ".." or fatal "Can't chdir: $!";
    fatal "Cannot find debian/rules anywhere!  Are you in the source code tree?"
	if cwd() eq "/";
}

if ( ! -x _ ) {
    print STDERR "Making debian/rules executable!\n";
    chmod 0755, "debian/rules" or
	fatal "Couldn't make debian/rules executable: $!";
}

# Pick up superuser privileges if we are running set[ug]id root
my $uid=$<;
if ( $< != 0 && $> == 0 ) { $< = $> }
my $gid=$(;
if ( $( != 0 && $) == 0 ) { $( = $) }

# Now let's look at our options, if any.  The first task is to decide
# which version of debuild we wish to run.  The rule is as follows: we
# want to run the first version (calling debian/rules explicitly) if
# there is at most one initial -r... argument, and all of the others
# are one of binary, binary-arch, binary-indep or clean.  We run the
# second version otherwise.  Note that the -r option is the only one
# stripped from the argument list.

my $command_version='rules';

if ( @ARGV == 0 ) { $command_version='dpkg'; }
else {
    foreach (@ARGV) {
	if ( ! /^(binary|binary-indep|binary-arch|clean)$/) {
	    $command_version='dpkg';
	    last;
	}
    }
}

if ( $command_version eq 'dpkg') {
    # We're going to run dpkg-buildpackage and possibly lintian.
    # Our first task is to parse the command line options.

    # And before we get too excited, does lintian even exist?
    system("command -v lintian >/dev/null 2>&1") == 0 or $run_lintian=0;

    my $Lopts=0;
    my $sourceonly='';
    my $binaryonly='';
    my $targetarch='';
    my $gnutarget='';
    my $signchanges=1;
    my $signdsc=1;
    my @dpkg_opts = qw(-us -uc);
    my @debsign_opts = ();

    # First process @dpkg_extra_opts from above

    foreach (@dpkg_extra_opts) {
	/^-r(.*)/ and $root_command=$1, next;
	/^-a(.*)/ and $targetarch=$1;       # Explained below
	/^-t(.*)/ and $_ ne '-tc' and $gnutarget=$1;    # Ditto
	$_ eq '-S' and $sourceonly=$_;       # Explained below
	/^-[mk]/ and push @debsign_opts, $_;            # Key selection options
	/^-s(pgp|gpg)$/ and push @debsign_opts, $_;  # Ditto
	/^-p/ and push @debsign_opts, $_;  # Ditto
	$_ eq '-us' and $signdsc=0, next;
	$_ eq '-uc' and $signchanges=0, next;
	/^-[Bb]$/ and $binaryonly=$_;
	push @dpkg_opts, $_;
    }

    while ($_=shift) {
	/^-r(.*)/ and $root_command=$1, next;
	/^-a(.*)/ and $targetarch=$1;       # Explained below
	/^-t(.*)/ and $_ ne '-tc' and $gnutarget=$1;    # Ditto
	$_ eq '-S' and $sourceonly=$_;       # Explained below
	/^-[mk]/ and push @debsign_opts, $_;            # Key selection options
	/^-s(pgp|gpg)$/ and push @debsign_opts, $_;  # Ditto
	/^-p/ and push @debsign_opts, $_;  # Ditto
	$_ eq '-us' and $signdsc=0, next;
	$_ eq '-uc' and $signchanges=0, next;
	/^-[Bb]$/ and $binaryonly=$_;
	last if /^(--lintian|-L)$/;
	push @dpkg_opts, $_;
    }
    if ($< != 0) {
	if ($root_command) {
	    # Only fakeroot is a default, so that's the only one we'll
	    # check for
	    if ($root_command eq 'fakeroot') {
		system('fakeroot : 2>/dev/null');
		if ($? >> 8 != 0) {
		    die "Problem running fakeroot: either install the fakeroot package,\nuse a -r option to select another root command program to use or\nrun me as root!\n";
		}
	    }
	    unshift @dpkg_opts, "-r$root_command";
	} else {
	    die "Need a --rootcmd or -r option to run!\n";
	}
    }

    if ($signchanges==1 and $signdsc==0) {
	warn "I will sign the .dsc file anyway as a signed .changes file was requested\n";
    }

    # We need to figure out what the changes file will be called,
    # so we copy some code from dpkg-buildpackage for this purpose.
    # Note that dpkg-buildpackage looks at any -a... and -t... parameters
    # it is given to determine the architecture, so we need to do the
    # same to determine the .changes filename.

    # The following is based on dpkg-buildpackage
    my ($pkg, $version, $sversion, $dsc, $changes);
    open DPKG, "dpkg-parsechangelog |" or
	fatal "Cannot open dpkg-parsechangelog pipe: $!";
    while (<DPKG>) {
	/^Source: / && chomp($pkg=$');
	/^Version: / && chomp($version=$');
    }
    close DPKG or fatal "dpkg-parsechangelog pipe error: $!";
    fatal "Could not determine Source and/or Version from changelog"
	unless $pkg and $version;
    my $arch;
    if ($sourceonly) {
	$arch = 'source' ;
    } else {
	unless (system("command -v dpkg-architecture >/dev/null 2>&1") == 0) {
	    fatal "This program depends on dpkg-architecture; your dpkg is far too old";
	}
	$arch=`dpkg-architecture -a${targetarch} -t${gnutarget} -qDEB_HOST_ARCH`;
	chomp $arch;
	fatal "Couldn't determine architecture!?" if ! $arch;
    }

    ($sversion=$version) =~ s/^\d+://;
    $dsc="${pkg}_$sversion.dsc";
    $changes="${pkg}_${sversion}_${arch}.changes";

    # So now we can run dpkg-buildpackage and lintian...

    # print STDERR "Running dpkg-buildpackage @dpkg_opts\n";
    system('dpkg-buildpackage', @dpkg_opts) == 0
	or fatal "dpkg-buildpackage failed!";
    chdir '..' or fatal "Can't chdir: $!";
    if ($run_lintian) {
	$<=$>=$uid;  # Give up on root privileges if we can
	$(=$)=$gid;
	print "Now running lintian...\n";
	# The remaining items in @ARGV, if any, are lintian options
	system('lintian', @lintian_extra_opts, @ARGV, $changes);
	print "Finished running lintian.\n";
    }
    if ($signchanges) {
	print "Now signing changes and any dsc files...\n";
	exec 'debsign', @debsign_opts, $changes
	    or fatal "Couldn't exec debsign: $!";
    }
    elsif (! $sourceonly and $signdsc) {
	print "Now signing dsc file...\n";
	exec 'debsign', @debsign_opts, $dsc
	    or fatal "Couldn't exec debsign: $!";
    }
    exit 0;
}
else {
    # Running debian/rules
    # Don't try to use the root command if we are already running as root
    if ( $< == 0 ) {
	exec 'debian/rules', @ARGV
	    or fatal "Couldn't exec debian/rules: $!";
    }

    # So we'll use the selected or default root command
    exec "$root_command debian/rules @ARGV"
	or fatal "Couldn't exec $root_command debian/rules: $!";
}

###### Subroutines

sub fatal($) {
    my ($pack,$file,$line);
    ($pack,$file,$line) = caller();
    (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
    $msg =~ s/\n\n$/\n/;
    die $msg;
}