#! /usr/bin/perl
#
# sbuild: build packages, obeying source dependencies
# Copyright © 1998-2000 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Copyright © 2005      Ryan Murray <rmurray@debian.org>
# Copyright © 2005-2009 Roger Leigh <rleigh@debian.org
# Copyright © 2008      Timothy G Abbott <tabbott@mit.edu>
# Copyright © 2008      Simon McVittie <smcv@debian.org>
#
# 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, see
# <http://www.gnu.org/licenses/>.
#
#######################################################################

package main;

use strict;
use warnings;

use POSIX;
use Data::Dumper;
use Sbuild qw(isin);
use Sbuild::Log qw(open_log close_log);
use Sbuild::Sysconfig qw(%programs);
use Sbuild::Options;
use Sbuild::Build;
use Sbuild::DB::Client;

sub main ();
sub write_jobs_file ();
sub append_to_FINISHED ($);
sub add_givenback ($$);
sub should_skip ($);
sub status_trigger ($$);
sub wanna_build_status_trigger ($$);
sub shutdown ($);
sub dump_main_state ();

my $conf = Sbuild::Conf->new();
exit 1 if !defined($conf);
my $options = Sbuild::Options->new($conf, "sbuild", "1");
exit 1 if !defined($options);
$conf->check_group_membership();

my $db = Sbuild::DB::Client->new($conf);

umask(022);

# Job state
my %jobs = ();
my $current_job = undef;

main();

sub main () {
    print "Selected distribution " . $conf->get('DISTRIBUTION') . "\n"
	if $conf->get('DEBUG');
    print "Selected chroot " . $conf->get('CHROOT') . "\n"
	if $conf->get('DEBUG') and defined $conf->get('CHROOT');
    print "Selected architecture " . $conf->get('ARCH') . "\n"
	if $conf->get('DEBUG' && defined($conf->get('ARCH')));

    open_log($conf);

    $SIG{'INT'} = \&main::shutdown;
    $SIG{'TERM'} = \&main::shutdown;
    $SIG{'ALRM'} = \&main::shutdown;
    $SIG{'PIPE'} = \&main::shutdown;

    # Create jobs
    foreach (@ARGV) {
	$jobs{$_} = Sbuild::Build->new($_, $conf);
	$jobs{$_}->set('Pkg Status Trigger', \&status_trigger)
    }
    write_jobs_file(); # Will now update on trigger.

    # Run each job.  Potential for parallelising this step.
    foreach (keys %jobs) {
	my $jobname = $_;

	my $job = $jobs{$jobname};
	$current_job = $jobname;

	# Do the build
	if (should_skip($job)) {
	    $job->set('Pkg Status', 'skipped');
	} else {
	    $job->run();
	}

	dump_main_state() if $conf->get('DEBUG');

	if ($conf->get('BATCH_MODE') &&
	    (-f $conf->get('HOME') . '/EXIT-DAEMON-PLEASE')) {
	    main::shutdown("NONE (flag file exit)");
	}
    }

    close_log($conf);
    unlink($conf->get('JOB_FILE'))
	if $conf->get('BATCH_MODE');
    unlink("SBUILD-FINISHED") if $conf->get('BATCH_MODE');
    if ($conf->get('SBUILD_MODE') eq "user" && defined($current_job) &&
	defined($jobs{$current_job})) {
	exit ($jobs{$current_job}->get('Pkg Status') ne "successful") ? 1 : 0;
    }
    exit 0;
}

# only called from main loop, but depends on job state.
sub write_jobs_file () {
    if ($conf->get('BATCH_MODE')) {

	my $file = $conf->get('JOB_FILE');
	local( *F );

	return if !open( F, ">$file" );
	foreach (keys %jobs) {
	    my $job = $jobs{$_};

	    print F $job->get('Package_OVersion') . ": " .
		$job->get('Pkg Status') . "\n";
	}
	close( F );
    }
}

sub append_to_FINISHED ($) {
    my $job = shift;

    local( *F );

    if ($conf->get('BATCH_MODE')) {
	open(F, ">>SBUILD-FINISHED");
	print F $job->get('Package_OVersion');
	close(F);
    }
}

sub add_givenback ($$) {
    my $build = shift;
    my $time = shift;

    if ($conf->get('BATCH_MODE')) {
	my $pkgv = $build->get('Package_OVersion');
	local( *F );

	$build->lock_file("SBUILD-GIVEN-BACK", 0);

	if (open( F, ">>SBUILD-GIVEN-BACK" )) {
	    print F "$pkgv $time\n";
	    close( F );
	}
	else {
	    $build->log("Can't open SBUILD-GIVEN-BACK: $!\n");
	}

	$build->unlock_file("SBUILD-GIVEN-BACK");
    }
}

sub should_skip ($) {
    my $build = shift;

    if ($conf->get('BATCH_MODE')) {
	my $pkgv = $build->get('Package_OVersion');

	$pkgv = $build->fixup_pkgv($pkgv);
	$build->lock_file("SKIP", 0);
	goto unlock if !open( F, "SKIP" );
	my @pkgs = <F>;
	close( F );

	if (!open( F, ">SKIP" )) {
	    print "Can't open SKIP for writing: $!\n",
	    "Would write: @pkgs\nminus $pkgv\n";
	    goto unlock;
	}
	my $found = 0;
	foreach (@pkgs) {
	    if (/^\Q$pkgv\E$/) {
		++$found;
		print "$pkgv found in SKIP file -- skipping building it\n";
	    }
	    else {
		print F $_;
	    }
	}
	close( F );
      unlock:
	$build->unlock_file("SKIP");
	return $found;
	}
}

sub status_trigger ($$) {
    my $build = shift;
    my $status = shift;

    wanna_build_status_trigger($build, $status);
    write_jobs_file();

    # Rewrite status if we need to give back or mark attempted
    # following failure.  Note that this must follow the above
    # function calls because set_status will recursively trigger.
    if ($status eq "failed" &&
	isin($build->get('Pkg Fail Stage'),
	     qw(fetch-src install-deps arch-check unpack
		check-unpacked-version check-space hack-binNMU
		install-deps-env))) {
	$build->set_status('given-back');
    } elsif ($status eq "failed" &&
	     isin ($build->get('Pkg Fail Stage'),
		   qw(build))) {
	$build->set_status('attempted');
    }
}

sub wanna_build_status_trigger ($$) {
    my $build = shift;
    my $status = shift;

    my $wb_status = 0;

    if ($conf->get('BATCH_MODE')) {
	my $pkgv = $build->get('Package_OVersion');

	return if !$build->get_conf('AUTO_GIVEBACK');

	if ($status eq "successful") {
	    $db->run_query('--built', "$pkgv");
	    $wb_status = $?;
	} elsif ($status eq "attempted") {
	    $db->run_query('--attempted', "$pkgv");
	    $wb_status = $?;
	} elsif ($status eq "given-back") {
	    $db->run_query('--give-back', "$pkgv");
	    $wb_status = $?;
	    $build->set('Pkg Status', "given-back");
	    $build->log("Giving back package $pkgv after failure in ".
			$build->get('Pkg Fail Stage') ." stage.\n");

	    if (!$wb_status) {
		$build->add_givenback($build, time);
		$build->write_stats('give-back', 1);
	    }
	}

	if ($wb_status) {
	    $build->log("wanna-build failed with status $?\n");
	}
    }
}

sub shutdown ($) {
    my $signame = shift;
    my(@npkgs,@pkgs);
    local( *F );

    $SIG{'INT'} = 'IGNORE';
    $SIG{'QUIT'} = 'IGNORE';
    $SIG{'TERM'} = 'IGNORE';
    $SIG{'ALRM'} = 'IGNORE';
    $SIG{'PIPE'} = 'IGNORE';

# TODO: Use main log
    if (defined($current_job) &&
	defined($jobs{$current_job})) {
	$jobs{$current_job}->log("sbuild received SIG$signame -- shutting down\n");
    }

    if ($conf->get('BATCH_MODE')) {

	# Dump names of unfinished jobs to REDO
	foreach (keys %jobs) {
	    my $job = $jobs{$_};

	    push(@npkgs, $job->get('Package_OVersion'))
		if $job->get('Pkg Status') ne "successful";
	}
	print "The following jobs were not finished: @npkgs\n";

	my $f = "REDO";
	if (-f "REDO.lock") {
	    # if lock file exists, write to a different file -- timing may
	    # be critical
	    $f = "REDO2";
	}
	if (open(F, "<$f")) {
	    @pkgs = <F>;
	    close(F);
	}
	if (open(F, ">>$f")) {
	    foreach (@npkgs) {
		next if grep( /^\Q$_\E\s/, @pkgs );
		print F "$_ " .
		    $jobs{$current_job}->get_conf('DISTRIBUTION');
		print F " " . $jobs{$current_job}->get_conf('BIN_NMU_VERSION')
		    . " " . $jobs{$current_job}->get_conf('BIN_NMU')
		    if (defined $jobs{$current_job}->get_conf('BIN_NMU_VERSION'));
		print F "\n";
	    }
	    close(F);
	}
	else {
	    print "Cannot open $f: $!\n";
	}
	open(F, ">SBUILD-REDO-DUMPED");
	close(F);
	print "SBUILD-REDO-DUMPED created\n";

	unlink("SBUILD-FINISHED");

	# next: say which packages should be uninstalled
	@pkgs = keys %{$jobs{$current_job}->get('Changes')->{'installed'}};
	if (@pkgs) {
	    if (open( F, ">>NEED-TO-UNINSTALL" )) {
		print F "@pkgs\n";
		close( F );
	    }
	    print "The following packages still need to be uninstalled ",
	    "(--purge):\n@pkgs\n";
	}
    }

    # Kill currently running command (if any)
    if (defined($current_job) &&
	defined($jobs{$current_job}) &&
	$jobs{$current_job}->get('Sub PID')) {
	print "Killing " . $jobs{$current_job}->get('Sub Task') .
	    " subprocess " . $jobs{$current_job}->get('Sub PID') . "\n";
	$jobs{$current_job}->get('Session')->run_command(
	    { COMMAND => ['perl', '-e',
			  "\"kill( \\\"TERM\\\", " .
			  $jobs{$current_job}->get('Sub PID') .
			  " )\""],
			  USER => 'root',
			  CHROOT => 1,
			  PRIORITY => 0,
			  DIR => '/' });
    }
    $jobs{$current_job}->remove_srcdep_lock_file();

    # Close logs and send mails
    if (defined($current_job) &&
	defined($jobs{$current_job}) &&
	defined($jobs{$current_job}->get('Session'))) {
	if ($conf->get('PURGE_BUILD_DIRECTORY') eq "always") {
	    $jobs{$current_job}->log("Purging " . $jobs{$current_job}->get('Chroot Build Dir') . "\n");
	    my $bdir = $jobs{$current_job}->get('Session')->strip_chroot_path($jobs{$current_job}->get('Chroot Build Dir'));
	    $jobs{$current_job}->get('Session')->run_command(
		{ COMMAND => [$Sbuild::Sysconfig::programs{'RM'},
			      '-rf', $bdir],
		  USER => 'root',
		  CHROOT => 1,
		  PRIORITY => 0,
		  DIR => '/' });
	}

	$jobs{$current_job}->get('Session')->end_session();
	$jobs{$current_job}->set('Session', undef);

	$jobs{$current_job}->close_build_log();
	$jobs{$current_job}->set('binNMU Name', undef);
    }
    close_log($conf);
    unlink( $jobs{$current_job}->get('Jobs File') ) if $conf->get('BATCH_MODE');
    $? = 0; $! = 0;
    if ($conf->get('SBUILD_MODE') eq "user") {
	exit 1;
    }
    exit 0;
}

sub dump_main_state () {
    print STDERR Data::Dumper->Dump([$current_job,
				     \%jobs],
				    [qw($current_job
					%jobs)] );
}

# avoid intermixing of stdout and stderr
$| = 1;
# in case the terminal disappears, the build should continue
$SIG{'HUP'} = 'IGNORE';
