#!/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;

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";
}

# this shall be an integer increased by every change of the API
# either to the worker or the tests
our $INTERFACE = 6;

use bmwqemu;
use needle;
use autotest;
use commands;
use distribution;
use testapi qw(diag);
use Getopt::Std;
require IPC::System::Simple;
use autodie qw(:all);
no autodie qw(kill);
use Cwd;
use POSIX qw(:sys_wait_h _exit);
use Carp qw(cluck);
use Time::HiRes qw(gettimeofday tv_interval sleep);

# 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;

# global exit status
my $r = 1;
# whether tests completed (or we bailed due to a failed 'fatal' test)
my $completed = 0;

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

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

# Sanity checks
die "CASEDIR environment variable not set, unknown test case directory" if !defined $bmwqemu::vars{CASEDIR};
die "No scripts in $bmwqemu::vars{CASEDIR}" if !-e "$bmwqemu::vars{CASEDIR}";

my $cpid;
my $testpid;
my $cfd;

my $loop = 1;

sub kill_commands {
    return unless $cpid;
    # create a copy as cpid is overwritten by SIGCHLD
    my $pid = $cpid;
    if (kill('TERM', $pid)) {
        diag "awaiting death of commands process";
        my $ret = waitpid($pid, 0);
        diag "commands process exited: $ret";
    }
    $cpid = 0;
}

sub kill_autotest {
    return unless $testpid;
    # create a copy as cpid is overwritten by SIGCHLD
    my $pid = $testpid;
    if (kill('TERM', $pid)) {
        diag "awaiting death of testpid $pid";
        my $ret = waitpid($pid, 0);
        diag "test process exited: $ret";
    }
    $testpid = 0;
}

sub kill_backend {
    if (defined $bmwqemu::backend && $bmwqemu::backend->{backend_pid}) {
        # save the pid in a scalar - signal handlers will reset it
        my $bpid = $bmwqemu::backend->{backend_pid};
        diag "killing backend process $bpid";
        kill('TERM', $bpid);
        waitpid($bpid, 0);
        diag("done with backend process");
        $bmwqemu::backend->{backend_pid} = 0;
    }
}

sub signalhandler {

    my ($sig) = @_;
    diag("signalhandler got $sig - loop $loop");
    if ($loop) {
        $loop = 0;
        return;
    }
    kill_backend;
    kill_commands;
    kill_autotest;
    _exit(1);
}

sub signalhandler_chld {

    diag("got sigchld");

    while ((my $child = waitpid(-1, WNOHANG)) > 0) {
        if ($child == $cpid) {
            diag("commands webserver died");
            $loop = 0;
            $cpid = 0;
            next;
        }
        if ($bmwqemu::backend->{backend_pid} && $child == $bmwqemu::backend->{backend_pid}) {
            diag("backend $child died");
            $bmwqemu::backend->{backend_pid} = 0;
            $bmwqemu::backend->{to_child}    = undef;
            $bmwqemu::backend->{from_child}  = undef;
            $loop                            = 0;
            next;
        }
        if ($child == $testpid) {
            diag("tests died");
            $testpid = 0;
            $loop    = 0;
            next;
        }
        diag("unknown child $child died");
    }
}

sub init_backend {
    my ($name) = @_;
    $bmwqemu::vars{BACKEND} ||= "qemu";
    # make sure the needles are initialized before the backend process is started
    needle::init($bmwqemu::vars{PRODUCTDIR} . "/needles");
    $bmwqemu::backend = backend::driver->new($bmwqemu::vars{BACKEND});
    return $bmwqemu::backend;
}

our $test_git_hash;

sub calculate_git_hash {
    my $dir = getcwd;
    chdir($bmwqemu::vars{CASEDIR});
    chomp($test_git_hash = qx{git rev-parse HEAD});
    $test_git_hash ||= "UNKNOWN";
    chdir($dir);
    diag "git hash of test distribution: $test_git_hash";
    return $test_git_hash;
}

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

# Try to load the main.pm from one of the following in this order:
#  - product dir
#  - casedir
#
# This allows further structuring the test distribution collections with
# multiple distributions or flavors in one repository.
$bmwqemu::vars{PRODUCTDIR} ||= $bmwqemu::vars{CASEDIR};

# as we are about to load the test modules store the git hash that has been
# used. If it is not a git repo fail silently, i.e. store an empty variable

calculate_git_hash;
# TODO find a better place to store hash in than vars.json, see
# https://github.com/os-autoinst/os-autoinst/pull/393#discussion_r50143013
$bmwqemu::vars{TEST_GIT_HASH} = $test_git_hash;

# start the command fork before we get into the backend, the command child
# is not supposed to talk to the backend directly
($cpid, $cfd) = commands::start_server($bmwqemu::vars{QEMUPORT} + 1);

# add lib of the test distributions - but only for main.pm not to pollute
# further dependencies (the tests get it through autotest)
my @oldINC = @INC;
unshift @INC, $bmwqemu::vars{CASEDIR} . '/lib';
require $bmwqemu::vars{PRODUCTDIR} . "/main.pm";
@INC = @oldINC;

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

testapi::init();

# init part
bmwqemu::save_vars();

my $testfd;
($testpid, $testfd) = autotest::start_process();

init_backend();

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

if (!$bmwqemu::backend->_send_json({cmd => 'alive'})) {
    # might throw an exception
    $bmwqemu::backend->start_vm();
}

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

use IO::Select;

my $s = IO::Select->new();
$s->add($testfd);
$s->add($cfd);
$s->add($bmwqemu::backend->{from_child});

# now we have everything, give the tests a go
$testfd->write("GO\n");

my $interactive = 0;
my $needinput   = 0;

my $current_test_name;

# timeout for the select (only set for check_screens)
my $timeout = undef;

# marks a running check_screen
our $tags = undef;

# set to the socket we have to send replies to when the backend is done
my $backend_requester = undef;

sub check_asserted_screen {
    my ($force_timeout) = @_;

    my ($seconds, $microseconds) = gettimeofday;
    my $rsp = $bmwqemu::backend->_send_json({cmd => 'check_asserted_screen'}) || {};
    # the test needs that information
    $rsp->{tags} = $tags;
    if ($rsp->{found}) {
        myjsonrpc::send_json($testfd, {ret => $rsp});
        $tags = $timeout = undef;
    }
    elsif ($rsp->{timeout}) {
        if ($interactive && !$force_timeout) {
            # now get fancy
            $bmwqemu::backend->_send_json({cmd => 'freeze_vm'});
            $rsp->{saveresult} = 1;
            myjsonrpc::send_json($testfd, {ret => $rsp});
            $needinput = 1;
        }
        else {
            myjsonrpc::send_json($testfd, {ret => $rsp});
            $tags = undef;
        }
        $timeout = undef;
    }
    else {
        my $delta = tv_interval([$seconds, $microseconds], [gettimeofday]);
        if ($delta > 0) {
            # sleep the remains of one second
            $timeout = 1 - $delta;
        }
        else {
            $timeout = 0;
        }
    }
}

$r = 0;

while ($loop) {
    my ($reads, $writes, $exceps) = IO::Select::select($s, undef, $s, $timeout);
    for my $r (@$reads) {
        my $rsp = myjsonrpc::read_json($r);
        if (!defined $rsp) {
            diag sprintf("THERE IS NOTHING TO READ %d %d %d", fileno($r), fileno($testfd), fileno($cfd));
            $r    = 1;
            $loop = 0;
            last;
        }
        if ($r == $bmwqemu::backend->{from_child}) {
            myjsonrpc::send_json($backend_requester, {ret => $rsp->{rsp}});
            $backend_requester = undef;
            next;
        }
        if ($rsp->{cmd} =~ m/^backend_(.*)/) {
            die "we need to implement a backend queue" if $backend_requester;
            $backend_requester = $r;
            my $cmd = $1;
            delete $rsp->{cmd};
            myjsonrpc::send_json($bmwqemu::backend->{to_child}, {cmd => $cmd, arguments => $rsp});
            next;
        }
        if ($rsp->{cmd} eq 'set_current_test') {
            $bmwqemu::backend->_send_json({cmd => 'set_serial_offset'});
            $current_test_name = $rsp->{name};
            myjsonrpc::send_json($r, {ret => 1});
            next;
        }
        if ($rsp->{cmd} eq 'tests_done') {
            $r         = $rsp->{died};
            $completed = $rsp->{completed};
            CORE::close($testfd);
            $testfd = undef;
            kill_autotest;
            $loop = 0;
            next;
        }
        if ($rsp->{cmd} eq 'check_screen') {
            my $mustmatch = $rsp->{mustmatch};
            my $timeout   = $rsp->{timeout};
            my $check     = $rsp->{check};

            $tags = $bmwqemu::backend->_send_json(
                {
                    cmd       => 'set_tags_to_assert',
                    arguments => {
                        mustmatch => $mustmatch,
                        timeout   => $timeout
                    }})->{tags};
            next;
        }

        ##### HTTP commands
        if ($rsp->{cmd} eq 'status') {
            my $result = {tags => $tags, running => $current_test_name};
            $result->{interactive} = $interactive;
            $result->{needinput}   = $needinput;
            myjsonrpc::send_json($r, $result);
            next;
        }

        if ($rsp->{cmd} eq 'version') {
            my $result = {test_git_hash => $test_git_hash, version => $INTERFACE};
            myjsonrpc::send_json($r, $result);
            next;
        }

        if ($rsp->{cmd} eq 'interactive') {
            # interactive is boolean
            $interactive = $rsp->{params}->{state} ? 1 : 0;
            if (!$interactive && $needinput) {
                # need to continue the VM
                $bmwqemu::backend->_send_json({cmd => 'retry_assert_screen'});
                $needinput = 0;
                $timeout   = .1;
                check_asserted_screen(1);
            }
            myjsonrpc::send_json($r, {interactive => $interactive});
            next;
        }

        if ($rsp->{cmd} eq 'stop_waitforneedle') {
            $bmwqemu::backend->_send_json({cmd => 'reduce_deadline'});
            myjsonrpc::send_json($r, {ret => 0});
            next;
        }
        if ($rsp->{cmd} eq 'continue_waitforneedle' || $rsp->{cmd} eq 'reload_needles') {
            $needinput = 0;
            $timeout   = .1;
            my $reload = $rsp->{cmd} eq 'reload_needles';
            # tell backend to retry
            $bmwqemu::backend->_send_json({cmd => 'retry_assert_screen', arguments => {reload_needles => $reload}});
            # that's enough for the webui to know
            myjsonrpc::send_json($r, {ret => 0});
            check_asserted_screen(1);
            next;
        }
        die "Unknown command $rsp->{cmd}";
    }

    if (defined $tags && !$needinput) {
        check_asserted_screen;
    }
}

# don't leave the commands server open - it will no longer react anyway
# as most of it ends up in the loop above
kill_commands;

if ($testfd) {
    $r = 1;    # unusual shutdown
    CORE::close $testfd;
    kill_autotest;
}

diag "isotovideo " . ($r ? 'failed' : 'done');

my $clean_shutdown;
if (!$r) {
    eval {
        $clean_shutdown = $bmwqemu::backend->_send_json({cmd => 'is_shutdown'});
        diag "BACKEND SHUTDOWN $clean_shutdown";
    };
    # don't rely on the backend in a sane state if we failed - just kill it later
    bmwqemu::stop_vm();
}

# read calculated variables from backend and tests
bmwqemu::load_vars();

# mark hard disks for upload if test finished
if (!$r && $completed && (my $nd = $bmwqemu::vars{NUMDISKS})) {
    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;
        $name =~ /\.([[:alnum:]]+)$/;
        my $format = $1;
        push @toextract, {hdd_num => $i, name => $name, dir => $dir, format => $format};
    }
    if (@toextract && !$clean_shutdown) {
        diag "ERROR: Machine not shut down when uploading disks!\n";
        $r = 1;
    }
    else {
        for my $asset (@toextract) {
            $bmwqemu::backend->extract_assets($asset);
        }
    }
}

END {
    kill_backend;
    kill_commands;
    kill_autotest;
    print "$$: EXIT $r\n";
    _exit($r);
}

# vim: set sw=4 et:
