# Copyright 2009-2013 Bernhard M. Wiedemann
# Copyright SUSE LLC
# SPDX-License-Identifier: GPL-2.0-or-later

package bmwqemu;

use Mojo::Base -strict, -signatures;
use autodie ':all';
use Fcntl ':flock';
use Feature::Compat::Try;
use Time::HiRes qw(sleep);
use IO::Socket;
use Carp;
use Mojo::JSON qw(encode_json);
use Cpanel::JSON::XS ();
use File::Path 'remove_tree';
use Data::Dumper;
use Mojo::Log;
use Mojo::File qw(path);
use Term::ANSIColor;

use Exporter 'import';

our $VERSION;
our @EXPORT_OK = qw(diag fctres fctinfo fctwarn modstate save_vars);

require IPC::System::Simple;
use log;

sub mydie;

$| = 1;


# assert timeout, 0 is a valid timeout
our $default_timeout = 30;    ## no critic (Variables::ProhibitPackageVars)
our $openqa_default_share = '/var/lib/openqa/share';    ## no critic (Variables::ProhibitPackageVars)

our $screenshotpath = 'qemuscreenshot';    ## no critic (Variables::ProhibitPackageVars)

# global vars

our @ovmf_locations_no_secure_boot = (    ## no critic (Variables::ProhibitPackageVars)
    '/usr/share/qemu/ovmf-x86_64-4m-code.bin',    # openSUSE qemu-ovmf package
    '/usr/share/qemu/ovmf-x86_64-ms-code.bin',    # openSUSE qemu-ovmf package
);
our @ovmf_locations = (    ## no critic (Variables::ProhibitPackageVars)
    '/usr/share/qemu/ovmf-x86_64-ms-4m-code.bin',    # openSUSE qemu-ovmf package
    '/usr/share/qemu/ovmf-x86_64-ms-code.bin',    # openSUSE qemu-ovmf package
    '/usr/share/edk2.git/ovmf-x64/OVMF_CODE-pure-efi.fd',    # kraxel.org nightly packages
    '/usr/share/edk2/ovmf/OVMF_CODE.fd',    # Fedora's edk2-ovmf package
    '/usr/share/OVMF/OVMF_CODE.fd',    # Debian's ovmf package
);

our %vars;    ## no critic (Variables::ProhibitPackageVars)
tie %vars, 'bmwqemu::tiedvars', %vars;

sub ovmf_locations () { ($vars{UEFI_SECURE_BOOT} // 1) ? \@ovmf_locations : \@ovmf_locations_no_secure_boot }

sub result_dir () { 'testresults' }

# deprecated functions, moved to log module
{
    no warnings 'once';
    *log_format_callback = \&log::log_format_callback;
    *diag = \&log::diag;
    *fctres = \&log::fctres;
    *fctinfo = \&log::fctinfo;
    *fctwarn = \&log::fctwarn;
    *modstate = \&log::modstate;
    *logger = \&log::logger;
    *init_logger = \&log::init_logger;
}

use constant {
    STATE_FILE => 'base_state.json',
    MIB => 1024 * 1024,
    GIB => 1024 * 1024 * 1024,
    STORAGE_KEEP_FREE_RATIO => $ENV{OS_AUTOINST_STORAGE_KEEP_FREE_RATIO} // .2,
    STORAGE_KEEP_FREE_GB => $ENV{OS_AUTOINST_STORAGE_KEEP_FREE_GB} // 50,
};

# Write a JSON representation of the process termination to disk
sub serialize_state (%state) {
    my $message = $state{msg};
    bmwqemu::fctwarn($message) if delete $state{error};
    bmwqemu::diag($message) if delete $state{log};
    # avoid adding message about termination from myjsonrpc as reason, can happen during shutdown and very unlikely about the actual problem
    return undef if $message =~ m/myjsonrpc: remote end terminated/;
    return undef if -e STATE_FILE;
    try { path(STATE_FILE)->spew(encode_json(\%state)) }
    catch ($e) { bmwqemu::diag("Unable to serialize fatal error: $e") }    # uncoverable statement
}

sub load_vars () {
    my $ret = {};
    my $data;
    try { $data = path('vars.json')->slurp }
    catch ($e) { return 0 }
    try { $ret = Cpanel::JSON::XS->new->relaxed->decode($data) }
    catch ($e) { die "parse error in vars.json:\n$e" }
    %vars = %{$ret};
    return;
}

sub save_vars (%args) {
    my $f = path('vars.json');
    my $fd = $f->open('>');
    flock $fd, LOCK_EX or die "cannot lock vars.json: $!\n";
    truncate $fd, 0 or die "cannot truncate vars.json: $!\n";

    my $write_vars = \%vars;
    if ($args{no_secret}) {
        $write_vars = {};
        my $hide_re = '^_SECRET_|_PASSWORD';
        $hide_re .= "|$vars{_HIDE_SECRETS_REGEX}" if $vars{_HIDE_SECRETS_REGEX};
        $write_vars->{$_} = $vars{$_} for grep { !/$hide_re/ } keys %vars;
    }

    # make sure the JSON is sorted
    my $json = Cpanel::JSON::XS->new->pretty->canonical;
    print $fd $json->encode($write_vars);
    return;
}

# set from isotovideo during initialization
our $topdir;    ## no critic (Variables::ProhibitPackageVars)

sub init () {
    load_vars();

    $vars{BACKEND} ||= 'qemu';

    # remove directories for asset upload
    remove_tree('assets_public');
    remove_tree('assets_private');

    remove_tree(result_dir);
    mkdir result_dir;
    mkdir join '/', result_dir, 'ulogs';

    log::init_logger;
}

sub _check_publish_vars () {
    return 0 unless my $nd = $vars{NUMDISKS};
    my @hdds = map { $vars{"HDD_$_"} } 1 .. $nd;
    for my $i (1 .. $nd) {
        for my $type (qw(STORE PUBLISH FORCE_PUBLISH)) {
            my $name = $type . "_HDD_$i";
            next unless my $out = $vars{$name};
            die "HDD_$i also specified in $name. This is not supported" if grep { $_ && $_ eq $out } @hdds;
        }
    }
    return 1;
}

sub _get_storage_stats ($path) {
    my $df_output = qx{df -B1 --output=size,avail "$path"};
    return undef unless defined $df_output;
    my ($total, $available) = $df_output =~ /\s+(\d+)\s+(\d+)\s*$/;
    return ($total, $available);
}

sub default_hdd_size_gb () { 10 }

sub default_numdisks ($v = \%vars) {
    return defined $v->{RAIDLEVEL} ? 4 : 1;
}

sub _abort_if_storage_limit_exceeded () {
    return undef if $ENV{CI} || $ENV{GITHUB_ACTIONS};
    my $keep_free = $vars{STORAGE_KEEP_FREE_RATIO} // STORAGE_KEEP_FREE_RATIO;
    return undef if $keep_free <= 0;
    my $numdisks = $vars{NUMDISKS} // default_numdisks();
    my $total_hdd_size_gb = 0;
    for my $i (1 .. $numdisks) {
        my $size = $vars{"HDDSIZEGB_$i"} // $vars{HDDSIZEGB} // default_hdd_size_gb();
        $total_hdd_size_gb += $size;
    }
    return undef if $total_hdd_size_gb <= 0;
    my ($total_storage, $available) = _get_storage_stats('.');
    return warn "Could not determine available storage space\n" unless defined $total_storage;
    my $requested_bytes = $total_hdd_size_gb * GIB;
    my $min_free_bytes = $total_storage * $keep_free;
    my $keep_free_gb = $vars{STORAGE_KEEP_FREE_GB} // STORAGE_KEEP_FREE_GB;
    my $relative_available = $available - $min_free_bytes;
    my $relative_exceeded = $requested_bytes > $relative_available;
    my $absolute_exceeded = $keep_free_gb > 0 && $requested_bytes > $available - ($keep_free_gb * GIB);
    return undef unless $relative_exceeded && $absolute_exceeded;
    my $msg = sprintf 'Not enough storage for requested HDDSIZEGB (requested %d GiB, available keeping %d%% free: %d GiB, generally available %d GiB, total %d GiB)',
      $total_hdd_size_gb, int($keep_free * 100), $relative_available > 0 ? int($relative_available / GIB) : 0, int($available / GIB), int($total_storage / GIB);
    serialize_state(result => 'incomplete', msg => $msg);
    die "$msg\n";
}

sub ensure_valid_vars () {
    # defaults
    $vars{QEMUPORT} ||= 15_222;
    $vars{VNC} ||= 90;
    # openQA already sets a random string we can reuse
    $vars{JOBTOKEN} ||= random_string(10);

    die 'CASEDIR variable not set, unknown test case directory' if !defined $vars{CASEDIR};
    die "No scripts in CASEDIR '$vars{CASEDIR}'\n" unless -e $vars{CASEDIR};
    die "WHEELS_DIR '$vars{WHEELS_DIR}' does not exist" if defined $vars{WHEELS_DIR} && !-d $vars{WHEELS_DIR};
    _abort_if_storage_limit_exceeded();
    _check_publish_vars();
    save_vars();
}

## some var checks end

# global vars end

# local vars

our $backend;    ## no critic (Variables::ProhibitPackageVars)

# local vars end

# util and helper functions

sub current_test () {
    require autotest;
    no warnings 'once';
    return $autotest::current_test;
}

sub update_line_number () {
    return unless my $current_test = current_test;
    return unless $current_test->{script};
    my @out;
    my $casedir = $vars{CASEDIR} // '';
    for (my $i = 10; $i > 0; $i--) {
        my ($package, $filename, $line, $subroutine) = caller $i;
        next unless $filename && $filename =~ /\Q$casedir/;
        $filename =~ s@$casedir/?@@;
        push @out, "$filename:$line called $subroutine";
    }
    my $step_info = sprintf '[step:%s,%s,%s]',
      $current_test->{category} // '-', $current_test->{name} // '-', ($current_test->{test_count} // 0) + 1;
    log::logger->debug("$step_info " . join ' -> ', @out);
    return;
}

# pretty print like Data::Dumper but without the "VAR1 = " prefix
sub pp (@args) {
    # FTR, I actually hate Data::Dumper.
    my $value_with_trailing_newline = Data::Dumper->new(\@args)->Terse(1)->Useqq(1)->Dump();
    chomp $value_with_trailing_newline;
    return $value_with_trailing_newline;
}

# Use special argument `-masked` to hide the given value in log output.
# It can be specified multiple times and or the value can be a ARRAY_REF or
# scalar.
sub log_call (@args) {
    my $fname = (caller 1)[3];
    update_line_number();

    # extract -masked parameter out of argument list
    my @masked;
    my @effective_args;
    while (@args) {
        my $v = shift @args;
        if (defined($v) && $v eq '-masked' && @args) {
            my $mval = shift @args;
            push @masked, ref($mval) eq 'ARRAY' ? @$mval : $mval;
        } else {
            push @effective_args, $v;
        }
    }

    my $params;
    if (@effective_args == 1) {
        $params = pp($effective_args[0]);
    }
    else {
        # key/value pairs
        my @result;
        while (my ($key, $value) = splice @effective_args, 0, 2) {
            if ($key =~ tr/0-9a-zA-Z_//c) {
                # only quote if needed
                $key = pp($key);
            }
            push @result, join '=', $key, pp($value);
        }
        $params = join ', ', @result;
    }

    foreach (@masked) {
        my $mask = pp($_);
        $mask =~ s/^"(.*)"$/$1/;
        $params =~ s/\Q$mask\E/[masked]/g;
    }

    log::logger->debug('<<< ' . $fname . "($params)");
    return;
}

# util and helper functions end

# backend management

sub stop_vm () {
    return undef unless $backend;
    my $ret = $backend->stop();
    return $ret;
}

sub mydie ($cause_of_death) {
    log_call(cause_of_death => $cause_of_death);
    croak 'mydie';
}

# runtime information gathering functions end


# store the obj as json into the given filename
sub save_json_file ($result, $fn) {
    open my $fd, '>', "$fn.new";
    my $json;
    try { $json = Cpanel::JSON::XS->new->utf8->pretty->canonical->encode($result) }
    catch ($e) {
        my $dump = Data::Dumper->Dump([$result], ['result']);
        croak "Cannot encode input: $e\n$dump";
    }
    print $fd $json;
    close $fd;
    return rename "$fn.new", $fn;
}

sub scale_timeout ($timeout) {
    return $timeout * ($vars{TIMEOUT_SCALE} // 1);
}

=head2 random_string

  random_string([$count]);

Just a random string useful for pseudo security or temporary files.
=cut

sub random_string ($count) {
    $count //= 4;
    my $string;
    my @chars = ('a' .. 'z', 'A' .. 'Z');
    $string .= $chars[rand @chars] for 1 .. $count;
    return $string;
}

# sleeping for one second should ensure that one more screenshot is taken
sub wait_for_one_more_screenshot () { sleep 1 }

package bmwqemu::tiedvars;
use Tie::Hash;
use base qw/ Tie::StdHash /;    # no:style prevent style warning regarding use of Mojo::Base and base in this file
use Carp 'croak';

sub TIEHASH ($class, %args) {
    my $self = bless {
        data => {%args},
    }, $class;
}

sub STORE ($self, $key, $val) {
    croak("Settings key '$key' is invalid (check your test settings)") unless $key =~ m/^(?:[A-Z0-9_]+(\[\])?)\z/;
    $self->{data}->{$key} = $val;
}

sub FIRSTKEY ($self) {
    my $data = $self->{data};
    my @k = keys %$data;    # reset
    my $next = each %$data;
}

sub NEXTKEY ($self, $last) {
    my $data = $self->{data};
    my $next = each %$data;
}

sub FETCH ($self, $key) {
    my $val = $self->{data}->{$key};
}

sub DELETE ($self, $key) { delete $self->{data}->{$key} }

sub EXISTS ($self, $key) { exists $self->{data}->{$key} }

sub CLEAR ($self) { $self->{data} = {} }

sub SCALAR ($self) { scalar %{$self->{data}} }

1;
