#!/usr/bin/perl -w
# Copyright © 2009-2013 Bernhard M. Wiedemann
# Copyright © 2012-2016 SUSE LLC
#
# 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/>.
#

use strict;
use threads;

local $Devel::Trace::TRACE;
$Devel::Trace::TRACE = 0;

my $installprefix; # $bmwqemu::scriptdir

BEGIN {
    # the following line is modified during make install
    $installprefix = undef;

    my ($wd) = $0 =~ m-(.*)/-;
    $wd ||= '.';
    $installprefix ||= $wd;
    unshift @INC, "$installprefix";
}

use bmwqemu qw(diag);
use needle;
use autotest;
use Getopt::Std;
require IPC::System::Simple;
use autodie qw(:all);

# avoid paranoia
$Getopt::Std::STANDARD_HELP_VERSION = 1;

sub HELP_MESSAGE {
  print "$0 [-d]\n";
  print "Parses vars.json and tests the given assets/ISOS\n\n";
  print " -d enables direct output to STDERR instead of autoinst-log.txt\n"
}

# enable debug default when started from a tty
$bmwqemu::istty = -t 1; ## no critic
our ($opt_d);
getopts('d');
$bmwqemu::direct_output = $opt_d;

select(STDERR);
$| = 1;
select(STDOUT); # default
$| = 1;

$bmwqemu::scriptdir = $installprefix;
bmwqemu::init();

# Sanity checks
die "No scripts in $bmwqemu::vars{CASEDIR}" if !-e "$bmwqemu::vars{CASEDIR}";

bmwqemu::clean_control_files();

my $init = 1;

# all so ugly ...
sub signalhandler {

    # do not start a race about the results between the threads

    my $sig = shift;
    diag("signalhandler $$: got $sig");
    if ($autotest::running) {
        $autotest::running->fail_if_running();
        $autotest::running = undef;
    }
    if ( threads->tid() == 0 ) {
        bmwqemu::stop_vm();
        # mark it as no longer working
        delete $ENV{WORKERID};
        bmwqemu::save_status();
        # make sure the currently running test is shown as failed
        if (my $test = bmwqemu::current_test()) {
            $test->fail_if_running();
            $test->save_test_result();
        }
    }
    else {
        print STDERR "bug!? signal not received in main thread\n";
    }
    exit(1);
}

$SIG{ALRM} = \&signalhandler;
$SIG{TERM} = \&signalhandler;
$SIG{INT}  = \&signalhandler;
$SIG{HUP}  = \&signalhandler;

$ENV{MOJO_MAX_MESSAGE_SIZE} = 107741824;

# start web background server that provides real time information
# about the ongoing run
use commands;

$bmwqemu::vars{BACKEND} ||= "qemu";

# Load the main.pm from the casedir checked by the sanity checks above
require $bmwqemu::vars{CASEDIR}."/main.pm";

# set a default distribution if the tests don't have one
$testapi::distri ||= distribution->new;

# init part
bmwqemu::save_vars();
# make sure the needles are initialized before the backend thread is started
needle::init();
bmwqemu::init_backend( $bmwqemu::vars{BACKEND} );

if ($init) {
    open( my $fd, ">", "os-autoinst.pid" );
    print $fd "$$\n";
    close $fd;

    # run prestart test code before VM is started
    if (-f "$bmwqemu::vars{CASEDIR}/prestart.pm") {
        diag "running prestart step";
        eval {require $bmwqemu::vars{CASEDIR}."/prestart.pm";};
        if ($@) {
            diag "prestart step FAIL:";
            die $@;
        }
    }

    if ( !bmwqemu::alive ) {
        bmwqemu::start_vm or die $@;
    }
}

my $ct = commands::start_server($bmwqemu::vars{QEMUPORT} + 1);

if ($ENV{RUN_VNCVIEWER}) {
  system("vncviewer -shared localhost:" . $bmwqemu::vars{VNC} . " -viewonly &");
}
if ($ENV{RUN_DEBUGVIEWER}) {
  system("$bmwqemu::scriptdir/debugviewer/debugviewer qemuscreenshot/last.png &");
}

require Carp;

my $r = 0;
eval { autotest::runalltests(); };
if ($@) {
    warn $@;
    $r = 1;
}
else {
    # this is only for still getting screenshots while
    # all testscripts would have been already run
    sleep 10;
}

diag "isotovideo done" unless $r;
diag "FAIL" if $r;

$SIG{ALRM} = 'IGNORE';    # ignore ALRM so the readthread doesn't kill us here

my $clean_shutdown;
eval {
    my $status = $bmwqemu::backend->status();
    $clean_shutdown = 1 if $status||'' eq "shutdown";
};

bmwqemu::stop_vm();
print "killing commands thread\n";
$ct->kill('SIGTERM');
$ct->join();
print "done joining commands thread\n";

# mark hard disks for upload if test finished
if (!$r && (my $nd = $bmwqemu::vars{NUMDISKS})) {
    # if status() died the backend was already dead. So some fatal test
    # probably took it down. Don't upload in that case.
    my @toextract;
    for my $i (1 .. $nd) {
        my $dir = 'assets_private';
        my $name = $bmwqemu::vars{"STORE_HDD_$i"} || undef;
        unless ($name) {
            $name = $bmwqemu::vars{"PUBLISH_HDD_$i"} || undef;
            $dir = 'assets_public';
        }
        next unless $name;
        push @toextract, { hdd_num => $i, name => $name, dir => $dir };
    }
    if (@toextract && !$clean_shutdown) {
        diag "ERROR: Machine not shut down when uploading disks!\n";
    }
    else {
        for my $asset (@toextract) {
            $bmwqemu::backend->extract_assets($asset);
        }
    }
}

# run postrun test code after VM is stopped
if (-f "$bmwqemu::vars{CASEDIR}/postrun.pm") {
    diag "running postrun step";
    eval { require "$bmwqemu::vars{CASEDIR}/postrun.pm"; }; ## no critic
    if ($@) {
        diag "postrun step FAIL:";
        warn $@;
    }
}

# mark it as no longer working
delete $ENV{WORKERID};

# Write JSON result
bmwqemu::save_status();

exit $r;
# vim: set sw=4 et:
