Permalink
Cannot retrieve contributors at this time
| # 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/>. | |
| 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 | |
| enter_cmd | |
| 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 http://open.qa/documentation | |
| =cut | |
| =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. | |
| =cut | |
| 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. | |
| =cut | |
| 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'; | |
| } | |
| return; | |
| } | |
| =for stopwords ProhibitSubroutinePrototypes | |
| =head2 set_distribution | |
| set_distribution($distri); | |
| Set distribution object. | |
| You can use distribution object to implement distribution specific helpers. | |
| =cut | |
| sub set_distribution { | |
| ($distri) = @_; | |
| return $distri->init(); | |
| } | |
| =for stopwords SUT | |
| =head1 video output handling | |
| =head2 save_screenshot | |
| save_screenshot; | |
| Saves screenshot of current SUT screen. | |
| =cut | |
| sub save_screenshot { | |
| return $autotest::current_test->take_screenshot; | |
| } | |
| =head2 record_soft_failure | |
| =for stopwords softfail | |
| record_soft_failure([$reason]); | |
| 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 | |
| influenced. | |
| =cut | |
| sub record_soft_failure { | |
| my ($reason) = @_; | |
| bmwqemu::log_call(reason => $reason); | |
| $autotest::current_test->record_soft_failure_result($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]); | |
| Example: | |
| 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. | |
| =cut | |
| 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 | |
| force_soft_failure([$reason]); | |
| 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. | |
| =cut | |
| 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]; | |
| bmwqemu::fctres( | |
| 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)"; | |
| bmwqemu::fctres($status_message); | |
| # 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) { | |
| $autotest::current_test->record_screenfail( | |
| 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"); | |
| $current_test->take_screenshot(); | |
| } | |
| $current_test->save_test_result(); | |
| } | |
| # 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}) { | |
| $autotest::current_test->record_screenfail( | |
| img => $img, | |
| needles => $l->{candidates}, | |
| tags => $tags, | |
| result => $result, | |
| frame => $l->{frame}, | |
| ); | |
| } | |
| else { | |
| $autotest::current_test->record_screenfail( | |
| 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); | |
| } | |
| OpenQA::Exception::FailedNeedle->throw( | |
| error => "no candidate needle with tag(s) '$needletags' matched", | |
| tags => $mustmatch | |
| ); | |
| } | |
| if ($rsp->{saveresult}) { | |
| $autotest::current_test->save_test_result(); | |
| # 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); | |
| } | |
| return; | |
| } | |
| 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. | |
| =cut | |
| 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. | |
| =cut | |
| 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 | |
| match_has_tag($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. | |
| =cut | |
| sub match_has_tag { | |
| my ($tag) = @_; | |
| if ($last_matched_needle) { | |
| return $last_matched_needle->{needle}->has_tag($tag); | |
| } | |
| return; | |
| } | |
| =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. | |
| =cut | |
| 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 | |
| position. | |
| =cut | |
| 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; | |
| last; | |
| } | |
| # 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. | |
| =cut | |
| 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 | |
| executed. | |
| Example: | |
| 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. | |
| =cut | |
| 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 | |
| query_isotovideo('backend_set_reference_screenshot'); | |
| $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; | |
| } | |
| sleep(0.5); | |
| } | |
| save_screenshot; | |
| 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. | |
| Example: | |
| assert_screen_change { send_key 'alt-f4' }; | |
| =cut | |
| 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. | |
| =cut | |
| 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; | |
| bmwqemu::log_call(%args); | |
| $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]; | |
| query_isotovideo('backend_set_reference_screenshot'); | |
| 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; | |
| query_isotovideo('backend_set_reference_screenshot'); | |
| } | |
| 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); | |
| } | |
| $autotest::current_test->timeout_screenshot(); | |
| bmwqemu::fctres("wait_still_screen timed out after $timeout, last detected similarity is $sim"); | |
| return 0; | |
| } | |
| =head2 assert_still_screen | |
| assert_still_screen([$args...]) | |
| Run C<wait_still_screen> but C<die> if screen changed within timeout. Look | |
| into C<wait_still_screen> for details. | |
| =cut | |
| 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> | |
| =cut | |
| sub get_var { | |
| my ($var, $default) = @_; | |
| return $bmwqemu::vars{$var} // $default; | |
| } | |
| =head2 get_required_var | |
| get_required_var($variable) | |
| Similar to C<get_var> but without default value and throws exception if variable can not be retrieved. | |
| =cut | |
| 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) | |
| =cut | |
| sub set_var { | |
| my ($var, $val, %args) = @_; | |
| $bmwqemu::vars{$var} = $val; | |
| if ($args{reload_needles}) { | |
| bmwqemu::save_vars(); | |
| query_isotovideo('backend_reload_needles', {}); | |
| } | |
| return; | |
| } | |
| =head2 check_var | |
| check_var($variable, $value); | |
| Returns true if test variable C<$variable> is equal to C<$value> or returns C<undef>. | |
| =cut | |
| 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 ; ) | |
| =cut | |
| 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 | |
| =cut | |
| 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 | |
| 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/virtio_console.pm and consoles/serial_screen.pm. | |
| =cut | |
| 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 | |
| (default). | |
| 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. | |
| =cut | |
| 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'], @_); | |
| bmwqemu::log_call(%args); | |
| $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/svirt.pm) 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.> | |
| =cut | |
| 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.> | |
| =cut | |
| 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); | |
| return; | |
| } | |
| =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>. | |
| =cut | |
| 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 | |
| C<$serialdev>. | |
| =cut | |
| 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); | |
| return; | |
| } | |
| =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.> | |
| =cut | |
| 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. | |
| =cut | |
| 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. | |
| Example: | |
| save_tmp_file('autoyast/autoinst.xml', '<profile>Test</profile>') | |
| Then the file can be fetched using url: | |
| C< <autoinst_url>/files/autoyast/autoinst.xml> > | |
| =cut | |
| 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 | |
| get_test_data($relpath) | |
| 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. | |
| Example: | |
| get_test_data('autoyast/autoinst.xml') | |
| This will return content of the file located in data/autoyast/autoinst.xml | |
| =cut | |
| 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"); | |
| return; | |
| } | |
| 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/ }; | |
| =cut | |
| 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"; | |
| } | |
| $autotest::current_test->record_resultfile( | |
| 'validate_script_output', $message, | |
| result => $res, | |
| ); | |
| if ($res eq 'fail') { | |
| croak "output not validating"; | |
| } | |
| return 0; | |
| } | |
| =head2 become_root | |
| become_root; | |
| Open a root shell. | |
| I<The implementation is distribution specific and not always available.> | |
| =cut | |
| 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.> | |
| =cut | |
| sub ensure_installed { | |
| return $distri->ensure_installed(@_); | |
| } | |
| =head2 hashed_string | |
| hashed_string(); | |
| Return a short string representing the given string by passing it through the | |
| MD5 algorithm and taking the first characters. | |
| =cut | |
| 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' | |
| =cut | |
| 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_key($key); | |
| Hold one C<$key> until release it | |
| =cut | |
| sub hold_key { | |
| my ($key) = @_; | |
| bmwqemu::log_call('hold_key', key => $key); | |
| query_isotovideo('backend_hold_key', {key => $key}); | |
| } | |
| =head2 release_key | |
| release_key($key); | |
| Release one C<$key> which is kept holding | |
| =cut | |
| 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. | |
| =cut | |
| 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. | |
| =cut | |
| 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}); | |
| return; | |
| } | |
| 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 | |
| # https://stackoverflow.com/questions/372370 | |
| @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. | |
| =cut | |
| 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. | |
| =cut | |
| sub enter_cmd { | |
| type_string shift, lf => 1, @_; | |
| } | |
| =head1 mouse support | |
| =head2 mouse_set | |
| mouse_set($x, $y); | |
| Move mouse pointer to given coordinates | |
| =cut | |
| 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 | |
| =cut | |
| 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. | |
| =cut | |
| 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. | |
| =cut | |
| 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 | |
| mouse_hide([$border_offset]); | |
| Hide mouse cursor by moving it out of screen area. | |
| =cut | |
| 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. | |
| =cut | |
| 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.> | |
| =cut | |
| require backend::console_proxy; | |
| our %testapi_console_proxies; | |
| =head2 select_console | |
| select_console($console [, @args]); | |
| Example: | |
| select_console("root-console"); | |
| 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>. | |
| =cut | |
| 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 | |
| console("testapi_console")->$console_command(@console_command_args) | |
| 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 | |
| here. | |
| =cut | |
| 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 | |
| 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). | |
| =cut | |
| sub reset_consoles { | |
| query_isotovideo('backend_reset_consoles'); | |
| return; | |
| } | |
| =head2 | |
| current_console | |
| Return the currently selected console, a call when no console is selected, will | |
| return C<undef>. | |
| =cut | |
| sub current_console { | |
| return $autotest::selected_console; | |
| } | |
| =head1 audio support | |
| =for stopwords qemu | |
| =head2 start_audiocapture | |
| start_audiocapture; | |
| Tells the backend to record a C<.wav> file of the sound card. | |
| I<Only supported by qemu backend.> | |
| =cut | |
| 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 | |
| assert_recorded_sound('we-will-rock-you'); | |
| 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.> | |
| =cut | |
| sub assert_recorded_sound { | |
| my ($mustmatch) = @_; | |
| return _check_or_assert_sound $mustmatch; | |
| } | |
| =head2 check_recorded_sound | |
| check_recorded_sound('we-will-rock-you'); | |
| 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.> | |
| =cut | |
| sub check_recorded_sound { | |
| my ($mustmatch) = @_; | |
| return _check_or_assert_sound $mustmatch, 1; | |
| } | |
| =head1 miscellaneous | |
| =head2 power | |
| power($action); | |
| Trigger backend specific power action, can be C<'on'>, C<'off'>, C<'acpi'> or C<'reset'> | |
| =cut | |
| sub power { | |
| # params: (on), off, acpi, reset | |
| my ($action) = @_; | |
| bmwqemu::log_call(action => $action); | |
| query_isotovideo('backend_power', {action => $action}); | |
| } | |
| =head2 check_shutdown | |
| check_shutdown([$timeout]); | |
| 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. | |
| =cut | |
| 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"); | |
| sleep($timeout); | |
| } | |
| # -1 counts too | |
| if ($is_shutdown) { | |
| return 1; | |
| } | |
| sleep 1; | |
| --$timeout; | |
| } | |
| return 0; | |
| } | |
| =head2 assert_shutdown | |
| assert_shutdown([$timeout]); | |
| 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. | |
| =cut | |
| sub assert_shutdown { | |
| my ($timeout) = @_; | |
| $timeout //= 60; | |
| if (check_shutdown($timeout)) { | |
| $autotest::current_test->take_screenshot('ok'); | |
| return; | |
| } | |
| else { | |
| $autotest::current_test->take_screenshot('fail'); | |
| croak "Machine didn't shut down!"; | |
| } | |
| } | |
| =head2 eject_cd | |
| eject_cd; | |
| if backend supports it, eject the CD | |
| =cut | |
| sub eject_cd { | |
| bmwqemu::log_call(); | |
| query_isotovideo('backend_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.> | |
| =cut | |
| sub save_memory_dump { | |
| my %nargs = @_; | |
| $nargs{filename} ||= $autotest::current_test->{name}; | |
| bmwqemu::log_call(%nargs); | |
| bmwqemu::diag("Trying to save machine state"); | |
| query_isotovideo('backend_save_memory_dump', \%nargs); | |
| } | |
| =head2 save_storage_drives | |
| save_storage_drives([$filename]); | |
| 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.> | |
| =cut | |
| 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::log_call(); | |
| bmwqemu::diag("Trying to save machine drives"); | |
| bmwqemu::load_vars(); | |
| # 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 | |
| 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.> | |
| =cut | |
| 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/; | |
| bmwqemu::log_call(); | |
| query_isotovideo('backend_freeze_vm'); | |
| } | |
| =head2 resume_vm | |
| 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.> | |
| =cut | |
| sub resume_vm { | |
| bmwqemu::log_call(); | |
| query_isotovideo('backend_cont_vm'); | |
| } | |
| =head2 parse_junit_log | |
| =for stopwords jUnit | |
| parse_junit_log("report.xml"); | |
| 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. | |
| =cut | |
| # 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 | |
| =cut | |
| 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 | |
| local @INC = ($ENV{OPENQA_LIBPATH} // OPENQA_LIBPATH, @INC); | |
| eval { | |
| require OpenQA::Parser; | |
| OpenQA::Parser->import('parser'); | |
| my $parser = parser($format => "ulogs/$file"); | |
| $parser->write_output(bmwqemu::result_dir()); | |
| $parser->write_test_result(bmwqemu::result_dir()); | |
| $parser->tests->each( | |
| 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. | |
| =cut | |
| 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 10.0.2.2 | |
| =cut | |
| sub host_ip { | |
| return check_var('BACKEND', 'qemu') ? get_var('QEMU_HOST_IP', '10.0.2.2') : 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"); | |
| =cut | |
| 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 | |
| data_url($name); | |
| 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 | |
| =cut | |
| 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. | |
| =cut | |
| 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"); | |
| return; | |
| } | |
| 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/suse.ps'; | |
| Or you can upload public assets that will have a fixed filename | |
| replacing previous assets - useful for external users: | |
| upload_asset '/tmp/suse.ps', 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/suse.ps', 1, 1; | |
| =cut | |
| sub upload_asset { | |
| my ($file, $public, $nocheck) = @_; | |
| if (get_var('OFFLINE_SUT')) { | |
| record_info('upload skipped', "Skipped uploading asset '$file' as we are offline"); | |
| return; | |
| } | |
| 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) { | |
| type_string("$cmd\n"); | |
| } | |
| 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'], @_); | |
| =cut | |
| 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; | |
| } | |
| 1; |