isotovideo

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

=head1 SYNOPSIS

isotovideo [OPTIONS] [TEST PARAMETER]

Parses vars.json and tests the given assets/ISOs.

=head1 OPTIONS

=over 4

=item B<-d, --debug>

Enable direct output to STDERR instead of autoinst-log.txt

=item B<-v, --version>

Show the current program version and test API version

=item B<-h, -?, --help>

Show this help.

=head1 TEST PARAMETER

All additional command line arguments specified in the C<key=value> format are
parsed as test parameters which take precedence over the settings in the
vars.json file. Lower case key names are transformed into upper case
automatically for convenience.

=cut

use strict;
use warnings;
use autodie ':all';
no autodie 'kill';

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;
use needle;
use autotest;
use commands;
use distribution;
use testapi 'diag';
use File::Basename;
use Getopt::Long;
require IPC::System::Simple;
use POSIX qw(:sys_wait_h _exit);
use Time::HiRes qw(gettimeofday tv_interval sleep time);
use Try::Tiny;
use File::Spec;
use File::Path;
use Mojo::UserAgent;
use Mojo::IOLoop::ReadWriteProcess 'process';
use Mojo::IOLoop::ReadWriteProcess::Session 'session';
Getopt::Long::Configure("no_ignore_case");
use OpenQA::Isotovideo::CommandHandler;
use OpenQA::Isotovideo::Interface;
use OpenQA::Isotovideo::Utils qw(checkout_git_repo_and_branch checkout_git_refspec);

session->enable;
session->enable_subreaper;

my %options;
# global exit status
my $return_code = 1;

sub usage {
    my ($usage_return_code) = @_;
    $return_code = $usage_return_code;
    eval { use Pod::Usage; pod2usage($return_code); };
    if ($@) {
        die "cannot display help, install perl(Pod::Usage)\n";
    }
}

sub _get_version_string {
    my $dirname     = dirname(__FILE__);
    my $thisversion = qx{git -C $dirname rev-parse HEAD};
    chomp $thisversion;
    die 'Could not parse version' unless $thisversion;
    return "Current version is $thisversion [interface v$OpenQA::Isotovideo::Interface::version]";
}

sub version {
    print _get_version_string() . "\n";
    exit 0;
}

GetOptions(\%options, 'debug|d', 'help|h|?', 'version|v') or usage(1);
usage(0)  if $options{help};
version() if $options{version};

diag(_get_version_string());

# enable debug default when started from a tty
$bmwqemu::direct_output = $options{debug};

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

$bmwqemu::scriptdir = $installprefix;
bmwqemu::init();
for my $arg (@ARGV) {
    if ($arg =~ /^([[:alnum:]_\[\]\.]+)=(.+)/) {
        my $key = uc $1;
        $bmwqemu::vars{$key} = $2;
        diag("Setting forced test parameter $key -> $2");
    }
}

my $cmd_srv_process;
my $command_handler;
my $testprocess;
my $cmd_srv_fd;
my $cmd_srv_port;
my $backend_process;
my $loop = 1;

# note: The subsequently defined stop_* functions are used to tear down the process tree.
#       However, the worker also ensures that all processes are being terminated (and
#       eventually killed).

sub stop_commands {
    my ($reason) = @_;
    return unless defined $cmd_srv_process;
    return unless $cmd_srv_process->is_running;

    my $pid = $cmd_srv_process->pid;
    diag("terminating command server $pid because $reason");

    # inform websocket clients
    # note: If the job is stopped by the worker because it has been aborted, the worker will send this command
    #       on its own to the command server and also stop the command server. So this is only done in the case
    #       the test execution just ends.
    if ($cmd_srv_port && $reason && $reason eq 'test execution ended') {
        my $job_token = $bmwqemu::vars{JOBTOKEN};
        my $url       = "http://127.0.0.1:$cmd_srv_port/$job_token/broadcast";
        diag('isotovideo: informing websocket clients before stopping command server: ' . $url);

        my $timeout = 15;
        my $ua      = Mojo::UserAgent->new(request_timeout => $timeout);
        my $tx      = $ua->post($url, json => {stopping_test_execution => $reason});
        try {
            my $res = $tx->result;
            if ($res->code != 200) {
                my $error_message = $res->to_string;
                diag('isotovideo: unable to inform websocket clients about stopping command server: ' . $error_message);
                if ($error_message =~ qr/.*timeout.*/i) {
                    diag("isotovideo: The command server could be under heavy load and the timeout of $timeout seconds has been exceeded. This message is most likely not be related to the MAX_JOB_TIME of the current job possibly being exceeded.");
                }
                else {
                    diag('The command server might have already been stopped by the worker after the user has aborted the job or the job timeout has been exceeded.');
                }
            }
        }
        catch {
            diag('isotovideo: unable to inform websocket clients about stopping command server: ' . $_);
        };
    }

    # stop the command server
    $cmd_srv_process->stop() if $cmd_srv_process->is_running;
    $cmd_srv_process = undef;
    diag('done with command server');
}

sub stop_autotest {
    return unless defined $testprocess;

    diag('stopping autotest process ' . $testprocess->pid);
    $testprocess->stop() if $testprocess->is_running;
    $testprocess = undef;
    diag('done with autotest process');
}

sub stop_backend {
    return unless defined $bmwqemu::backend && $backend_process;

    diag('stopping backend process ' . $backend_process->pid);
    $backend_process->stop if $backend_process->is_running;
    $backend_process = undef;
    diag('done with backend process');
}

sub signalhandler {
    my ($sig) = @_;
    diag("signalhandler got $sig");
    if ($loop) {
        $loop = 0;
        return;
    }
    stop_backend;
    stop_commands("received signal $sig");
    stop_autotest;
    _exit(1);
}

sub init_backend {
    my ($name) = @_;

    $bmwqemu::vars{BACKEND} ||= "qemu";
    $bmwqemu::backend = backend::driver->new($bmwqemu::vars{BACKEND});
    return $bmwqemu::backend;
}

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

# make sure all commands coming from the backend will not be in the
# developers's locale - but a defined english one. This is SUSE's
# default locale
$ENV{LC_ALL} = 'en_US.UTF-8';
$ENV{LANG}   = 'en_US.UTF-8';

checkout_git_repo_and_branch('CASEDIR');

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

# checkout Git repo NEEDLES_DIR refers to (if it is a URL) and re-assign NEEDLES_DIR to contain the checkout path
checkout_git_repo_and_branch('NEEDLES_DIR');

bmwqemu::ensure_valid_vars();

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

$bmwqemu::vars{TEST_GIT_HASH} = checkout_git_refspec($bmwqemu::vars{CASEDIR} => 'TEST_GIT_REFSPEC');

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

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

# 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';
if ($bmwqemu::vars{SCHEDULE}) {
    diag 'Enforced test schedule by \'SCHEDULE\' variable in action';
    $bmwqemu::vars{INCLUDE_MODULES} = undef;
    autotest::loadtest($_ . '.pm') foreach split(',', $bmwqemu::vars{SCHEDULE});
    $bmwqemu::vars{INCLUDE_MODULES} = 'none';
}
my $productdir = $bmwqemu::vars{PRODUCTDIR};
my $main_path  = File::Spec->catfile($productdir, 'main.pm');
if (-e $main_path) {
    unshift @INC, '.';
    require $main_path;
}
elsif (!File::Spec->file_name_is_absolute($productdir) && -e File::Spec->catfile($bmwqemu::vars{CASEDIR}, $main_path)) {
    require File::Spec->catfile($bmwqemu::vars{CASEDIR}, $main_path);
}
elsif (!$bmwqemu::vars{SCHEDULE}) {
    die '\'SCHEDULE\' not set and ' . $productdir . '/main.pm not found, need one of both';
}
@INC = @oldINC;

if ($bmwqemu::vars{_EXIT_AFTER_SCHEDULE}) {
    diag 'Early exit has been requested with _EXIT_AFTER_SCHEDULE. Only evaluating test schedule.';
    exit 0;
}
testapi::init();
needle::init();
bmwqemu::save_vars();

my $testfd;
($testprocess, $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();
}

# launch debugging tools
my %debugging_tools;
$debugging_tools{vncviewer} = ['vncviewer', '-viewonly', '-shared', "localhost:$bmwqemu::vars{VNC}"] if $ENV{RUN_VNCVIEWER};
$debugging_tools{debugviewer} = ["$bmwqemu::scriptdir/debugviewer/debugviewer", 'qemuscreenshot/last.png'] if $ENV{RUN_DEBUGVIEWER};
for my $tool (keys %debugging_tools) {
    next if fork() != 0;
    no autodie 'exec';
    { exec(@{$debugging_tools{$tool}}) };
    exit -1;    # don't continue in any case (exec returns if it fails to spawn the process printing an error message on its own)
}

use IO::Select;

$backend_process = $bmwqemu::backend->{backend_process};
my $io_select = IO::Select->new();
$io_select->add($testfd);
$io_select->add($cmd_srv_fd);
$io_select->add($backend_process->channel_out);

# stop main loop as soon as one of the child processes terminates
my $stop_loop = sub { $loop = 0 if $loop; };
$testprocess->once(collected => $stop_loop);
$backend_process->once(collected => $stop_loop);
$cmd_srv_process->once(collected => $stop_loop);

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

$command_handler = OpenQA::Isotovideo::CommandHandler->new(
    cmd_srv_fd => $cmd_srv_fd,
    backend_fd => $backend_process->channel_in,
);
$command_handler->on(tests_done => sub {
        CORE::close($testfd);
        $testfd = undef;
        stop_autotest;
        $loop = 0;
});

my ($last_check_seconds, $last_check_microseconds) = gettimeofday;
sub _calc_check_delta {
    # an estimate of eternity
    my $delta = 100;
    if ($last_check_seconds) {
        $delta = tv_interval([$last_check_seconds, $last_check_microseconds], [gettimeofday]);
    }
    # sleep the remains of one second if $delta > 0
    my $timeout = $delta > 0 ? 1 - $delta : 0;
    $command_handler->timeout($timeout < 0 ? 0 : $timeout);
    return $delta;
}

sub check_asserted_screen {
    my $no_wait = shift;

    if ($no_wait) {
        # prevent CPU overload by waiting at least a little bit
        $command_handler->timeout(0.1);
    }
    else {
        _calc_check_delta;
        # come back later, avoid too often called function
        return if $command_handler->timeout > 0.05;
    }
    ($last_check_seconds, $last_check_microseconds) = gettimeofday;
    my $rsp = $bmwqemu::backend->_send_json({cmd => 'check_asserted_screen'}) || {};
    # the test needs that information
    $rsp->{tags} = $command_handler->tags;
    if ($rsp->{found} || $rsp->{timeout}) {
        myjsonrpc::send_json($testfd, {ret => $rsp});
        $command_handler->clear_tags_and_timeout();
    }
    else {
        _calc_check_delta unless $no_wait;
    }
}

$return_code = 0;

# enter the main loop: process messages from autotest, command server and backend
while ($loop) {
    my ($ready_for_read, $ready_for_write, $exceptions) = IO::Select::select($io_select, undef, $io_select, $command_handler->timeout);
    for my $readable (@$ready_for_read) {
        my $rsp = myjsonrpc::read_json($readable);
        if (!defined $rsp) {
            diag sprintf("THERE IS NOTHING TO READ %d %d %d", fileno($readable), fileno($testfd), fileno($cmd_srv_fd));
            $readable = 1;
            $loop     = 0;
            last;
        }
        if ($readable == $backend_process->channel_out) {
            $command_handler->send_to_backend_requester({ret => $rsp->{rsp}});
            next;
        }
        $command_handler->process_command($readable, $rsp);
    }
    if (defined($command_handler->tags)) {
        check_asserted_screen($command_handler->no_wait);
    }
}

# tell the command server that it should no longer process isotovideo commands since we've
# just left the loop which would handle such commands (otherwise the command server would just
# hang on the next isotovideo command)
$command_handler->stop_command_processing;

# terminate/kill the command server and let it inform its websocket clients before
stop_commands('test execution ended');

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

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

my $clean_shutdown;
if (!$return_code) {
    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 stop it later
    eval { bmwqemu::stop_vm(); };
    if ($@) {
        diag "Error during stop_vm: $@";
        $return_code = 1;
    }
}

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

sub store_asset {
    my ($index, $name, $dir) = @_;
    $name =~ /\.([[:alnum:]]+)$/;
    my $format = $1;
    return {hdd_num => $index, name => $name, dir => $dir, format => $format};
}

sub handle_generated_assets {
    # mark hard disks for upload if test finished
    return unless !$return_code && $command_handler->test_completed && ($bmwqemu::vars{BACKEND} eq 'qemu');
    my @toextract;
    my $nd = $bmwqemu::vars{NUMDISKS};
    if ($command_handler->test_completed) {
        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, store_asset($i, $name, $dir);
        }
        if ($bmwqemu::vars{UEFI} && $bmwqemu::vars{PUBLISH_PFLASH_VARS}) {
            push(@toextract, {pflash_vars => 1,
                    name   => $bmwqemu::vars{PUBLISH_PFLASH_VARS},
                    dir    => 'assets_public',
                    format => 'qcow2'});
        }
        if (@toextract && !$clean_shutdown) {
            diag "ERROR: Machine not shut down when uploading disks!\n";
            $return_code = 1;
            return;
        }
    }
    for my $i (1 .. $nd) {
        my $name = $bmwqemu::vars{"FORCE_PUBLISH_HDD_$i"} || next;
        diag "Requested to force the publication of '$name'";
        push @toextract, store_asset($i, $name, 'assets_public');
    }
    for my $asset (@toextract) {
        local $@;
        eval { $bmwqemu::backend->extract_assets($asset); };
        if ($@) {
            diag "extract assets failed: $@";
            $return_code = 1;
        }
    }
}
handle_generated_assets;

END {
    stop_backend;
    stop_commands('test execution ended through exception');
    stop_autotest;

    # in case of early exit, e.g. help display
    $return_code //= 0;

    print "$$: EXIT $return_code\n";
    $? = $return_code;
}