Skip to content
Switch branches/tags
Go to file
Cannot retrieve contributors at this time
executable file 2288 lines (1682 sloc) 68.5 KB
# 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
# 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 <>.
package testapi;
use base Exporter;
use Carp;
use Exporter;
use 5.018;
use warnings;
use File::Basename qw(basename dirname);
use File::Path 'make_path';
use Time::HiRes qw(sleep gettimeofday tv_interval);
use autotest 'query_isotovideo';
use Mojo::DOM;
require IPC::System::Simple;
use autodie ':all';
use OpenQA::Exceptions;
use OpenQA::Isotovideo::NeedleDownloader;
use Digest::MD5 'md5_base64';
use Carp qw(cluck croak);
use MIME::Base64 'decode_base64';
use Scalar::Util qw(looks_like_number reftype);
use B::Deparse;
require bmwqemu;
use constant OPENQA_LIBPATH => '/usr/share/openqa/lib';
our @EXPORT = qw($realname $username $password $serialdev %cmd %vars
get_var get_required_var check_var set_var get_var_array check_var_array autoinst_url
send_key send_key_until_needlematch type_string type_password
hold_key release_key
assert_screen check_screen assert_and_dclick save_screenshot
assert_and_click mouse_hide mouse_set mouse_click
mouse_dclick mouse_tclick match_has_tag click_lastmatch mouse_drag
assert_script_run script_run assert_script_sudo script_sudo
script_output validate_script_output
start_audiocapture assert_recorded_sound check_recorded_sound
select_console console reset_consoles current_console
upload_asset data_url check_shutdown assert_shutdown parse_junit_log parse_extra_log upload_logs
wait_screen_change assert_screen_change wait_still_screen assert_still_screen wait_serial
record_soft_failure record_info force_soft_failure
become_root x11_start_program ensure_installed eject_cd power
save_memory_dump save_storage_drives freeze_vm resume_vm
diag hashed_string
save_tmp_file get_test_data
our @EXPORT_OK = qw(is_serial_terminal);
our %cmd;
our $distri;
our $realname = "Bernhard M. Wiedemann";
our $username;
our $password;
our $serialdev;
our $last_matched_needle;
sub send_key;
sub check_screen;
sub type_string;
sub type_password;
sub enter_cmd;
=head1 introduction
=for stopwords os autoinst isotovideo openQA
This test API module provides methods exposed by the os-autoinst backend to be
used within tests.
Many methods define a timeout parameter which can be scaled by setting the
C<TIMEOUT_SCALE> variable in the test settings which are read by the isotovideo
process. The scale parameter can be used based on performance of workers to
prevent false positive timeouts based on differing worker performance.
os-autoinst is used in the openQA project.
+For more information on how to use openQA, please visit
=head1 internal
=head2 _calculate_clickpoint
This subroutine is used to by several subroutines dealing with mouse clicks to calculate
a clickpoint, when only the needle area is available. It takes the area coordinates and
returns the center of that area. It is meant to be a helper subroutine not available
to be used in tests.
sub _calculate_clickpoint {
my ($needle_to_use, $needle_area, $click_point) = @_;
# If there is no needle area defined, take it from the needle itself.
if (!$needle_area) {
$needle_area = $needle_to_use->{area}->[-1];
# If there is no clickpoint defined, or if it has been specifically defined as "center"
# then calculate the click point as a central point of the specified area.
if (!$click_point || $click_point eq 'center') {
$click_point = {
xpos => $needle_area->{w} / 2,
ypos => $needle_area->{h} / 2,
# Use the click point coordinates (which are relative numbers inside of the area)
# to calculate the absolute click point position.
my $x = int($needle_area->{x} + $click_point->{xpos});
my $y = int($needle_area->{y} + $click_point->{ypos});
return $x, $y;
=for stopwords xen hvc0 xvc0 ipmi ttyS
=head2 init
Used for internal initialization, do not call from tests.
sub init {
if (get_var('OFW') || get_var('BACKEND', '') =~ /s390x|pvm_hmc/) {
$serialdev = "hvc0";
elsif (get_var('SERIALDEV')) {
$serialdev = get_var('SERIALDEV');
else {
$serialdev = 'ttyS0';
=for stopwords ProhibitSubroutinePrototypes
=head2 set_distribution
Set distribution object.
You can use distribution object to implement distribution specific helpers.
sub set_distribution {
($distri) = @_;
return $distri->init();
=for stopwords SUT
=head1 video output handling
=head2 save_screenshot
Saves screenshot of current SUT screen.
sub save_screenshot {
return $autotest::current_test->take_screenshot;
=head2 record_soft_failure
=for stopwords softfail
Record a soft failure on the current test modules result. The result will
still be counted as a success. Use this to mark where workarounds are applied.
Takes an optional C<$reason> string which is recorded in the log file. See
C<force_soft_failure> to forcefully override a failed test module status from
a C<post_fail_hook> or C<record_info> when the status should not be
sub record_soft_failure {
my ($reason) = @_;
bmwqemu::log_call(reason => $reason);
sub _is_valid_result {
my ($result) = @_;
return $result =~ /^(ok|fail|softfail)$/;
=head2 record_info
=for stopwords softfail
record_info($title, $output [, result => $result] [, resultname => $resultname]);
record_info('workaround', "we know what we are doing");
Record a generic step result on the current test modules. This is meant for
informational purposes to be interpreted by a displaying system. For example
openQA can show a info box as part of the job results details. Use this
instead of C<record_soft_failure> for example when you do not want to mark the
job as a softfail. The optional value C<$result> can be 'ok' (default),
'fail', 'softfail'. C<$resultname> can be specified for the additional name
tag on the result file.
sub record_info {
my ($title, $output, %nargs) = @_;
$nargs{result} //= 'ok';
die 'unsupported $result \'' . $nargs{result} . '\'' unless _is_valid_result($nargs{result});
bmwqemu::log_call(title => $title, output => $output, %nargs);
$autotest::current_test->record_resultfile($title, $output, %nargs);
=head2 force_soft_failure
=for stopwords softfail
Similar to C<record_soft_failure> but can be used to override the test module
status to softfail from a C<post_fail_hook> if the module would be set to fail
otherwise. This can be used for easier tracking of known issues without
needing to handle failed tests a lot.
sub force_soft_failure {
my ($reason) = @_;
bmwqemu::log_call(reason => $reason);
$autotest::current_test->record_soft_failure_result($reason, force_status => 1);
sub _handle_found_needle {
my ($foundneedle, $rsp, $tags) = @_;
# convert the needle back to an object
$foundneedle->{needle} = needle->new($foundneedle->{needle});
my $img = tinycv::from_ppm(decode_base64($rsp->{image}));
my $frame = $rsp->{frame};
$autotest::current_test->record_screenmatch($img, $foundneedle, $tags, $rsp->{candidates}, $frame);
my $lastarea = $foundneedle->{area}->[-1];
sprintf("found %s, similarity %.2f @ %d/%d", $foundneedle->{needle}->{name}, $lastarea->{similarity}, $lastarea->{x} // 0, $lastarea->{y} // 0));
$last_matched_needle = $foundneedle;
return $foundneedle;
sub _check_backend_response {
my ($rsp, $check, $timeout, $mustmatch) = @_;
my $tags = $rsp->{tags};
if (my $foundneedle = $rsp->{found}) {
return _handle_found_needle($foundneedle, $rsp, $tags);
elsif ($rsp->{timeout}) {
my $method = $check ? 'check_screen' : 'assert_screen';
my $status_message = "match=" . join(',', @$tags) . " timed out after $timeout ($method)";
# add the final mismatch as 'unk' result to be able to create a new needle from it
# note: add the screenshot only if configured to pause on timeout - otherwise we would
# record each failure twice
my $failed_screens = $rsp->{failed_screens};
my $final_mismatch = $failed_screens->[-1];
if (query_isotovideo(is_configured_to_pause_on_timeout => {check => $check})) {
my $current_test = $autotest::current_test;
if ($final_mismatch) {
img => tinycv::from_ppm(decode_base64($final_mismatch->{image})),
needles => $final_mismatch->{candidates},
tags => $tags,
result => 'unk',
frame => $final_mismatch->{frame},
else {
bmwqemu::fctwarn("ran into $method timeout but there's no final mismatch - just taking a screenshot");
# do a special rpc call to isotovideo which will block if the test should be paused
# (if the test should not be paused this call will return 0; on resume (after pause) it will return 1)
query_isotovideo('report_timeout', {
tags => $tags,
msg => $status_message,
check => $check,
}) and return 'try_again';
if ($check) {
# only care for the last one
$failed_screens = [$final_mismatch];
for my $l (@$failed_screens) {
my $img = tinycv::from_ppm(decode_base64($l->{image}));
my $result = $check ? 'unk' : 'fail';
$result = 'unk' if ($l != $final_mismatch);
if ($rsp->{saveresult}) {
img => $img,
needles => $l->{candidates},
tags => $tags,
result => $result,
frame => $l->{frame},
else {
img => $img,
needles => $l->{candidates},
tags => $tags,
result => $result,
overall => $check ? undef : 'fail',
frame => $l->{frame},
# Handle case where a stall was detected: fail if this is an
# assert_screen, warn if it's a check_screen
if ($rsp->{stall}) {
if (!$check) {
record_info('Stall detected', 'Stall was detected during assert_screen fail', result => 'fail');
else {
bmwqemu::fctwarn("stall detected during check_screen failure!");
if (!$check && !$rsp->{saveresult}) {
# Must match can be only scalar or array ref.
my $needletags = $mustmatch;
if (ref($mustmatch) eq 'ARRAY') {
$needletags = join(', ', @$mustmatch);
error => "no candidate needle with tag(s) '$needletags' matched",
tags => $mustmatch
if ($rsp->{saveresult}) {
# now back into waiting for the backend
$rsp = myjsonrpc::read_json($autotest::isotovideo);
return unless $rsp;
$rsp = $rsp->{ret};
$rsp->{tags} = $tags;
return _check_backend_response($rsp, $check, $timeout, $mustmatch);
else {
die "unexpected response " . bmwqemu::pp($rsp);
sub _check_or_assert {
my ($mustmatch, $check, %args) = @_;
die "no tags specified" if (!$mustmatch || (ref $mustmatch eq 'ARRAY' && scalar @$mustmatch == 0));
die "current_test undefined" unless $autotest::current_test;
$args{timeout} = bmwqemu::scale_timeout($args{timeout});
while (1) {
my $rsp = query_isotovideo('check_screen', {mustmatch => $mustmatch, check => $check, timeout => $args{timeout}, no_wait => $args{no_wait}});
# check backend response
# (implemented as separate function because it needs to call itself)
my $backend_response = _check_backend_response($rsp, $check, $args{timeout}, $mustmatch);
# return the response unless we should try again after resuming from paused state
return $backend_response if (!$backend_response || $backend_response ne 'try_again');
# download new needles
OpenQA::Isotovideo::NeedleDownloader->new()->download_missing_needles($rsp->{new_needles} // []);
# reload needles before trying again
query_isotovideo('backend_reload_needles', {});
=head2 assert_screen
assert_screen($mustmatch [, [$timeout] | [timeout => $timeout]] [, no_wait => $no_wait]);
Wait for needle with tag C<$mustmatch> to appear on SUT screen. C<$mustmatch>
can be string or C<ARRAYREF> of string (C<['tag1', 'tag2']>). The maximum
waiting time is defined by C<$timeout>. It is recommended to use a value lower
than the default timeout only when explicitly needed. C<assert_screen> is not
very suitable for checking performance expectations. Under the normal
circumstance of the screen being shown this does not imply a longer waiting
time as the method returns as soon as a successful needle match occurred.
Specify C<$no_wait> to run the screen check as fast as possible that is
possibly more than once per second which is default. Select this to check a
screen which can change in a range faster than 1-2 seconds not to miss the
screen to check for.
Returns matched needle or throws C<FailedNeedle> exception if $timeout timeout
is hit. Default timeout is 30s.
sub assert_screen {
my ($mustmatch) = shift;
my $timeout;
$timeout = shift if (@_ % 2);
my %args = (timeout => $timeout // $bmwqemu::default_timeout, @_);
bmwqemu::log_call(mustmatch => $mustmatch, %args);
return _check_or_assert($mustmatch, 0, %args);
=head2 check_screen
check_screen($mustmatch [, [$timeout] | [timeout => $timeout]] [, no_wait => $no_wait]);
Similar to C<assert_screen> but does not throw exceptions. Use this for optional matches.
Check C<assert_screen> for parameters.
Unlike C<assert_screen> it is recommended to use the lowest possible timeout
to prevent needless waiting time in case no match is expected behaviour. In
general a value of 0s for the timeout should suffice, that is only checking
once with no waiting time. In most cases a check_screen with a higher timeout
can be replaced by C<assert_screen> with multiple tags using an C<ARRAYREF> in
combination with C<match_has_tag> or another synchronization call in before,
for example C<wait_screen_change> or C<wait_still_screen>.
Returns matched needle or C<undef> if timeout is hit. Default timeout is 0s.
sub check_screen {
my ($mustmatch) = shift;
my $timeout;
$timeout = shift if (@_ % 2);
my %args = (timeout => $timeout // 0, @_);
bmwqemu::log_call(mustmatch => $mustmatch, %args);
return _check_or_assert($mustmatch, 1, %args);
=head2 match_has_tag
Returns true (1) if last matched needle has C<$tag>, false (0) if last
matched needle does not have C<$tag>, and C<undef> if no needle has yet
been matched at the time of the call.
sub match_has_tag {
my ($tag) = @_;
if ($last_matched_needle) {
return $last_matched_needle->{needle}->has_tag($tag);
=head2 assert_and_click
assert_and_click($mustmatch [, timeout => $timeout] [, button => $button] [, clicktime => $clicktime ] [, dclick => 1 ] [, mousehide => 1 ]);
Wait for needle with C<$mustmatch> tag to appear on SUT screen. Then click
C<$button> at the "click_point" position as defined in the needle JSON file,
or - if the JSON has not explicit "click_point" - in the middle of the last
needle area. If C<$dclick> is set, do double click instead. C<$mustmatch> can
be string or C<ARRAYREF> of strings (C<['tag1', 'tag2']>). C<$button> is by
default C<'left'>. C<'left'> and C<'right'> is supported. If C<$mousehide> is
true then always move mouse to the 'hidden' position after clicking to prevent
to hide the area where user wants to assert/click in second step.
Throws C<FailedNeedle> exception if C<$timeout> timeout is hit. Default timeout is 30s.
sub assert_and_click {
my ($mustmatch, %args) = @_;
$args{timeout} //= $bmwqemu::default_timeout;
$last_matched_needle = assert_screen($mustmatch, $args{timeout});
bmwqemu::log_call(mustmatch => $mustmatch, %args);
my %click_args = map { $_ => $args{$_} } qw(button dclick mousehide);
return click_lastmatch(%click_args);
=head2 click_lastmatch
click_lastmatch([, button => $button] [, clicktime => $clicktime ] [, dclick => 1 ] [, mousehide => 1 ]);
Click C<$button> at the "click_point" position as defined in the needle JSON file
of the last matched needle, or - if the JSON has not explicit "click_point" -
in the middle of the last match area. If C<$dclick> is set, do double click
instead. Supported values for C<$button> are C<'left'> and C<'right'>, C<'left'>
is the default. If C<$mousehide> is true then always move mouse to the 'hidden'
position after clicking to prevent to disturb the area where user wants to
assert/click in second step, otherwise move the mouse back to its previous
sub click_lastmatch {
my %args = @_;
$args{button} //= 'left';
$args{dclick} //= 0;
$args{mousehide} //= 0;
return unless $last_matched_needle;
my $old_mouse_coords = query_isotovideo('backend_get_last_mouse_set');
# determine click coordinates from the last area which has those explicitly specified
my $relevant_area;
my $relative_click_point;
for my $area (reverse @{$last_matched_needle->{area}}) {
next unless ($relative_click_point = $area->{click_point});
$relevant_area = $area;
# Calculate the absolute click point.
my ($x, $y) = _calculate_clickpoint($last_matched_needle, $relevant_area, $relative_click_point);
bmwqemu::diag("clicking at $x/$y");
mouse_set($x, $y);
if ($args{dclick}) {
mouse_dclick($args{button}, $args{clicktime});
else {
mouse_click($args{button}, $args{clicktime});
# move mouse back to where it was before we clicked, or to the 'hidden' position if it had never been
# positioned
# note: We can not move the mouse instantly. Otherwise we might end up in a click-and-drag situation.
sleep 1;
if ($old_mouse_coords->{x} > -1 && $old_mouse_coords->{y} > -1 && !$args{mousehide}) {
return mouse_set($old_mouse_coords->{x}, $old_mouse_coords->{y});
else {
return mouse_hide();
=head2 assert_and_dclick
assert_and_dclick($mustmatch [, timeout => $timeout] [, button => $button] [, clicktime => $clicktime ] [, dclick => 1 ] [, mousehide => 1 ]);
Alias for C<assert_and_click> with C<$dclick> set.
sub assert_and_dclick {
my ($mustmatch, %args) = @_;
$args{dclick} = 1;
return assert_and_click($mustmatch, %args);
=head2 wait_screen_change
wait_screen_change(CODEREF [,$timeout [, similarity_level => 50]]);
Wrapper around code that is supposed to change the screen. This is the
opposite to C<wait_still_screen>. Make sure to put the commands to change the
screen within the block to avoid races between the action and the screen
change. C<wait_screen_change> waits for a screen change after C<CODEREF> was
wait_screen_change {
send_key 'esc';
Notice: If you use the second parameter, you could get the following warning
Useless use of private variable in void context
To avoid it, use parentheses for the function call and the reserved word 'sub' for the callback
subroutine block.
wait_screen_change(sub {
send_key 'esc';
}, 15);
Returns true if screen changed or false on timeout. Default timeout is 10s. Default
similarity_level is 50.
sub wait_screen_change(&@) {
my ($callback, $timeout, %args) = @_;
$timeout ||= 10;
$args{similarity_level} //= 50;
bmwqemu::log_call(timeout => $timeout, %args);
$timeout = bmwqemu::scale_timeout($timeout);
# get the initial screen
$callback->() if $callback;
my $starttime = time;
while (time - $starttime < $timeout) {
my $sim = query_isotovideo('backend_similiarity_to_reference')->{sim};
bmwqemu::diag("waiting for screen change: " . (time - $starttime) . " $sim");
if ($sim < $args{similarity_level}) {
bmwqemu::fctres("screen change seen at " . (time - $starttime));
return 1;
bmwqemu::fctres("timed out");
return 0;
=head2 assert_screen_change
assert_screen_change(CODEREF [,$timeout]);
Run C<CODEREF> with C<wait_screen_change> but C<die> if screen did not change
within timeout. Look into C<wait_screen_change> for details.
assert_screen_change { send_key 'alt-f4' };
sub assert_screen_change(&@) {
# Need to parse code reference and pass to the method explicitly as
# wait_screen_change uses prototype which expects code block as an argument
# This resolves compile time issues
my ($coderef, @args) = @_;
wait_screen_change(\&{$coderef}, @_) or die 'assert_screen_change failed to detect a screen change';
=head2 wait_still_screen
=for stopwords stilltime
wait_still_screen([$stilltime | [stilltime => $stilltime]] [, $timeout] | [timeout => $timeout]] [, similarity_level => $similarity_level] [, no_wait => $no_wait]);
Wait until the screen stops changing.
See C<assert_screen> for C<$no_wait>.
Returns true if screen is not changed for given C<$stilltime> (in seconds) or undef on timeout.
Default timeout is 30s, default stilltime is 7s.
sub wait_still_screen {
my $stilltime = looks_like_number($_[0]) ? shift : 7;
my $timeout = (@_ % 2) ? shift : $bmwqemu::default_timeout;
my %args = (stilltime => $stilltime, timeout => $timeout, @_);
$args{similarity_level} //= 47;
$timeout = bmwqemu::scale_timeout($args{timeout});
$stilltime = $args{stilltime};
if ($timeout < $stilltime) {
bmwqemu::fctwarn("Selected timeout \'$timeout\' below stilltime \'$stilltime\', returning with false");
return 0;
my $starttime = time;
my $lastchangetime = [gettimeofday];
my $sim = 0;
while (time - $starttime < $timeout) {
$sim = query_isotovideo('backend_similiarity_to_reference')->{sim};
my $now = [gettimeofday];
if ($sim < $args{similarity_level}) {
# a change
$lastchangetime = $now;
if (($now->[0] - $lastchangetime->[0]) + ($now->[1] - $lastchangetime->[1]) / 1000000. >= $stilltime) {
bmwqemu::fctres("detected same image for $stilltime seconds, last detected similarity is $sim");
return 1;
# with 'no_wait' actually wait a little bit not to waste too much CPU
# corresponding to what check_screen/assert_screen also does
# internally
sleep($args{no_wait} ? 0.01 : 0.5);
bmwqemu::fctres("wait_still_screen timed out after $timeout, last detected similarity is $sim");
return 0;
=head2 assert_still_screen
Run C<wait_still_screen> but C<die> if screen changed within timeout. Look
into C<wait_still_screen> for details.
sub assert_still_screen(@) {
wait_still_screen(@_) or die 'assert_still_screen failed to detect a still screen';
=head1 test variable access
=head2 get_var
get_var($variable [, $default ])
Returns content of test variable C<$variable> or the C<$default> given as second argument or C<undef>
sub get_var {
my ($var, $default) = @_;
return $bmwqemu::vars{$var} // $default;
=head2 get_required_var
Similar to C<get_var> but without default value and throws exception if variable can not be retrieved.
sub get_required_var {
my ($var) = @_;
return $bmwqemu::vars{$var} // croak "Could not retrieve required variable $var";
=head2 set_var
set_var($variable, $value [, reload_needles => 1] );
Set test variable C<$variable> to value C<$value>.
Variables starting with C<_SECRET_> will not appear in the C<vars.json> file.
Specify a true value for the C<reload_needles> flag to trigger a reloading
of needles in the backend and call the cleanup handler with the new variables
to make sure that possibly deselected needles are now taken into account
(useful if you change scenarios during the test run)
sub set_var {
my ($var, $val, %args) = @_;
$bmwqemu::vars{$var} = $val;
if ($args{reload_needles}) {
query_isotovideo('backend_reload_needles', {});
=head2 check_var
check_var($variable, $value);
Returns true if test variable C<$variable> is equal to C<$value> or returns C<undef>.
sub check_var {
my ($var, $val) = @_;
return 1 if (defined $bmwqemu::vars{$var} && $bmwqemu::vars{$var} eq $val);
return 0;
=head2 get_var_array
get_var_array($variable [, $default ]);
Return the given variable as array reference (split variable value by , | or ; )
sub get_var_array {
my ($var, $default) = @_;
my @vars = split(/,|;/, $bmwqemu::vars{$var} || '');
my @default = split(/,|;/, $default || '');
return \@default if !@vars;
return \@vars;
=head2 check_var_array
check_var_array($variable, $value);
Boolean function to check if a value list contains a value
sub check_var_array {
my ($var, $val) = @_;
my $vars_r = get_var_array($var);
return grep { $_ eq $val } @$vars_r;
=head1 script execution helpers
=for stopwords os-autoinst autoinst isotovideo VNC
=head2 is_serial_terminal
Determines if communication with the guest is being performed purely over a
serial port. When true, the guest should have a tty attached to a serial port
and os-autoinst sends commands to it as text. This differs from when a text
console is selected in the guest, but VNC is being used to simulate key presses.
When a serial terminal is selected you will not be able to use functions which
rely on needles. This sub is not exported by default as most tests I<will not
benefit> from changing their behaviour depending on if communication happens
over serial or VNC.
For more info see consoles/ and consoles/
sub is_serial_terminal {
state $ret;
state $last_seen = '';
if (defined current_console() && current_console() ne $last_seen) {
$last_seen = current_console();
$ret = query_isotovideo('backend_is_serial_terminal', {});
return $ret->{yesorno};
=head2 wait_serial
wait_serial($regex or ARRAYREF of $regexes, [, timeout => $timeout] [, expect_not_found => $expect_not_found] [, %args]);
Deprecated mode
wait_serial($regex or ARRAYREF of $regexes [, $timeout [, $expect_not_found [, @args ]]]);
Wait for C<$regex> or anyone of C<$regexes> to appear on serial output.
Setting C<$no_regex> will cause it to do a plain string search.
Set C<$quiet>, to avoid recording serial_result.
For serial_terminal there are more options available, like C<record_output>,
C<buffer_size>. See C<consoles::serial_screen::read_unitl> for details.
Returns the string matched or C<undef> if C<$expect_not_found> is false
Returns C<undef> or (after timeout) the string that I<did _not_ match> if
C<$expect_not_found> is true. The default timeout is 90 seconds.
sub wait_serial {
my $regexp = shift;
my %args = compat_args(
regexp => $regexp,
timeout => 90,
expect_not_found => 0,
quiet => undef,
no_regex => 0,
buffer_size => undef,
record_output => undef,
}, ['timeout', 'expect_not_found'], @_);
$args{timeout} = bmwqemu::scale_timeout($args{timeout});
my $ret = query_isotovideo('backend_wait_serial', \%args);
my $matched = $ret->{matched};
if ($args{expect_not_found}) {
$matched = !$matched;
bmwqemu::wait_for_one_more_screenshot() unless is_serial_terminal;
# to string, we need to feed string of result to
# record_serialresult()
$matched = $matched ? 'ok' : 'fail';
# convert dos2unix (poo#20542)
# hyperv and vmware (backend/ connect serial line over TCP/IP (socat)
# convert CRLF to LF only
$ret->{string} =~ s,\r\n,\n,g;
$autotest::current_test->record_serialresult(bmwqemu::pp($regexp), $matched, $ret->{string}) unless ($args{quiet});
bmwqemu::fctres("$regexp: $matched");
return $ret->{string} if ($matched eq "ok");
return; # false
=head2 x11_start_program
x11_start_program($program[, @args]);
Start C<$program> in graphical desktop environment.
I<The implementation is distribution specific and not always available.>
sub x11_start_program {
my ($program, @args) = @_;
bmwqemu::log_call(program => $program, @args);
return $distri->x11_start_program($program, @args);
sub _handle_script_run_ret {
my ($ret, $cmd, %args) = @_;
croak "command '$cmd' timed out" unless (defined $ret);
my $die_msg = "command '$cmd' failed";
$die_msg .= ": $args{fail_message}" if $args{fail_message};
croak $die_msg unless ($ret == 0);
=head2 assert_script_run
assert_script_run($cmd [, timeout => $timeout] [, fail_message => $fail_message] [,quiet => $quiet]);
Deprecated mode
assert_script_run($cmd [, $timeout [, $fail_message]]);
Run C<$cmd> via C<$distri->script_run> and C<die> unless it returns zero (indicating
successful completion of C<$cmd>). Default timeout is 90 seconds.
Use C<script_run> instead if C<$cmd> may fail.
C<$fail_message> is returned in the die message if specified.
I<The C<script_run> implementation is distribution specific and not always available.
For this to work correctly, it must return 0 if and only if C<$command> completes
successfully. It must NOT return 0 if C<$command> times out. The default implementation
should work on *nix operating systems with a configured serial device.>
sub assert_script_run {
my $cmd = shift;
my %args = compat_args(
# assert_script_run originally had the implicit default timeout of
# wait_serial which we are repeating here to preserve old behaviour and
# not change default timeout.
timeout => 90,
fail_message => '',
quiet => testapi::get_var('_QUIET_SCRIPT_CALLS')
}, ['timeout', 'fail_message'], @_);
bmwqemu::log_call(cmd => $cmd, %args);
my $ret = $distri->script_run($cmd, timeout => $args{timeout}, quiet => $args{quiet});
_handle_script_run_ret($ret, $cmd, %args);
=head2 script_run
script_run($cmd [, timeout => $timeout] [, output => ''] [, quiet => $quiet]);
Deprecated mode
script_run($cmd [, $timeout]);
Run C<$cmd> (in the default implementation, by assuming the console prompt and typing
the command). If C<$timeout> is greater than 0, wait for that length of time for
execution to complete (otherwise, returns undef immediately). See C<distri->script_run>
for default timeout.
C<$output> can be used as an explanatory text that will be displayed with the execution of
the command.
<Returns> exit code received from I<$cmd>, or undef if $timeout is 0 or execution
does not complete within $timeout.
I<The implementation is distribution specific and not always available.>
The default implementation should work on *nix operating systems with a configured
serial device so long as the user has permissions to write to the supplied serial
device C<$serialdev>.
sub script_run {
my $cmd = shift;
my %args = compat_args(
timeout => undef,
output => '',
quiet => testapi::get_var('_QUIET_SCRIPT_CALLS')
}, ['timeout'], @_);
bmwqemu::log_call(cmd => $cmd, %args);
return $distri->script_run($cmd, %args);
=head2 assert_script_sudo
assert_script_sudo($command [, $wait]);
Run C<$command> via C<script_sudo> and then check by C<wait_serial> if its exit
status is not zero.
See C<wait_serial> for default timeout.
I<The implementation is distribution specific and not always available.>
Make sure the non-root user has permissions to write to the supplied serial device
sub assert_script_sudo {
my ($cmd, $wait) = @_;
my $str = hashed_string("ASS$cmd");
script_sudo("$cmd; echo $str-\$?- > /dev/$serialdev", 0);
my $ret = wait_serial("$str-\\d+-", $wait);
$ret = ($ret =~ /$str-(\d+)-/)[0] if $ret;
_handle_script_run_ret($ret, $cmd);
=head2 script_sudo
script_sudo($program [, $wait]);
Run C<$program> using sudo. Handle the sudo timeout and send password when appropriate.
C<$wait> defaults to 2 seconds.
I<The implementation is distribution specific and not always available.>
sub script_sudo {
my $name = shift;
my $wait = shift // 2;
bmwqemu::log_call(name => $name, wait => $wait);
return $distri->script_sudo($name, $wait);
=for stopwords SUT
=head2 script_output
script_output($script [, $wait, type_command => 1, proceed_on_failure => 1] [,quiet => $quiet])
Executing script inside SUT with C<bash -eox> (in case of serial console with C<bash -eo>)
and directs C<stdout> (I<not> C<stderr>!) to the serial console and returns
the output I<if> the script exits with 0. Otherwise the test is set to failed.
NOTE: execution result may include extra serial output which was on serial console
since command was triggered in case serial console is not dedicated for
the script output only.
The script content is based on the variable content of C<current_test_script>
and is typed or fetched through HTTP depending on various parameters. Typing
can be forced by passing C<type_command => 1> for example when the SUT does
not provide a usable network connection.
C<proceed_on_failure> - allows to proceed with validation when C<$script> is
failing (return non-zero exit code)
The default timeout for the script is based on the default in C<wait_serial>
and can be tweaked by setting the C<$wait> positional parameter.
sub script_output {
my $script = shift;
my %args = testapi::compat_args(
timeout => undef,
proceed_on_failure => undef, # fail on error by default
quiet => testapi::get_var('_QUIET_SCRIPT_CALLS'),
type_command => undef,
}, ['timeout'], @_);
return $distri->script_output($script, %args);
=head2 save_tmp_file
save_tmp_file($relpath, $content)
Saves content to the file in the worker pool directory using hash of the path,
including file, so it can be fetched via http later on using
C< <autoinst_url>/files/#path_to_the_file> > url.
Can be used to modify files for specific test needs, e.g. autoinst profiles.
Dies if cannot open file for writing.
save_tmp_file('autoyast/autoinst.xml', '<profile>Test</profile>')
Then the file can be fetched using url:
C< <autoinst_url>/files/autoyast/autoinst.xml> >
sub save_tmp_file {
my ($relpath, $content) = @_;
my $path = hashed_string($relpath);
bmwqemu::log_call(path => $relpath);
open my $fh, ">", $path;
print $fh $content;
close $fh;
=head2 get_test_data
Returns content of the file located in data directory. This method can be used
if one needs to modify files content before accessing it in SUT.
This will return content of the file located in data/autoyast/autoinst.xml
sub get_test_data {
my ($path) = @_;
$path = get_var('CASEDIR') . '/data/' . $path;
bmwqemu::log_call(path => $path);
unless (-e $path) {
bmwqemu::diag("File doesn't exist: $path");
open my $fh, "<", $path;
my $content = do { local $/; <$fh> };
close $fh;
return $content;
=head2 validate_script_output
validate_script_output($script, $code | $regexp [, timeout => $timeout] [,quiet => $quiet])
Deprecated mode
validate_script_output($script, $code, [$wait])
Wrapper around script_output, that runs a callback on the output, or
alternatively matches a regular expression. Use it as
validate_script_output "cat /etc/hosts", sub { m/127.*localhost/ };
validate_script_output "cat /etc/hosts", qr/127.*localhost/;
validate_script_output "cat /etc/hosts", sub { $_ !~ m/987.*somehost/ };
sub validate_script_output {
my ($script, $check) = splice(@_, 0, 2);
my %args = compat_args(
timeout => 30,
quiet => testapi::get_var('_QUIET_SCRIPT_CALLS')
}, ['timeout'], @_);
my $output = script_output($script, %args);
my $res = 'ok';
my $message = '';
if (reftype $check eq 'CODE') {
# set $_ so the callbacks can be simpler code
$_ = $output;
if (!$check->()) {
$res = 'fail';
bmwqemu::diag("output does not pass the code block:\n$output");
my $deparse = B::Deparse->new("-p");
# avoid "use strict; use warnings" in the output to make it shorter
$deparse->ambient_pragmas(warnings => [], strict => "all");
my $body = $deparse->coderef2text($check);
$message = sprintf
"validate_script_output got:\n%s\n\nCheck function (deparsed code):\n%s",
$output, $body;
elsif (reftype $check eq 'REGEXP') {
if ($output !~ $check) {
$res = 'fail';
bmwqemu::diag("output does not match the regex:\n$output");
$message = sprintf
"validate_script_output got:\n%s\n\nRegular expression:\n%s",
$output, $check;
else {
croak "Invalid use of validate_script_output(), second arg must be a coderef or regexp";
'validate_script_output', $message,
result => $res,
if ($res eq 'fail') {
croak "output not validating";
return 0;
=head2 become_root
Open a root shell.
I<The implementation is distribution specific and not always available.>
sub become_root {
return $distri->become_root;
=head2 ensure_installed
ensure_installed $package;
Helper to install a package to SUT.
I<The implementation is distribution specific and not always available.>
sub ensure_installed {
return $distri->ensure_installed(@_);
=head2 hashed_string
Return a short string representing the given string by passing it through the
MD5 algorithm and taking the first characters.
sub hashed_string {
my ($string, $count) = @_;
$count //= 5;
my $hash = md5_base64($string);
# + and / are problematic in regexps and shell commands
$hash =~ s,\+,_,g;
$hash =~ s,/,~,g;
return substr($hash, 0, $count);
=head1 keyboard support
=head2 send_key
send_key($key [, wait_screen_change => $wait_screen_change]);
Send one C<$key> to SUT keyboard input. Waits for the screen to change when
C<$wait_screen_change> is true.
Special characters naming:
'esc', 'down', 'right', 'up', 'left', 'equal', 'spc', 'minus', 'shift', 'ctrl'
'caps', 'meta', 'alt', 'ret', 'tab', 'backspace', 'end', 'delete', 'home', 'insert'
'pgup', 'pgdn', 'sysrq', 'super'
sub send_key {
my $key = shift;
my %args = (@_ == 1) ? (do_wait => +shift()) : @_;
$args{do_wait} //= 0;
$args{wait_screen_change} //= 0;
bmwqemu::log_call(key => $key, %args);
if ($args{wait_screen_change}) {
wait_screen_change { query_isotovideo('backend_send_key', {key => $key}) };
else {
query_isotovideo('backend_send_key', {key => $key});
=head2 hold_key
Hold one C<$key> until release it
sub hold_key {
my ($key) = @_;
bmwqemu::log_call('hold_key', key => $key);
query_isotovideo('backend_hold_key', {key => $key});
=head2 release_key
Release one C<$key> which is kept holding
sub release_key {
my $key = shift;
bmwqemu::log_call('release_key', key => $key);
query_isotovideo('backend_release_key', {key => $key});
=head2 send_key_until_needlematch
send_key_until_needlematch($tag, $key [, $counter, $timeout]);
Send specific key until needle with C<$tag> is not matched or C<$counter> is 0.
C<$tag> can be string or C<ARRAYREF> (C<['tag1', 'tag2']>)
Default counter is 20 steps, default timeout is 1s
Throws C<FailedNeedle> exception if needle is not matched until C<$counter> is 0.
sub send_key_until_needlematch {
my ($tag, $key, $counter, $timeout) = @_;
$counter //= 20;
$timeout //= 1;
while (!check_screen($tag, $timeout)) {
wait_screen_change {
send_key $key;
if (!$counter--) {
assert_screen $tag, 1;
=head2 type_string
type_string($string [, max_interval => <num> ] [, wait_screen_changes => <num> ] [, wait_still_screen => <num> ] [, secret => 1 ]
[, timeout => <num>] [, similarity_level => <num>] [, lf => 1 ]);
send a string of characters, mapping them to appropriate key names as necessary
you can pass optional parameters with following keys:
C<max_interval (1-250)> determines the typing speed, the lower the
C<max_interval> the slower the typing.
C<wait_screen_change> if set, type only this many characters at a time
C<wait_screen_change> and wait for the screen to change between sets.
C<wait_still_screen> if set, C<wait_still_screen> returns true if screen is not
changed for given C<$wait_still_screen> seconds or false if the screen is not still
for the given seconds within defined C<timeout> after the whole string is typed.
Default timeout is 30s, default stilltime is 0s.
C<similarity_level> can be passed as argument for wrapped C<wait_still_screen> calls.
C<secret (bool)> suppresses logging of the actual string typed.
C<lf (bool)> finishes the string with an additional line feed, for example to
enter a command line.
sub type_string {
# special argument handling for backward compat
my $string = shift;
my %args;
if (@_ == 1) { # backward compat
%args = (max_interval => $_[0]);
else {
%args = @_;
my $log = $args{secret} ? 'SECRET STRING' : $string;
$string .= "\n" if $args{lf};
if (is_serial_terminal) {
bmwqemu::log_call(text => $log, %args);
query_isotovideo('backend_type_string', {text => $string, %args});
my $max_interval = $args{max_interval} // 250;
my $wait = $args{wait_screen_change} // 0;
my $wait_still = $args{wait_still_screen} // 0;
my $wait_timeout = $args{timeout} // 30;
my $wait_sim_level = $args{similarity_level} // 47;
bmwqemu::log_call(string => $log, max_interval => $max_interval, wait_screen_changes => $wait, wait_still_screen => $wait_still,
timeout => $wait_timeout, similarity_level => $wait_sim_level);
my @pieces;
if ($wait) {
# split string into an array of pieces of specified size
@pieces = unpack("(a${wait})*", $string);
else {
push @pieces, $string;
for my $piece (@pieces) {
if ($wait) {
wait_screen_change { query_isotovideo('backend_type_string', {text => $piece, max_interval => $max_interval}); };
else {
query_isotovideo('backend_type_string', {text => $piece, max_interval => $max_interval});
if ($wait_still && !wait_still_screen(stilltime => $wait_still,
timeout => $wait_timeout, similarity_level => $wait_sim_level)) {
die "wait_still_screen timed out after ${wait_timeout}s!";
=head2 type_password
type_password($password [, max_interval => <num> ] [, wait_screen_changes => <num> ] [, wait_still_screen => <num> ] [, timeout => <num>]
[, similarity_level => <num>] );
A convenience wrapper around C<type_string>, which doesn't log the string.
Uses C<$testapi::password> if no string is given.
You can pass the same optional parameters as for C<type_string> function.
sub type_password {
my ($string, %args) = @_;
$string //= $password;
type_string $string, secret => 1, max_interval => ($args{max_interval} // 100), %args;
=head2 enter_cmd
enter_cmd($string [, max_interval => <num> ] [, wait_screen_changes => <num> ] [, wait_still_screen => <num> ] [, secret => 1 ]
[, timeout => <num>] [, similarity_level => <num>] );
A convenience wrapper around C<type_string>, that adds a linefeed to execute a
command within a command line prompt.
You can pass the same optional parameters as for C<type_string> function.
sub enter_cmd {
type_string shift, lf => 1, @_;
=head1 mouse support
=head2 mouse_set
mouse_set($x, $y);
Move mouse pointer to given coordinates
sub mouse_set {
my ($mx, $my) = @_;
bmwqemu::log_call(x => $mx, y => $my);
query_isotovideo('backend_mouse_set', {x => $mx, y => $my});
=head2 mouse_click
mouse_click([$button, $hold_time]);
Click mouse C<$button>. Can be C<'left'> or C<'right'>. Set C<$hold_time> to hold button for set time in seconds.
Default hold time is 0.15s
sub mouse_click {
my $button = shift || 'left';
my $time = shift || 0.15;
bmwqemu::log_call(button => $button, cursor_down => $time);
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
=head2 mouse_dclick
mouse_dclick([$button, $hold_time]);
Same as mouse_click only for double click.
sub mouse_dclick(;$$) {
my $button = shift || 'left';
my $time = shift || 0.10;
bmwqemu::log_call(button => $button, cursor_down => $time);
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
=head2 mouse_tclick
mouse_tclick([$button, $hold_time]);
Same as mouse_click only for triple click.
sub mouse_tclick(;$$) {
my $button = shift || 'left';
my $time = shift || 0.10;
bmwqemu::log_call(button => $button, cursor_down => $time);
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
sleep $time;
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
=head2 mouse_hide
Hide mouse cursor by moving it out of screen area.
sub mouse_hide(;$) {
my $border_offset = shift || 0;
bmwqemu::log_call(border_offset => $border_offset);
query_isotovideo('backend_mouse_hide', {offset => $border_offset});
=head2 mouse_drag
mouse_drag([$startpoint, $endpoint, $startx, $starty, $endx, $endy, $button, $timeout]);
Click mouse C<$button>, C<'left'> or C<'right'>, at a given location, hold the button and drag
the mouse to another location where the button is released. You can set the C<$startpoint>
and C<$endpoint> by passing the name of the needle tag, i.e. the mouse drag happens between
the two needle areas. Alternatively, you can set all the coordinates explicitly with C<$startx>,
C<$starty>, C<$endx>, and C<$endy>. You can also set one point using a needle and another one
using coordinates. If both the coordinates and the needle are provided, the coordinates
will be used to set up the locations and the needle location will be overridden.
sub mouse_drag {
my %args = @_;
my ($startx, $starty, $endx, $endy);
# If full coordinates are provided, work with them as a priority,
if (defined $args{startx} and defined $args{starty}) {
$startx = $args{startx};
$starty = $args{starty};
# If the coordinates were not complete, use the needle as a fallback solution.
elsif (defined $args{startpoint}) {
my $startmatch = $args{startpoint};
# Check that the needle exists.
my $start_matched_needle = assert_screen($startmatch, $args{timeout});
# Calculate the click point from the area defined by the needle (take the center of it)
($startx, $starty) = _calculate_clickpoint($start_matched_needle);
# If neither coordinates nor a needle is provided, report an error and quit.
else {
die "The starting point of the drag was not correctly provided. Either provide the 'startx' and 'starty' coordinates, or a needle marking the starting point.";
# Repeat the same for endpoint coordinates or needles.
if (defined $args{endx} and defined $args{endy}) {
$endx = $args{endx};
$endy = $args{endy};
elsif (defined $args{endpoint}) {
my $endmatch = $args{endpoint};
my $end_matched_needle = assert_screen($endmatch, $args{timeout});
($endx, $endy) = _calculate_clickpoint($end_matched_needle);
else {
die "The ending point of the drag was not correctly provided. Either provide the 'endx' and 'endy' coordinates, or a needle marking the end point.";
# Get the button variable. If no button has been provided, assume the "left" button.
my $button = $args{button} // "left";
# Now, perform the actual mouse drag. Navigate to the startpoint location,
# press and hold the mouse button, then navigate to the endpoint location
# and release the mouse button.
mouse_set($startx, $starty);
query_isotovideo('backend_mouse_button', {button => $button, bstate => 1});
mouse_set($endx, $endy);
query_isotovideo('backend_mouse_button', {button => $button, bstate => 0});
bmwqemu::log_call(message => "Mouse dragged from $startx,$starty to $endx, $endy", button => $button);
=head1 multi console support
All C<testapi> commands that interact with the system under test do that
through a console. C<send_key>, C<type_string> type into a console.
C<assert_screen> 'looks' at a console, C<assert_and_click> looks at
and clicks on a console.
Most backends support several consoles in some way. These consoles
then have names as defined by the backend.
Consoles can be selected for interaction with the system under test.
One of them is 'selected' by default, as defined by the backend.
There are no consoles predefined by default, the distribution has
to add them during initial setup and define actions on what should
happen when they are selected first by the tests.
E.g. your distribution can give e.g. C<tty2> and C<tty4> a name for the
tests to select
$self->add_console('root-console', 'tty-console', {tty => 2});
$self->add_console('user-console', 'tty-console', {tty => 4});
=head2 add_console
add_console("console", "console type" [, optional console parameters...])
You need to do this in your distribution and not in tests. It will not trigger
any action on the system under test, but only store the parameters.
The console parameters are console specific. Parameter C<persistent> skips
console reset and console is persistent during the test execution.
I<The implementation is distribution specific and not always available.>
require backend::console_proxy;
our %testapi_console_proxies;
=head2 select_console
select_console($console [, @args]);
Select the named console for further C<testapi> interaction (send_text,
send_key, wait_screen_change, ...)
If this the first time, a test selects this console, the distribution
will get a call into activate_console('root-console', $console_obj, @args) to
make sure to actually log in root. For the backend it's just a C<tty>
object (in this example) - so it will ensure the console is active,
but to setup the root shell on this console, the distribution needs
to run test code.
After the console selection the distribution callback
C<$distri->console_selected> is called with C<@args>.
sub select_console {
my ($testapi_console, @args) = @_;
bmwqemu::log_call(testapi_console => $testapi_console, @args);
if (!exists $testapi_console_proxies{$testapi_console}) {
$testapi_console_proxies{$testapi_console} = backend::console_proxy->new($testapi_console);
my $ret = query_isotovideo('backend_select_console', {testapi_console => $testapi_console});
die $ret->{error} if $ret->{error};
$autotest::selected_console = $testapi_console;
if ($ret->{activated}) {
# we need to store the activated consoles for rollback
if ($autotest::last_milestone) {
push(@{$autotest::last_milestone->{activated_consoles}}, $testapi_console);
$testapi::distri->activate_console($testapi_console, @args);
$testapi::distri->console_selected($testapi_console, @args);
return $testapi_console_proxies{$testapi_console};
=head2 console
Some consoles have special commands beyond C<type_string>, C<assert_screen>
Such commands can be accessed using this API.
C<console("bootloader")>, C<console("errorlog")>, ... returns a proxy
object for the specific console which can then be directly accessed.
This is also useful for typing/interacting 'in the background',
without turning the video away from the currently selected console.
Note: C<assert_screen()> and friends look at the currently selected
console (select_console), no matter which console you send commands to
sub console {
my ($testapi_console) = @_;
$testapi_console ||= current_console();
bmwqemu::log_call(testapi_console => $testapi_console);
if (!exists $testapi_console_proxies{$testapi_console}) {
$testapi_console_proxies{$testapi_console} = backend::console_proxy->new($testapi_console);
return $testapi_console_proxies{$testapi_console};
=head2 reset_consoles
will make sure the next select_console will activate the console. This is important
if you did something to the system that affects the console (e.g. trigger reboot).
sub reset_consoles {
Return the currently selected console, a call when no console is selected, will
return C<undef>.
sub current_console {
return $autotest::selected_console;
=head1 audio support
=for stopwords qemu
=head2 start_audiocapture
Tells the backend to record a C<.wav> file of the sound card.
I<Only supported by qemu backend.>
sub start_audiocapture {
my $fn = $autotest::current_test->capture_filename;
my $filename = join('/', bmwqemu::result_dir(), $fn);
bmwqemu::log_call(filename => $filename);
return query_isotovideo('backend_start_audiocapture', {filename => $filename});
sub _check_or_assert_sound {
my ($mustmatch, $check) = @_;
my $result = $autotest::current_test->stop_audiocapture();
my $wavfile = join('/', bmwqemu::result_dir(), $result->{audio});
system("snd2png $wavfile $result->{audio}.png");
my $imgpath = "$result->{audio}.png";
return $autotest::current_test->verify_sound_image($imgpath, $mustmatch, $check);
=head2 assert_recorded_sound
Tells the backend to record a C<.wav> file of the sound card and asserts if it matches
expected audio. Comparison is performed after conversion to the image.
I<Only supported by QEMU backend.>
sub assert_recorded_sound {
my ($mustmatch) = @_;
return _check_or_assert_sound $mustmatch;
=head2 check_recorded_sound
Tells the backend to record a C<.wav> file of the sound card and checks if it matches
expected audio. Comparison is performed after conversion to the image.
I<Only supported by QEMU backend.>
sub check_recorded_sound {
my ($mustmatch) = @_;
return _check_or_assert_sound $mustmatch, 1;
=head1 miscellaneous
=head2 power
Trigger backend specific power action, can be C<'on'>, C<'off'>, C<'acpi'> or C<'reset'>
sub power {
# params: (on), off, acpi, reset
my ($action) = @_;
bmwqemu::log_call(action => $action);
query_isotovideo('backend_power', {action => $action});
=head2 check_shutdown
Periodically check backend for status until C<'shutdown'>. Does I<not> initiate shutdown.
Returns true on success and false if C<$timeout> timeout is hit. Default timeout is 60s.
sub check_shutdown {
my ($timeout) = @_;
$timeout //= 60;
bmwqemu::log_call(timeout => $timeout);
$timeout = bmwqemu::scale_timeout($timeout);
while ($timeout >= 0) {
my $is_shutdown = query_isotovideo('backend_is_shutdown') || 0;
if ($is_shutdown < 0) {
bmwqemu::diag("Backend does not implement is_shutdown - just sleeping");
# -1 counts too
if ($is_shutdown) {
return 1;
sleep 1;
return 0;
=head2 assert_shutdown
Periodically check backend for status until C<'shutdown'>. Does I<not> initiate shutdown.
Returns C<undef> on success, marks the test as failed and throws exception
if C<$timeout> timeout is hit. Default timeout is 60s.
sub assert_shutdown {
my ($timeout) = @_;
$timeout //= 60;
if (check_shutdown($timeout)) {
else {
croak "Machine didn't shut down!";
=head2 eject_cd
if backend supports it, eject the CD
sub eject_cd {
=head2 save_memory_dump
save_memory_dump(filename => undef);
Saves the SUT memory state using C<$filename> as base for the memory dump
filename, the default will be the current test's name.
This method must be called within a post_fail_hook.
I<Currently only qemu backend is supported.>
sub save_memory_dump {
my %nargs = @_;
$nargs{filename} ||= $autotest::current_test->{name};
bmwqemu::diag("Trying to save machine state");
query_isotovideo('backend_save_memory_dump', \%nargs);
=head2 save_storage_drives
Saves all of the SUT drives using C<$filename> as part of the final filename,
the default will be the current test's name. The disk number will be always present.
This method must be called within a post_fail_hook.
I<Currently only qemu backend is supported.>
sub save_storage_drives {
my $filename ||= $autotest::current_test->{name};
die "save_storage_drives should be called within a post_fail_hook" unless ((caller(1))[3]) =~ /post_fail_hook/;
bmwqemu::diag("Trying to save machine drives");
# Right now, we're saving all the disks
# sometimes we might not want to. This could be improved.
if (my $nd = $bmwqemu::vars{NUMDISKS}) {
for my $i (1 .. $nd) {
query_isotovideo('backend_save_storage_drives', {disk => $i, filename => $filename});
=head2 freeze_vm
If the backend supports it, freeze the virtual machine. This will allow the
virtual machine to be paused/frozen within the test, it is recommended to call
this within a C<post_fail_hook> so that memory and disk dumps can be extracted
without any risk of data changing, or in rare cases call it before the tests
tests have already begun, to avoid unexpected behaviour.
I<Currently only qemu backend is supported.>
sub freeze_vm {
# While it might be a good idea to allow the user to stop the vm within a test
# we're not encouraging them to do that outside a post_fail_hook or at any point
# in the test code.
bmwqemu::diag "Call freeze_vm within a post_fail_hook or very early in your test"
unless ((caller(1))[3]) =~ /post_fail_hook/;
=head2 resume_vm
If the backend supports it, resume the virtual machine. Call this method to
start virtual machine CPU explicitly if DELAYED_START is set.
I<Currently only qemu backend is supported.>
sub resume_vm {
=head2 parse_junit_log
=for stopwords jUnit
Upload log file from SUT (calls upload_logs internally). The uploaded
file is then parsed as jUnit format and extra test results are created from it.
# XXX: To keep until tests are adapted
sub parse_junit_log { return parse_extra_log('JUnit', shift) }
=head2 parse_extra_log
=for stopwords extra_log
parse_extra_log( Format => "report.xml" );
Upload log file from SUT (calls upload_logs internally). The uploaded
file is then parsed as the format supplied, that can be understood by OpenQA::Parser
and extra test results are created from it.
Formats currently supported are: JUnit, XUnit, LTP
sub parse_extra_log {
my ($format, $file) = @_;
$file = upload_logs($file);
my @tests;
local $@;
# We need to touch @INC as specific supported format are split
# in different classes and dynamically loaded by OpenQA::Parser
eval {
require OpenQA::Parser;
my $parser = parser($format => "ulogs/$file");
sub {
push(@tests, $_->to_openqa);
croak $@ if $@;
return $autotest::current_test->register_extra_test_results(\@tests);
=head1 log and data upload and download helpers
=for stopwords diag
=head2 diag
diag('important message');
Write a diagnostic message to the logfile. In color, if possible.
sub diag {
return bmwqemu::diag(@_);
=head2 host_ip
=for stopwords kvm VM
Return VM's host IP
in a kvm instance you reach the VM's host under default
sub host_ip {
return check_var('BACKEND', 'qemu') ? get_var('QEMU_HOST_IP', '') : get_required_var('WORKER_HOSTNAME');
=head2 autoinst_url
autoinst_url([$path, $query]);
returns the base URL to contact the local C<os-autoinst> service
Optional C<$path> argument is appended after base url.
Optional HASHREF C<$query> is converted to URL query and appended
after path.
Returns constructor URL. Can be used inline:
script_run("curl " . autoinst_url . "/data");
sub autoinst_url {
my ($path, $query) = @_;
$path //= '';
$query //= {};
my $hostname = get_var('AUTOINST_URL_HOSTNAME', host_ip());
# QEMUPORT is historical for the base port of the worker instance
my $workerport = get_var("QEMUPORT") + 1;
my $token = get_var('JOBTOKEN');
my $querystring = join('&', map { "$_=$query->{$_}" } sort keys %$query);
my $url = "http://$hostname:$workerport/$token$path";
$url .= "?$querystring" if $querystring;
return $url;
=head2 data_url
returns the URL to download data or asset file
Special values REPO_\d and ASSET_\d points to the asset configured
in the corresponding variable
sub data_url($) {
my ($name) = @_;
if ($name =~ /^REPO_\d$/) {
return autoinst_url("/assets/repo/" . get_var($name));
if ($name =~ /^ASSET_\d$/) {
return autoinst_url("/assets/other/" . get_var($name));
else {
return autoinst_url("/data/$name");
=head2 upload_logs
=for stopwords GiB failok OpenQA WebUI
upload_logs($file [, failok => 0, timeout => 90, log_name => "custom_name.log" ]);
Upload C<$file> to OpenQA WebUI as a log file and
return the uploaded file name. If failok is not set, a failed upload or
timeout will cause the test to die. Failed uploads happen if the file does not
exist or is over 20 GiB in size, so failok is useful when you just want
to upload the file if it exists but not mind if it doesn't. Default
timeout is 90s. C<log_name> parameter allow to control resulted job's attachment name.
sub upload_logs {
my $file = shift;
my %args = @_;
my $failok = $args{failok} || 0;
my $timeout = $args{timeout} || 90;
if (get_var('OFFLINE_SUT')) {
record_info('upload skipped', "Skipped uploading log file '$file' as we are offline");
bmwqemu::log_call(file => $file, failok => $failok, timeout => $timeout, %args);
my $basename = basename($file);
my $upname = ($args{log_name} || $autotest::current_test->{name}) . '-' . $basename;
my $cmd = "curl --form upload=\@$file --form upname=$upname ";
$cmd .= autoinst_url("/uploadlog/$basename");
if ($failok) {
# just use script_run so we don't care if the upload fails
script_run($cmd, $timeout);
else {
assert_script_run($cmd, $timeout);
return $upname;
=head2 upload_asset
=for stopwords svirt
upload_asset $file [,$public[,$nocheck]];
Uploads C<$file> as asset to OpenQA WebUI
You can upload private assets only accessible by related jobs:
upload_asset '/tmp/';
Or you can upload public assets that will have a fixed filename
replacing previous assets - useful for external users:
upload_asset '/tmp/', 1;
If you just want to upload a file and verify that it was uploaded
correctly on your own (e.g. in svirt console we don't have a serial
line and can't rely on assert_script_run check), add an optional
C<$nocheck> parameter:
upload_asset '/tmp/', 1, 1;
sub upload_asset {
my ($file, $public, $nocheck) = @_;
if (get_var('OFFLINE_SUT')) {
record_info('upload skipped', "Skipped uploading asset '$file' as we are offline");
bmwqemu::log_call(file => $file, public => $public, nocheck => $nocheck);
my $cmd = "curl --form upload=\@$file ";
$cmd .= "--form target=assets_public " if $public;
my $basename = basename($file);
$cmd .= autoinst_url("/upload_asset/$basename");
if ($nocheck) {
else {
return assert_script_run($cmd);
=head2 compat_args
Helper function to create backward compatible function arguments when moving
from positional arguments to named one.
compat_args( $hash_ref_defaults, $arrayref_old_fixed, [ $arg1, $arg2, ...])
A typical call would look like:
my %args = compat_args({timeout => 60, .. }, ['timeout'], @_);
sub compat_args {
my ($def_args, $fix_keys) = splice(@_, 0, 2);
my %ret;
for my $key (@{$fix_keys}) {
$ret{$key} = shift if (scalar(@_) >= 1 && (!defined($_[0]) || !grep(/^$_[0]$/, keys(%{$def_args}))));
carp("Odd number of arguments") unless ((@_ % 2) == 0);
%ret = (%{$def_args}, %ret, @_);
map { $ret{$_} //= $def_args->{$_} } keys(%{$def_args});
return %ret;