File Coverage

backend/baseclass.pm
Criterion Covered Total %
statement 914 1095 83.4
total 914 1095 83.4


line stmt code
1   # Copyright 2009-2013 Bernhard M. Wiedemann
2   # Copyright 2012-2021 SUSE LLC
3   # SPDX-License-Identifier: GPL-2.0-or-later
4    
5   # this is an abstract class
6    
7   use Mojo::Base -base, -signatures;
8 37 use feature 'say';
  37  
  37  
9 37 use autodie ':all';
  37  
  37  
10 37  
  37  
  37  
11   use Carp qw(carp confess);
12 37 use Mojo::JSON; # booleans
  37  
  37  
13 37 use Cpanel::JSON::XS ();
  37  
  37  
14 37 use File::Copy 'cp';
  37  
  37  
15 37 use File::Basename;
  37  
  37  
16 37 use Time::HiRes qw(gettimeofday time tv_interval);
  37  
  37  
17 37 use Try::Tiny;
  37  
  37  
18 37 use POSIX qw(_exit :sys_wait_h);
  37  
  37  
19 37 use IO::Select;
  37  
  37  
20 37 require IPC::System::Simple;
  37  
  37  
21   use myjsonrpc;
22 37 use Net::SSH2 'LIBSSH2_ERROR_EAGAIN';
  37  
  37  
23 37 use OpenQA::Benchmark::Stopwatch;
  37  
  37  
24 37 use MIME::Base64 'encode_base64';
  37  
  37  
25 37 use List::Util 'min';
  37  
  37  
26 37 use List::MoreUtils 'uniq';
  37  
  37  
27 37 use Scalar::Util 'looks_like_number';
  37  
  37  
28 37 use Mojo::File 'path';
  37  
  37  
29 37 use OpenQA::Exceptions;
  37  
  37  
30 37 use Time::Seconds;
  37  
  37  
31 37 use English -no_match_vars;
  37  
  37  
32 37 use OpenQA::NamedIOSelect;
  37  
  37  
33 37  
  37  
  37  
34   use constant FULL_SCREEN_SEARCH_FREQUENCY => $ENV{OS_AUTOINST_FULL_SCREEN_SEARCH_FREQUENCY} // 5;
35 37 use constant FULL_UPDATE_REQUEST_FREQUENCY => $ENV{OS_AUTOINST_FULL_UPDATE_REQUEST_FREQUENCY} // 5;
  37  
  37  
36 37  
  37  
  37  
37   # should be a singleton - and only useful in backend process
38   our $backend;
39    
40   has [qw(
41   update_request_interval last_update_request screenshot_interval
42   last_screenshot last_image assert_screen_check
43   reference_screenshot assert_screen_tags assert_screen_needles
44   assert_screen_deadline assert_screen_fails assert_screen_last_check
45   stall_detected
46   )];
47    
48   my $self = bless({class => $class}, $class);
49 68 $self->{started} = 0;
  68  
  68  
50 68 $self->{serialfile} = "serial0";
51 68 $self->{serial_offset} = 0;
52 68 $self->{video_frame_data} = [];
53 68 $self->{video_frame_number} = 0;
54 68 $self->{video_encoders} = {};
55 68 $self->{external_video_encoder_image_data} = [];
56 68 $self->{min_image_similarity} = 10000;
57 68 $self->{min_video_similarity} = 10000;
58 68 $self->{children} = [];
59 68 $self->{ssh_connections} = {};
60 68 $self->{xres} = $bmwqemu::vars{XRES} // 1024;
61 68 $self->{yres} = $bmwqemu::vars{YRES} // 768;
62 68  
63 68 return $self;
64   }
65 68  
66   open(my $sf, '>', $self->{serialfile});
67   close($sf);
68 14 }
  14  
  14  
69 14  
70 14 # runs in the backend process to deserialize VNC commands
71   my $func = $cmd->{cmd};
72   die "not supported command: $func" unless $self->can($func);
73   return $self->$func($cmd->{arguments});
74 205 }
  205  
  205  
  205  
75 205  
76 205 chomp($msg);
77 205 bmwqemu::fctinfo "Backend process died, backend errors are reported below in the following lines:\n$msg";
78   bmwqemu::serialize_state(component => 'backend', msg => $msg);
79   $backend->stop_vm();
80 2 $backend->close_pipes();
  2  
  2  
81 2 }
82 2  
83 2 bmwqemu::diag("backend got $sig");
84 2 $backend->stop_vm;
85 1 }
86    
87   die "there can be only one!" if $backend;
88 1 $backend = $self;
  1  
  1  
89 1  
90 1 $SIG{__DIE__} = \&die_handler;
91   $SIG{TERM} = \&backend_signalhandler;
92    
93 11 my $io = IO::Handle->new();
  11  
  11  
  11  
  11  
94 11 $io->fdopen($cmdpipe, "r") || die "r fdopen $!";
95 11 $self->{cmdpipe} = $io;
96    
97 11 $io = IO::Handle->new();
98 11 $io->fdopen($rsppipe, "w") || die "w fdopen $!";
99   $rsppipe = $io;
100 11 $io->autoflush(1);
101 11 $self->{rsppipe} = $io;
102 10  
103   bmwqemu::diag "$$: cmdpipe " . fileno($self->{cmdpipe}) . ', rsppipe ' . fileno($self->{rsppipe});
104 10  
105 10 bmwqemu::diag "started mgmt loop with pid $$";
106 10  
107 10 my $select_read = $self->{select_read} = OpenQA::NamedIOSelect->new;
108 10 my $select_write = $self->{select_write} = OpenQA::NamedIOSelect->new;
109   $select_read->add($self->{cmdpipe}, "baseclass::cmdpipe");
110 10 $select_write->add($self->{cmdpipe}, "baseclass::cmdpipe");
111    
112 10 $self->last_update_request("-Inf" + 0);
113   $self->last_screenshot(undef);
114 10 $self->screenshot_interval($bmwqemu::vars{SCREENSHOTINTERVAL} || .5);
115 10 # query the VNC backend more often than we write out screenshots, so the chances
116 10 # are high we're not writing out outdated screens
117 10 $self->update_request_interval($self->screenshot_interval / 2);
118    
119 10 for my $console (values %{$testapi::distri->{consoles}}) {
120 10 # tell the consoles who they need to talk to (in this thread)
121 10 $console->backend($self);
122   }
123    
124 10 $self->run_capture_loop;
125    
126 10 bmwqemu::diag("management process exit at " . POSIX::strftime("%F %T", gmtime));
  10  
127   }
128 16  
129   # write as much data as possible (this is called when $fh is ready to write)
130   my $data = shift @$array_of_buffers;
131 10 my $data_written = $fh->syswrite($data);
132   die "$program_name not accepting data: $!" unless defined $data_written;
133 0  
134   # put remaining data it back into the queue
135   unshift @$array_of_buffers, substr($data, $data_written) unless $data_written == length($data);
136 10532  
  10532  
  10532  
  10532  
  10532  
  10532  
137   # remove file handle from selects if there's no more data to write
138 10532 if (!@$array_of_buffers) {
139 10532 $self->{select_read}->remove($fh);
140 10532 $self->{select_write}->remove($fh);
141   }
142   }
143 10532  
144   # Time slot buckets
145   my $buckets = {};
146 10532 my $wait_time_limit = $bmwqemu::vars{_CHKSEL_RATE_WAIT_TIME} // 30;
147 325 my $hits_limit = $bmwqemu::vars{_CHKSEL_RATE_HITS} // 30_000;
148 325  
149   while (1) {
150   last unless $self->{cmdpipe};
151   my $now = gettimeofday;
152 2803 my $time_to_timeout = "Inf" + 0;
  2803  
  2803  
  2803  
  2803  
153   if (defined $timeout && defined $starttime) {
154 2803 $time_to_timeout = $timeout - ($now - $starttime);
155 2803 last if $time_to_timeout <= 0;
156 2803 }
157    
158 2803 my $time_to_update_request = $self->update_request_interval - ($now - $self->last_update_request);
159 16629 if ($time_to_update_request <= 0) {
160 16627 $self->request_screen_update();
161 16627 $self->last_update_request($now);
162 16627 # no need to interrupt loop if VNC does not talk to us first
163 14272 $time_to_update_request = $time_to_timeout;
164 14272 }
165    
166   # if we got stalled for a long time, we assume bad hardware and report it
167 13836 if ($self->assert_screen_last_check && $now - $self->last_screenshot > $self->screenshot_interval * 20) {
168 13836 $self->stall_detected(1);
169 641 my $diff = $now - $self->last_screenshot;
170 641 bmwqemu::fctwarn "There is some problem with your environment, we detected a stall for $diff seconds";
171   }
172 641  
173   my $time_to_screenshot = $self->screenshot_interval - ($now - $self->last_screenshot);
174   if ($time_to_screenshot <= 0) {
175   $self->capture_screenshot();
176 13836 $self->last_screenshot($now);
177 0 $time_to_screenshot = $self->screenshot_interval;
178 0 }
179 0  
180   my $time_to_next = min($time_to_screenshot, $time_to_update_request, $time_to_timeout);
181   my ($read_set, $write_set) = IO::Select->select($self->{select_read}->select(), $self->{select_write}->select(), undef, $time_to_next);
182 13836  
183 13836 # We need to check the video encoder and the serial socket
184 322 my ($video_encoder, $external_video_encoder, $other) = (0, 0, 0);
185 322 for my $fh (@$write_set) {
186 322 if ($fh == $self->{encoder_pipe}) {
187   $self->_write_buffered_data_to_file_handle('Encoder', $self->{video_frame_data}, $fh);
188   $video_encoder = 1;
189 13836 }
190 13836 elsif ($fh == $self->{external_video_encoder_cmd_pipe}) {
191   $self->_write_buffered_data_to_file_handle('External encoder', $self->{external_video_encoder_image_data}, $fh);
192   $external_video_encoder = 1;
193 13836 }
194 13836 else {
195 10496 next if $other;
196 10496 $other = 1;
197 10496 die "error checking socket for write: $fh\n" unless $self->check_socket($fh, 1) || $other;
198   }
199   last if $video_encoder == 1 && $external_video_encoder == 1 && $other;
200 0 }
201 0  
202   for my $fh (@$read_set) {
203   # This tries to solve the problem of half-open sockets (when reading, as writing will throw an exception)
204 0 # There are three ways to solve this problem:
205 0 # + Send a message either to the application protocol (null message) or to the application protocol framing (an empty message)
206 0 # Disadvantages: Requires changes on both ends of the communication. (for example: on SSH connection i realized that after a
207   # while I start getting "bad packet length" errors)
208 10496 # + Polling the connections (Note: This is how HTTP servers work when dealing with persistent connections)
209   # Disadvantages: False positives
210   # + Change the keepalive packet settings
211 13836 # Disadvantages: TCP/IP stacks are not required to support keepalives.
212   if (fileno $fh && fileno $fh != -1) {
213   # Very high limits! On a working socket, the maximum hits per 10 seconds will be around 60.
214   # The maximum hits per 10 seconds saw on a half open socket was >100k
215   if (check_select_rate($buckets, $wait_time_limit, $hits_limit, fileno $fh, time())) {
216   my $console = $self->{current_console}->{testapi_console};
217   my $fd_nr = fileno $fh;
218   my $cnt = $buckets->{BUCKET}{$fd_nr};
219   my $name = $self->{select_read}->get_name($fh);
220   my $msg = "The file descriptor $fd_nr ($name) hit the read attempts threshold of $hits_limit/${wait_time_limit}s by $cnt. ";
221 202 $msg .= "Active console '$console' is not responding, it could be a half-open socket or you need to increase _CHKSEL_RATE_HITS value. ";
222   $msg .= "Make sure the console is reachable or disable stall detection on expected disconnects with '\$console->disable_vnc_stalls', for example in case of intended machine shutdown.";
223   OpenQA::Exception::ConsoleReadError->throw(error => $msg);
224 202 }
225 0 }
226 0  
227 0  
228 0 die "error checking socket for read: $fh\n" unless $self->check_socket($fh, 0);
229 0 # don't check for further sockets after this one as
230 0 # check_socket can have side effects on the sockets
231 0 # (e.g. console resets), so better take the next socket
232 0 # next time
233   last;
234   }
235   }
236   }
237 202  
238   =head2 run_capture_loop($timeout)
239    
240   =out
241    
242 192 =item timeout
243    
244   run the loop this long in seconds, indefinitely if undef, or until the
245   $self->{cmdpipe} is closed, whichever occurs first.
246    
247   =back
248    
249   =cut
250    
251   my $starttime = gettimeofday;
252   $self->last_screenshot($starttime) unless $self->last_screenshot;
253    
254   eval { $self->do_capture($timeout, $starttime) };
255   return unless $@;
256   bmwqemu::fctwarn "capture loop failed $@";
257   $self->close_pipes();
258   }
259    
260 2803 # wait_time_limit = seconds
  2803  
  2803  
  2803  
261 2803 # This is not sliding buckets. All the IDs inside the bucket must be over the limit!
262 2803 my $lower_limit = $buckets->{TIME} //= $time;
263   my $upper_limit = $lower_limit + $wait_time_limit;
264 2803 if ($time > $upper_limit) {
  2803  
265 2793 $buckets->{TIME} = $time;
266 0  
267 0 # This is to give the opportunity to recover, if the reboot/restart is slow
268   for (keys %{$buckets->{BUCKET}}) {
269   if ($buckets->{BUCKET}{$_} < $hits_limit) {
270   $buckets->{BUCKET} = {$id => 1};
271   return 0;
272 292 }
  292  
  292  
  292  
  292  
  292  
  292  
273 292 }
274 292  
275 292 return 1;
276 6 }
277   $buckets->{BUCKET}{$id}++;
278   return 0;
279 6 }
  6  
280 9  
281 4 my $pid = open($self->{$pipe_name}, '|-', @cmd);
282 4 my $pipe = $self->{$pipe_name};
283   $self->{video_encoders}->{$pid} = {name => $display_name, pipe => $pipe};
284   $pipe->blocking(0);
285   }
286 2  
287   return 0 if $bmwqemu::vars{NOVIDEO};
288 286  
289 286 my $cmd = $bmwqemu::vars{EXTERNAL_VIDEO_ENCODER_CMD} or return 0;
290   my $output_file_name = $bmwqemu::vars{EXTERNAL_VIDEO_ENCODER_OUTPUT_FILE_EXTENSION} // 'webm';
291   my $output_file_path = Cwd::getcwd . "/video.$output_file_name";
292 10 $cmd .= " '$output_file_path'" unless $cmd =~ s/%OUTPUT_FILE_NAME%/$output_file_path/;
  10  
  10  
  10  
  10  
  10  
293 10  
294 10 bmwqemu::diag "Launching external video encoder: $cmd";
295 10 $self->_invoke_video_encoder(external_video_encoder_cmd_pipe => 'external video encoder', $cmd);
296 10 return 1;
297   }
298    
299 10 # start external video encoder if configured
  10  
  10  
300 10 my $has_external_video_encoder_configured = $self->_start_external_video_encoder_if_configured;
301    
302 10 # start internal video encoder; only start it to generate PNGs if an external video encoder is used or NOVIDEO set
303 0 my $cwd = Cwd::getcwd;
304 0 my @cmd = (qw(nice -n 19), "$bmwqemu::scriptdir/videoencoder", "$cwd/video.ogv");
305 0 push(@cmd, '-n') if $bmwqemu::vars{NOVIDEO} || ($has_external_video_encoder_configured && !$bmwqemu::vars{EXTERNAL_VIDEO_ENCODER_ADDITIONALLY});
306   push @cmd, '-x', $self->{xres}, '-y', $self->{yres};
307 0 $self->_invoke_video_encoder(encoder_pipe => 'built-in video encoder', @cmd);
308 0  
309 0 # open file for recording real time clock timestamps as subtitle
310   open($self->{vtt_caption_file}, '>', "$cwd/video_time.vtt");
311   $self->{vtt_caption_file}->print("WEBVTT\n");
312 10  
  10  
  10  
313   return;
314 10 }
315    
316   my $video_encoders = delete $self->{video_encoders};
317 10 return undef unless defined $video_encoders && keys %$video_encoders;
318 10  
319 10 # pass remaining video frames to the video encoder
320 10 bmwqemu::diag 'Passing remaining frames to the video encoder';
321 10 my $timeout = 30;
322   my $video_data_for_internal_encoder = $self->{video_frame_data};
323   my $video_data_for_external_encoder = $self->{external_video_encoder_image_data};
324 10 my $select = IO::Select->new;
325 10 $select->add(my $internal_pipe = $self->{encoder_pipe}) if @$video_data_for_internal_encoder;
326   $select->add(my $external_pipe = $self->{external_video_encoder_cmd_pipe}) if @$video_data_for_external_encoder;
327 10 try {
328   while ($select->count) {
329   $! = 0;
330 11 die($! ? "$!\n" : 'timeout exceeded') unless my @ready = $select->can_write($timeout);
  11  
  11  
331 11 for my $fh (@ready) {
332 11 if (defined $internal_pipe && $fh == $internal_pipe) {
333   $self->_write_buffered_data_to_file_handle('Encoder', $video_data_for_internal_encoder, $fh);
334   $select->remove($fh) unless @$video_data_for_internal_encoder;
335 10 }
336 10 elsif (defined $external_pipe && $fh == $external_pipe) {
337 10 $self->_write_buffered_data_to_file_handle('External encoder', $video_data_for_external_encoder, $fh);
338 10 $select->remove($fh) unless @$video_data_for_external_encoder;
339 10 }
340 10 }
341 10 }
342   }
343 10 catch {
344 19 bmwqemu::diag "Unable to pass remaining frames to video encoder: $_";
345 19 };
346 19  
347 37 # give the video encoder processes time to finalize the video
348 19 # note: Closing the pipe should cause the video encoder to terminate. Not sending SIGTERM/SIGINT because the signal might be
349 18 # already sent by the worker or shell and ffmpeg will not continue finalizing the video after receiving a 2nd exit signal.
350   no autodie qw(close waitpid);
351   close $video_encoders->{$_}->{pipe} for keys %$video_encoders;
352 18 bmwqemu::diag 'Waiting for video encoder to finalize the video';
353 18 for (my $interval = 0.25; $timeout > 0; sleep($interval), $timeout -= $interval) {
354   for my $pid (keys %$video_encoders) {
355   my $ret = waitpid($pid, WNOHANG);
356   if ($ret == $pid || $ret == -1) {
357   bmwqemu::diag "The $video_encoders->{$pid}->{name} (pid $pid) terminated";
358   delete $video_encoders->{$pid};
359 1 }
360 10 }
361   last unless keys %$video_encoders;
362   }
363   return undef unless keys %$video_encoders;
364   bmwqemu::diag "Unable to terminate $video_encoders->{$_}->{name}, sending SIGKILL" for keys %$video_encoders;
365 37 kill KILL => (keys %$video_encoders);
  37  
  37  
366 10 }
367 10  
368 10 # new api
369 486  
370 486 $self->{started} = 1;
371 486 $self->start_encoder();
372 6 return $self->do_start_vm();
373 6 }
374    
375   if ($self->{started}) {
376 486 # backend.run might have disappeared already in case of failed builds
377   no autodie 'unlink';
378 10 unlink('backend.run');
379 4 $self->do_stop_vm();
380 4 $self->{started} = 0;
381   }
382   $self->_stop_video_encoder();
383   $self->close_ssh_connections();
384   $self->close_pipes(); # does not return
385 10 return;
  10  
  10  
386 10 }
387 10  
388 10 return 0 unless $self->{started};
389   return 1 if $self->file_alive() and $self->raw_alive();
390   bmwqemu::fctwarn("ALARM: backend.run got deleted! - exiting...");
391 11 _exit(1);
  11  
  11  
392 11 }
393    
394 37 # new api end
  37  
  37  
395 6  
396 6 # virtual methods
397 6 my $method = (caller(1))[3];
398   $method =~ s/^backend::baseclass:://;
399 11 confess sprintf "backend method '%s' not implemented for class '%s'",
400 11 $method, ref $self;
401 11 }
402 5  
403   # parameters: acpi, reset, (on), off
404    
405 9 return; # sorry, no
  9  
  9  
406 9 }
407 0  
408 0  
409 0  
410    
411    
412    
413   ## MAY be overwritten:
414    
415 75 # vm's would return
  75  
  75  
416 75 # (userstat, systemstat)
417 75  
418 75 my $frametime_ms = 1000 * $self->{video_frame_number} / 24;
419   my $caption = "\n$self->{video_frame_number}\n";
420   # presentation time span (one frame)
421   $caption .= sprintf(POSIX::strftime("%T.%%03d", gmtime($frametime_ms / 1000)), $frametime_ms % 1000);
422   $frametime_ms += 1000 / 24;
423 10 $caption .= " --> ";
  10  
  10  
  10  
  10  
424 5 $caption .= sprintf(POSIX::strftime("%T.%%03d\n", gmtime($frametime_ms / 1000)), $frametime_ms % 1000);
  5  
  5  
  5  
425 10 # clock value as caption text
  10  
  10  
  10  
  10  
426 10 $caption .= sprintf(POSIX::strftime("[%FT%T.%%03d]\n", localtime($walltime)), 1000 * ($walltime - int($walltime)));
  10  
  10  
  10  
427 10  
  10  
  10  
  10  
428 5 return $caption;
  5  
  5  
  5  
429 5 }
  5  
  5  
  5  
430    
431 5 my $watch = OpenQA::Benchmark::Stopwatch->new();
  5  
  5  
432 5 $watch->start();
433    
434   $image = $image->scale($self->{xres}, $self->{yres});
435 5 $watch->lap("scaling");
  5  
  5  
  5  
  5  
436    
437 5 my $lastscreenshot = $self->last_image;
  5  
  5  
  5  
438    
439 5 # link identical files to save space
  5  
  5  
  5  
  5  
440   my $sim = 0;
441 5 $sim = $lastscreenshot->similarity($image) if $lastscreenshot;
  5  
  5  
  5  
  5  
442   $watch->lap("similarity");
443 5  
  5  
  5  
  5  
  5  
444   $self->{min_image_similarity} -= 1;
445   $self->{min_image_similarity} = $sim if $sim < $self->{min_image_similarity};
446   $self->{min_video_similarity} -= 1;
447   $self->{min_video_similarity} = $sim if $sim < $self->{min_video_similarity};
448    
449 5 # ensure gettimeofday returns float number, not a list of two entries
  5  
  5  
  5  
450   # where we would discard the second element
451 331 $self->{vtt_caption_file}->print($self->format_vtt_timestamp('' . gettimeofday));
  331  
  331  
  331  
452 331  
453 331 # we have two different similarity levels - one (slightly higher value, based
454   # t/data/user-settings-*) to determine if it's worth it to recheck needles
455 331 # and one (slightly lower as less significant) determining if we write the frame
456 331 # into the video
457 331 if ($self->{min_image_similarity} <= 54) {
458 331 $self->last_image($image);
459   $self->{min_image_similarity} = 10000;
460 331 }
461    
462 331 my $external_video_encoder_cmd_pipe = $self->{external_video_encoder_cmd_pipe};
463   if ($self->{min_video_similarity} > 50) { # we ignore smaller differences
464   push(@{$self->{video_frame_data}}, "R\n");
465 321 push(@{$self->{external_video_encoder_image_data}}, $self->{last_image_data})
  321  
  321  
  321  
466 321 if defined $external_video_encoder_cmd_pipe && defined $self->{last_image_data};
467 321 }
468   else {
469 321 my $imgdata = $self->{last_image_data} = $image->ppm_data;
470 321 $watch->lap("convert ppm data");
471   push(@{$self->{video_frame_data}}, 'E ' . length($imgdata) . "\n");
472 321 push(@{$self->{video_frame_data}}, $imgdata);
473   $self->{min_video_similarity} = 10000;
474   push(@{$self->{external_video_encoder_image_data}}, $imgdata)
475 321 if defined $external_video_encoder_cmd_pipe;
476 321 }
477 321 my $encoder_pipe = $self->{encoder_pipe};
478   $self->{select_read}->add($encoder_pipe, 'baseclass::encoder_pipe');
479 321 $self->{select_write}->add($encoder_pipe, 'baseclass::encoder_pipe');
480 321 if (defined $external_video_encoder_cmd_pipe) {
481 321 $self->{select_read}->add($external_video_encoder_cmd_pipe, 'baseclass::external_video_encoder_cmd_pipe');
482 321 $self->{select_write}->add($external_video_encoder_cmd_pipe, 'baseclass::external_video_encoder_cmd_pipe');
483   }
484   $self->{video_frame_number} += 1;
485    
486 321 $watch->stop();
487   if ($watch->as_data()->{total_time} > $self->screenshot_interval && !$bmwqemu::vars{NO_DEBUG_IO}) {
488   bmwqemu::fctwarn sprintf("enqueue_screenshot took %.2f seconds", $watch->as_data()->{total_time});
489   bmwqemu::diag "DEBUG_IO: \n" . $watch->summary();
490   }
491    
492 321 return;
493 297 }
494 297  
495   if ($self->{cmdpipe}) {
496   close($self->{cmdpipe}) || die "close $!\n";
497 321 $self->{cmdpipe} = undef;
498 321 }
499 46  
  46  
500 0 return unless $self->{rsppipe};
501 46  
502   # disarm SIGTERM handler to avoid re-entrant stop_vm call, stopping anyway
503   $SIG{TERM} = 'IGNORE';
504 275  
505 275 bmwqemu::diag "sending magic and exit";
506 275 myjsonrpc::send_json($self->{rsppipe}, {QUIT => 1});
  275  
507 275 close($self->{rsppipe}) || die "close $!\n";
  275  
508 275 Devel::Cover::report() if Devel::Cover->can('report');
509 275 _exit(0);
  0  
510   }
511    
512 321 # this is called for all sockets ready to read from
513 321 if ($self->{cmdpipe} && $fh == $self->{cmdpipe}) {
514 321 return 1 if $write;
515 321 my $cmd = myjsonrpc::read_json($self->{cmdpipe});
516 0  
517 0 if ($cmd->{cmd}) {
518   my $rsp = {rsp => ($self->handle_command($cmd) // 0)};
519 321 $rsp->{json_cmd_token} = $cmd->{json_cmd_token};
520   if ($self->{rsppipe}) { # the command might have closed it
521 321 myjsonrpc::send_json($self->{rsppipe}, $rsp);
522 321 }
523 0 }
524 0 else {
525   use Data::Dumper;
526   die "no command in " . Dumper($cmd);
527 321 }
528   return 1;
529   }
530 12 return 0;
  12  
  12  
531 12 }
532 6  
533 6 ###################################################################
534   ## access other consoles from the test case process
535    
536 12 # There can be two vnc backends (local Xvnc or remote vnc) and
537   # there can be several terminals on the local Xvnc.
538   #
539 6 # switching means: turn to the right vnc and if it's the Xvnc,
540   # iconify/deiconify the right x3270 terminal window.
541 6 #
542 6 # For now, we just raise the terminal window to the front on the local-Xvnc
543 6 # DISPLAY.
544 6 #
545 0 # should we hide the other windows, somehow?
546   #if exists $self->{current_console} ...
547   # my $current_window_id = $self->{current_console}->{window_id};
548   # if (defined $current_window_id) {
549 203 # system("DISPLAY=$display xdotool windowminimize --sync $current_window_id");
  203  
  203  
  203  
  203  
550 203 # }
551 200 #-> select
552 200  
553   my $testapi_console = $args->{testapi_console};
554 200  
555 200 my $selected_console = $self->console($testapi_console);
556 191 my $activated = try {
557 191 local $SIG{__DIE__} = 'DEFAULT';
558 191 $selected_console->select;
559   }
560   catch {
561   {error => $_};
562 37 };
  37  
  37  
563 0  
564   return $activated if ref($activated);
565 190 $self->{current_console} = $selected_console;
566   $self->{current_screen} = $selected_console->screen;
567 3 $self->capture_screenshot();
568   return {activated => $activated};
569   }
570    
571   # we iterate through all consoles
572   for my $console (keys %{$testapi::distri->{consoles}}) {
573   next if $self->console($console)->{args}->{persistent};
574   $self->reset_console({testapi_console => $console});
575   }
576   return;
577   }
578    
579   $self->console($args->{testapi_console})->reset;
580   return;
581   }
582    
583   my $testapi_console = $args->{testapi_console};
584   my $console_info = $self->console($testapi_console);
585   $self->{current_console} = undef if defined $self->{current_console} && $self->{current_console} == $console_info;
586   $console_info->disable();
587   return;
588   }
589    
590 7 for my $console (keys %{$testapi::distri->{consoles}}) {
  7  
  7  
  7  
591 7 my $console_info = $self->console($console);
592   $console_info->disable() if $console_info->can('disable');
593 7 }
594   }
595 7  
596 7 for my $console (keys %{$testapi::distri->{consoles}}) {
597   my $console_info = $self->console($console);
598   $console_info->activate() if $console_info->{activated} && $console_info->can('disable');
599 1 }
600 7 }
601    
602 7 =head3 save_console_snapshots
603 4  
604 4 Should be called when a snapshot of the SUT is taken to save the current state
605 4 of any consoles which have state. For example: text consoles may have
606 4 unprocessed output from the SUT in their buffers which is needed by test
607   module after the snapshot.
608    
609 0 =cut
  0  
  0  
  0  
610   for my $console (keys %{$testapi::distri->{consoles}}) {
611 0 my $console_info = $self->console($console);
  0  
612 0 $console_info->save_snapshot($name) if $console_info->can('save_snapshot');
613 0 }
614   }
615 0  
616   =head3 load_console_snapshots
617    
618 0 Should be called when a snapshot of the SUT is loaded to ensure consoles are
  0  
  0  
  0  
619 0 in the same state as when the snapshot was taken.
620 0  
621   =cut
622   for my $console (keys %{$testapi::distri->{consoles}}) {
623 5 my $console_info = $self->console($console);
  5  
  5  
  5  
624 5 $console_info->load_snapshot($name) if $console_info->can('load_snapshot');
625 5 }
626 5 }
627 5  
628 5 return $self->bouncer('request_screen_update', $args);
629   }
630    
631 1 my $ret = $testapi::distri->{consoles}->{$testapi_console};
  1  
  1  
632 1 carp "console $testapi_console does not exist" unless $ret;
  1  
633 1 return $ret;
634 1 }
635    
636   # forward to the current VNC console
637   return unless $self->{current_screen};
638 0 return $self->{current_screen}->$call($args);
  0  
  0  
639 0 }
  0  
640 0  
641 0 return $self->bouncer('send_key', $args);
642   }
643    
644   return $self->bouncer('hold_key', $args);
645   }
646    
647   return $self->bouncer('release_key', $args);
648   }
649    
650   return $self->bouncer('type_string', $args);
651   }
652    
653 0 return $self->bouncer('mouse_set', $args);
  0  
  0  
  0  
654 0 }
  0  
655 0  
656 0 return $self->bouncer('mouse_hide', $args);
657   }
658    
659   return $self->bouncer('mouse_button', $args);
660   }
661    
662   return $self->bouncer('get_last_mouse_set', $args);
663   }
664    
665   return {yesorno => $self->{current_console}->is_serial_terminal};
666 0 }
  0  
  0  
  0  
667 0  
  0  
668 0  
669 0 return unless $self->{current_screen};
670    
671   my $screen = $self->{current_screen}->current_screen();
672   $self->enqueue_screenshot($screen) if $screen;
673 663 return;
  663  
  663  
  663  
674 663 }
675    
676   # called from testapi::set_var, so read the vars
677 25 bmwqemu::load_vars();
  25  
  25  
  25  
678 25  
679 25 $_->unregister() for needle::all();
680 25 needle::init();
681   }
682    
683 698 ###################################################################
  698  
  698  
  698  
  698  
684   # this is used by backend::console_proxy
685 698 my ($console, $function, $args) = @$wrapped_call{qw(console function args)};
686 682 $console = $self->console($console);
687    
688   my $wrapped_result = {};
689 4  
  4  
  4  
  4  
690 4 eval {
691   # Do not die in here.
692   # Move the decision to actually die to the server side instead.
693 0 # For this ignore backend::baseclass::die_handler.
  0  
  0  
  0  
694 0 local $SIG{__DIE__} = 'DEFAULT';
695   $wrapped_result->{result} = $wrapped_call->{wantarray} ? [$console->$function(@$args)] : $console->$function(@$args);
696   };
697 0 $wrapped_result->{exception} = join("\n", bmwqemu::pp($wrapped_call), $@) if $@;
  0  
  0  
  0  
698 0 return $wrapped_result;
699   }
700    
701 30 =head2 clear_serial_buffer
  30  
  30  
  30  
702 30  
703   Determines the starting offset within the serial file - so that we do not check the
704   previous test's serial output. Call this before you start doing something new
705 0  
  0  
  0  
  0  
706 0 =cut
707    
708   $self->{serial_offset} = -s $self->{serialfile};
709 1 return $self->{serial_offset};
  1  
  1  
  1  
710 1 }
711    
712    
713 0 =head2 serial_text
  0  
  0  
  0  
714 0  
715   Returns the output on the serial device since the last call to clear_serial_buffer
716    
717 0 =cut
  0  
  0  
  0  
718 0  
719   return ($self->read_serial($self->{serial_offset}))[0];
720   }
721 0  
  0  
  0  
  0  
722 0 =head2 read_serial
723    
724   Returns the output and the offset after reading on the serial device from position
725 2  
  2  
  2  
  2  
  2  
726   =cut
727 326  
  326  
  326  
728 326 open(my $SERIAL, "<", $self->{serialfile});
729   seek($SERIAL, $position, $whence);
730 323 local $/;
731 323 my $data = <$SERIAL>;
732 323 my $offset = tell $SERIAL;
733   close($SERIAL);
734    
735 1 return ($data, $offset);
  1  
736   }
737 1  
738   my $regexp = $args->{regexp};
739 1 my $timeout = $args->{timeout};
740 1 my $matched = 0;
741   my $str;
742    
743   confess '\'current_console\' is not set' unless $self->{current_console};
744   if ($self->{current_console}->is_serial_terminal) {
745 40 return $self->{current_screen}->read_until($regexp, $timeout, %$args);
  40  
  40  
  40  
746 40 }
747 40  
748   $regexp = [$regexp] if ref $regexp ne 'ARRAY';
749 40 my $initial_time = time;
750   my $current_offset = $self->{serial_offset};
751 40 while (time < $initial_time + $timeout) {
752   $str = $self->serial_text();
753   for my $r (@$regexp) {
754   if (!$args->{no_regex} && $str =~ m/$r/) {
755 40 $current_offset += $LAST_MATCH_END[0];
756 40 $str = substr($str, 0, $LAST_MATCH_END[0]);
757   $matched = 1;
758 40 last;
759 40 } elsif ($args->{no_regex} && (my $i = index($str, $r)) >= 0) {
760   $current_offset += length($r) + $i;
761   $str = substr($str, 0, $i + length($r));
762   $matched = 1;
763   last;
764   }
765   }
766   last if ($matched);
767   $self->run_capture_loop(1);
768   }
769 27 $self->{serial_offset} = $current_offset;
  27  
  27  
770 27 return {matched => $matched, string => $str};
771 27 }
772    
773   # set_reference_screenshot and similiarity_to_reference are necessary to
774   # implement wait_still and wait_changed functions in the tests without having
775   # to transfer the screenshot into the test process
776   $self->reference_screenshot($self->last_image);
777   return;
778   }
779    
780   return {sim => 10000} if (!$self->reference_screenshot || !$self->last_image);
781 15 return {sim => $self->reference_screenshot->similarity($self->last_image)};
  15  
  15  
782 15 }
783    
784   my $mustmatch = $args->{mustmatch};
785   my $timeout = $args->{timeout} // $bmwqemu::default_timeout;
786    
787   # keep only the most recently used images (https://progress.opensuse.org/issues/15438)
788   needle::clean_image_cache();
789    
790   # get the array reference to all matching needles
791 33 my $needles = [];
  33  
  33  
  33  
  33  
792 33 my @tags;
793 32 if (ref($mustmatch) eq "ARRAY") {
794 32 my @a = @$mustmatch;
795 32 while (my $n = shift @a) {
796 32 if (ref($n) eq '') {
797 32 push @tags, split(/ /, $n);
798   $n = needle::tags($n);
799 32 push @a, @$n if $n;
800   next;
801   }
802 13 unless (ref($n) eq 'needle' && $n->{name}) {
  13  
  13  
  13  
803 13 warn "invalid needle passed <" . ref($n) . "> " . bmwqemu::pp($n);
804 13 next;
805 13 }
806 13 push @$needles, $n;
807   }
808 13 $needles = [uniq @$needles];
809 13 }
810 0 elsif ($mustmatch) {
811   $needles = needle::tags($mustmatch) || [];
812   @tags = ($mustmatch);
813 13 }
814 13  
815 13 { # remove duplicates
816 13 my %h = map { $_ => 1 } @tags;
817 15 @tags = sort keys %h;
818 15 }
819 15 $mustmatch = join(',', @tags);
820 9 bmwqemu::fctinfo "NO matching needles for $mustmatch" unless @$needles;
821 9  
822 9 $self->set_assert_screen_timeout($timeout);
823 9 $self->assert_screen_fails([]);
824   $self->assert_screen_needles($needles);
825 2 $self->assert_screen_last_check(undef);
826 2 $self->stall_detected(0);
827 2 # store them for needle reload event
828 2 $self->assert_screen_tags(\@tags);
829   $self->assert_screen_check($args->{check});
830   return {tags => \@tags};
831 15 }
832 4  
833   return bmwqemu::fctwarn('set_assert_screen_timeout called with non-numeric timeout') unless looks_like_number($timeout);
834 13 $self->assert_screen_deadline(time + $timeout);
835 13 return $self->assert_screen_deadline;
836   }
837    
838   return $self->assert_screen_deadline - time;
839   }
840    
841 9 my $failed_screens = $self->assert_screen_fails;
  9  
  9  
  9  
842 9 my $final_mismatch = $failed_screens->[-1];
843 9 if ($final_mismatch) {
844   _reduce_to_biggest_changes($failed_screens, 20);
845   # only append the last mismatch if it's different to the last one in the reduced list
846 15 my $new_final = $failed_screens->[-1];
  15  
  15  
  15  
847 15 if ($new_final != $final_mismatch) {
848 15 my $sim = $new_final->[0]->similarity($final_mismatch->[0]);
849   push(@$failed_screens, $final_mismatch) if ($sim < 50);
850   }
851 9 }
  9  
  9  
  9  
852 9  
853 9 my @json_fails;
854   for my $l (@$failed_screens) {
855   my ($img, $failed_candidates, $testtime, $similarity, $frame) = @$l;
856 9 my $h = {
857   candidates => $failed_candidates,
858   image => encode_base64($img->ppm_data),
859 9 frame => $frame,
860 9 };
861 9 push(@json_fails, $h);
862 1 }
863 1  
864 2 # free memory
865 2 $self->assert_screen_fails([]);
866 2 return {timeout => 1, failed_screens => \@json_fails};
867 2 }
868 2  
869   # compensate rounding to be consistent with truncation in $search_ratio calculation
870 0 return sprintf("%.1fs", $time - 0.05);
871 0 }
872 0  
873   $self->{_final_full_update_requested} = 0;
874 0 $self->assert_screen_last_check(undef);
875   }
876 1  
877   return unless my $img = $self->last_image; # no screenshot yet to search on
878   my $watch = OpenQA::Benchmark::Stopwatch->new();
879 8 my $timestamp = $self->last_screenshot;
880 8 my $n = $self->_time_to_assert_screen_deadline;
881   my $frame = $self->{video_frame_number};
882    
883   # do a full-screen search every FULL_SCREEN_SEARCH_FREQUENCY'th time and at the end
884 9 my $search_ratio = $n < 0 || $n % FULL_SCREEN_SEARCH_FREQUENCY == 0 ? 1 : 0.02;
  9  
  10  
885 9 my ($oldimg, $old_search_ratio) = @{$self->assert_screen_last_check || [undef, 0]};
886    
887 9 bmwqemu::diag('no change: ' . time_remaining_str($n)) and return if $n >= 0 && $oldimg && $oldimg eq $img && $old_search_ratio >= $search_ratio;
888 9  
889   $watch->start();
890 9 $watch->{debug} = 0;
891 9  
892 9 my @registered_needles = grep { !$_->{unregistered} } @{$self->assert_screen_needles};
893 9 my ($foundneedle, $failed_candidates) = $img->search(\@registered_needles, 0, $search_ratio, ($watch->{debug} ? $watch : undef));
894 9 $watch->lap("Needle search") unless $watch->{debug};
895   if ($foundneedle) {
896 9 $self->_reset_asserted_screen_check_variables;
897 9 return {
898 9 image => encode_base64($img->ppm_data),
899   found => $foundneedle,
900   candidates => $failed_candidates,
901 9 frame => $frame,
  9  
  9  
  9  
902 9 };
903 9 }
904 9  
905   $watch->stop();
906   if ($watch->as_data()->{total_time} > $self->screenshot_interval) {
907 44 bmwqemu::fctwarn sprintf(
  44  
  44  
908 44 "check_asserted_screen took %.2f seconds for %d candidate needles - make your needles more specific",
909   $watch->as_data()->{total_time},
910   scalar(@registered_needles));
911 3 bmwqemu::diag "DEBUG_IO: \n" . $watch->summary() if (!$bmwqemu::vars{NO_DEBUG_IO} && $watch->{debug});
  3  
  3  
912 3 }
913 3  
914 3 my $no_match_diag = 'no match: ' . time_remaining_str($n);
915 3 if (my $best_candidate = $failed_candidates->[0]) {
916   $no_match_diag .= sprintf(
917 3 ", best candidate: %s (%.2f)",
918 3 $best_candidate->{needle}->{name},
919 0 1 - sqrt($best_candidate->{error})
920 0 );
921   }
922   bmwqemu::diag($no_match_diag);
923    
924 3 if ($n < 0) {
925 3 $self->_reset_asserted_screen_check_variables;
926 5  
927 5 if (!$self->assert_screen_check) {
928   my @unregistered_needles = grep { $_->{unregistered} } @{$self->assert_screen_needles};
929   my ($foundneedle, $candidates) = $img->search(\@unregistered_needles, 0, 1, undef);
930   # the best here is still a failure, as unregistered
931   push(@$failed_candidates, $foundneedle) if $foundneedle;
932 5 push(@$failed_candidates, @$candidates);
933   }
934   my $failed_screens = $self->assert_screen_fails;
935   # store the final mismatch
936 3 push(@$failed_screens, [$img, $failed_candidates, 0, 1000, $frame]);
937 3 my $hash = $self->_failed_screens_to_json;
938   $hash->{image} = encode_base64($img->ppm_data);
939   # store stall status
940 60 $hash->{stall} = $self->stall_detected;
  60  
  60  
941    
942 60 return $hash;
943   }
944   elsif ($n <= $self->screenshot_interval * 2 && !$self->{_final_full_update_requested}) {
945 9 # try to request a full screen update to workaround possibly destorted VNC screen
  9  
  9  
946 9 # as we're nearing the deadline
947 9 $self->request_screen_update({incremental => 0});
948   $self->{_final_full_update_requested} = 1;
949   }
950 47 elsif ($n % FULL_UPDATE_REQUEST_FREQUENCY == 0) {
  47  
  47  
  47  
951 47 $self->request_screen_update({incremental => 0});
952 47 }
953 47  
954 47 if ($search_ratio == 1) {
955 47 # save only failures where the whole screen has been searched
956   # results of partial searching are rather confusing
957    
958 47 # as the images create memory pressure, we only save quite different images
959 47 # the last screen is handled automatically and the first screen is only interesting
  47  
960   # if there are no others
961 47 my $sim = 29;
962   my $failed_screens = $self->assert_screen_fails;
963 47 if ($failed_screens->[-1] && $n > 0) {
964 47 $sim = $failed_screens->[-1]->[0]->similarity($img);
965   }
966 47 if ($sim < 30) {
  24  
  47  
967 47 push(@$failed_screens, [$img, $failed_candidates, $n, $sim, $frame]);
968 47 }
969 47 # clean up every once in a while to avoid excessive memory consumption.
970 6 # The value here is an arbitrary limit.
971   if (@$failed_screens > 60) {
972 6 _reduce_to_biggest_changes($failed_screens, 20);
973   }
974   }
975   $self->assert_screen_last_check([$img, $search_ratio]);
976   return;
977   }
978    
979 41 return if @$imglist <= $limit;
980 41  
981   my $first = shift @$imglist;
982   @$imglist = (sort { $b->[3] <=> $a->[3] } @$imglist)[0 .. (@$imglist > $limit ? $limit - 1 : $#$imglist)];
983   unshift @$imglist, $first;
984 0  
985 0 # now sort for test time
986   @$imglist = sort { $b->[2] <=> $a->[2] } @$imglist;
987    
988 41 # recalculate similarity
989 41 for (my $i = 1; $i < @$imglist; ++$i) {
990   $imglist->[$i]->[3] = $imglist->[$i - 1]->[0]->similarity($imglist->[$i]->[0]);
991   }
992    
993   return;
994 15 }
995    
996 41 bmwqemu::diag "ignored freeze_vm";
997   return;
998 41 }
999 3  
1000   bmwqemu::diag "ignored cont_vm";
1001 3 return;
1002 2 }
  0  
  2  
1003 2  
1004   return {} unless $self->last_image;
1005 2 return {
1006 2 image => encode_base64($self->last_image->ppm_data),
1007   frame => $self->{video_frame_number},
1008 3 };
1009   }
1010 3  
1011 3 my $imgpath = $args->{imgpath};
1012 3 my $mustmatch = $args->{mustmatch};
1013    
1014 3 my $img = tinycv::read($imgpath);
1015   my $needles = needle::tags($mustmatch) || [];
1016 3  
1017   my ($foundneedle, $failed_candidates) = $img->search($needles, 0, 1);
1018   return {found => $foundneedle, candidates => $failed_candidates} if $foundneedle;
1019   return {candidates => $failed_candidates};
1020   }
1021 3  
1022 3 $self->reload_needles if $args->{reload_needles};
1023   # reset timeout otherwise continue wait_forneedle might just fail if stopped too long than timeout
1024   $self->set_assert_screen_timeout($args->{timeout}) if $args->{timeout};
1025 21 $self->cont_vm;
1026   # do not need to retry in 5 seconds but contining SUT if continue_waitforneedle
1027   if ($args->{reload_needles}) {
1028 38 # short timeout, we're already there
1029   $self->set_tags_to_assert({mustmatch => $self->assert_screen_tags, timeout => 5, reloadneedles => 1});
1030   }
1031   return;
1032   }
1033    
1034   # shared between svirt and s390 backend
1035 24 bmwqemu::log_call(%{$self->hide_password(%args)});
1036 24 my %credentials = $self->get_ssh_credentials;
1037 24 $args{$_} //= $credentials{$_} foreach (keys(%credentials));
1038 19 $args{username} ||= 'root';
1039   $args{port} ||= 22;
1040 24 $args{keep_open} //= 0;
1041 6 my $connection_key;
1042    
1043   # e.g. using hyperv_intermediate host which is running Windows need to keep the connection.
1044   # Otherwise a mount point doesn't exists within the next command.
1045 24 if ($args{keep_open}) {
1046 0 $connection_key = join(',', map { $_ . "=" . $args{$_} } qw(hostname username port));
1047   my $con = $self->{ssh_connections}->{$connection_key};
1048   if (defined($con)) {
1049 38 # Check if we still can create channels on that connection
1050 38 if (my $tmp_chan = $con->channel()) {
1051   $tmp_chan->close();
1052   bmwqemu::diag "Use existing SSH connection (key:$connection_key)";
1053 3 return $con;
  3  
  3  
  3  
1054 3 } else {
1055   bmwqemu::diag "Close broken SSH connection (key:$connection_key)";
1056 0 $con->disconnect();
1057 0 delete $self->{ssh_connections}->{$connection_key};
  0  
1058 0 }
1059   }
1060   }
1061 0  
  0  
1062   # timeout requires libssh2 >= 1.2.9 so not all versions might have it
1063   my $ssh = Net::SSH2->new(timeout => ($bmwqemu::vars{SSH_COMMAND_TIMEOUT_S} // 5 * ONE_MINUTE) * 1000);
1064 0  
1065 0 # Retry multiple times, in case of the guest is not running yet
1066   my $counter = $bmwqemu::vars{SSH_CONNECT_RETRY} // 5;
1067   my $con_pretty = "$args{username}\@$args{hostname}";
1068 0 $con_pretty .= ":$args{port}" unless $args{port} == 22;
1069   while ($counter > 0) {
1070   if ($ssh->connect($args{hostname}, $args{port})) {
1071 0  
  0  
  0  
1072 0 if ($args{password}) {
1073 0 $ssh->auth(username => $args{username}, password => $args{password});
1074   }
1075   else {
1076 0 # this relies on agent to be set up correctly
  0  
  0  
1077 0 $ssh->auth_agent($args{username});
1078 0 }
1079   bmwqemu::diag "SSH connection to $con_pretty established" if $ssh->auth_ok;
1080   last;
1081 13 }
  13  
  13  
  13  
1082 13 else {
1083   bmwqemu::diag "Could not connect to $con_pretty, Retrying after some seconds...";
1084   sleep($bmwqemu::vars{SSH_CONNECT_RETRY_INTERVAL} // 10);
1085   $counter--;
1086 12 next;
1087   }
1088   }
1089 0 OpenQA::Exception::SSHConnectionError->throw(error => "Error connecting to <$con_pretty>: $@") unless $ssh->auth_ok;
  0  
  0  
  0  
1090 0  
1091 0 $self->{ssh_connections}->{$connection_key} = $ssh if ($args{keep_open});
1092   return $ssh;
1093 0 }
1094 0  
1095   =head2 get_ssh_credentials
1096 0 Should return a hash with the keys: C<hostname, username, password, port>
1097 0 The keys port and username are optional and default to 22 and 'root', respectively.
1098 0 =cut
1099    
1100   # open another ssh connection to grab the serial console
1101 0 bmwqemu::log_call(%{$self->hide_password(%args)});
  0  
  0  
  0  
1102 0 $self->stop_ssh_serial;
1103    
1104 0 my $ssh = $self->{serial} = $self->new_ssh_connection(%args);
1105 0 my $chan = $self->{serial_chan} = $ssh->channel();
1106   $ssh->die_with_error("Unable to establish SSH channel for serial console") unless $chan;
1107 0 $chan->blocking(0);
1108   $chan->pty(1);
1109 0 $chan->ext_data('merge');
1110   $self->{select_read}->add($ssh->sock);
1111 0 return ($ssh, $chan);
1112   }
1113    
1114   my $ssh = $self->{serial};
1115 75 return 0 unless $ssh;
  75  
  75  
  75  
1116 75 my $ssh_socket = $ssh->sock;
  75  
1117 75 return 0 unless $ssh_socket == $fh;
1118 75  
1119 75 if ($write) {
1120 75 bmwqemu::fctwarn 'SSH serial: setup error: socket has been wrongly selected for writing';
1121 75 return 1;
1122 75 }
1123    
1124   # read from SSH channel (receiving extended data channel as well via `$chan->ext_data('merge')`)
1125   my $chan = $self->{serial_chan};
1126 75 my $buffer;
1127 50 while (defined(my $bytes_read = $chan->read($buffer, 4096))) {
  150  
1128 50 return 1 unless $bytes_read > 0;
1129 50 print $buffer;
1130   open(my $serial, '>>', $self->{serialfile});
1131 35 print $serial $buffer;
1132 30 close($serial);
1133 30 }
1134 30  
1135   my ($error_code, $error_name, $error_string) = $ssh->error;
1136 5 return 1 if $error_code == LIBSSH2_ERROR_EAGAIN;
1137 5  
1138 5 bmwqemu::fctwarn "ssh serial: unable to read: $error_string (error code: $error_code) - closing connection";
1139   $self->stop_ssh_serial();
1140   return 1;
1141   }
1142    
1143   =head2 run_ssh_cmd
1144 45  
1145   $ret = run_ssh_cmd($cmd [, username => ?][, password => ?][,host => ?]);
1146   ($ret, $stdout, $stderr) = run_ssh_cmd($cmd [, username => ?][, password => ?][,host => ?], wantarray => 1);
1147 45  
1148 45 =cut
1149 45 my ($stdout, $stderr) = ('', '');
1150 45 $args{wantarray} //= 0;
1151 45 $args{keep_open} //= 1;
1152    
1153 45 bmwqemu::log_call(cmd => $cmd, %{$self->hide_password(%args)});
1154 45 my ($ssh, $chan) = $self->run_ssh($cmd, %args);
1155   $chan->send_eof;
1156    
1157   while (!$chan->eof) {
1158 0 if (my ($o, $e) = $chan->read2) {
1159   $stdout .= $o;
1160 45 $stderr .= $e;
1161 45 }
1162   }
1163    
1164 0 bmwqemu::diag("[run_ssh_cmd($cmd)] stdout:$/$stdout") if length($stdout);
1165 0 bmwqemu::diag("[run_ssh_cmd($cmd)] stderr:$/$stderr") if length($stderr);
1166 0 my $ret = $chan->exit_status();
1167 0 bmwqemu::diag("[run_ssh_cmd($cmd)] exit-code: $ret");
1168   $ssh->disconnect() unless ($args{keep_open});
1169    
1170 45 return $args{wantarray} ? ($ret, $stdout, $stderr) : $ret;
1171   }
1172 40  
1173 40 bmwqemu::log_call(cmd => $cmd, %{$self->hide_password(%args)});
1174   $args{blocking} //= 1;
1175   my $ssh = $self->new_ssh_connection(%args);
1176   my $chan = $ssh->channel() || $ssh->die_with_error("Unable to create SSH channel for executing \"$cmd\"");
1177   $chan->exec($cmd) || $ssh->die_with_error("Unable to execute \"$cmd\"");
1178   $ssh->blocking($args{blocking});
1179   return ($ssh, $chan);
1180 75 }
  75  
1181    
1182   my $cons = $self->{ssh_connections} // {};
1183 5 for my $key (keys(%{$cons})) {
  5  
  5  
  5  
1184 5 bmwqemu::diag("SSH disconnect $key");
  5  
1185 5 $cons->{$key}->disconnect();
1186   delete($cons->{$key});
1187 5 }
1188 5 }
1189 5  
1190 5 my $ssh = $self->{serial};
1191 5 return undef unless $ssh;
1192 5 bmwqemu::diag('Closing SSH serial connection with ' . $ssh->hostname);
1193 5 $self->{select_read}->remove($ssh->sock);
1194 5 $ssh->disconnect;
1195   $self->{serial_chan} = undef;
1196   return $self->{serial} = undef;
1197 28 }
  28  
  28  
  28  
  28  
1198 28  
1199 28 $args{password} = 'SECRET' if ($args{password});
1200 20 return \%args;
1201 20 }
1202    
1203 15 my $deprecation_message = <<"EOF";
1204 0 DEPRECATED: 'backend::$backend' is unsupported and planned to be
1205 0 removed from os-autoinst eventually. If the backend is still needed please
1206   report an issue on https://github.com/os-autoinst/os-autoinst . This message
1207   can be temporarily turned into a warning by setting the environment variable
1208   'OS_AUTOINST_NO_DEPRECATE_BACKEND_$backend' or the os-autoinst variable
1209 15 'NO_DEPRECATE_BACKEND_$backend'
1210 15 EOF
1211 15 die $deprecation_message unless $bmwqemu::vars{"NO_DEPRECATE_BACKEND_$backend"} || $ENV{"OS_AUTOINST_NO_DEPRECATE_BACKEND_$backend"};
1212 25 log::fctwarn $deprecation_message;
1213 20 }
1214 20  
1215 20 # Send TERM signal to any child process
1216 20 my $ret;
1217   for my $pid (@{$self->{children}}) {
1218   bmwqemu::diag("terminating child $pid");
1219 10 kill('TERM', $pid);
1220 10 for my $i (1 .. 5) {
1221   $ret = waitpid($pid, WNOHANG);
1222 5 bmwqemu::diag "waitpid for $pid returned $ret";
1223 5 last if ($ret == $pid);
1224 5 sleep 1;
1225   }
1226   }
1227   }
1228    
1229   die "Can't spawn child without code" unless ref($code) eq "CODE";
1230    
1231   my $pid = fork();
1232   die "fork failed" unless defined($pid);
1233 25  
  25  
  25  
  25  
  25  
1234 25 if ($pid == 0) {
1235 25 $code->();
1236 25 }
1237   else {
1238 25 push @{$self->{children}}, $pid;
  25  
1239 25 return $pid;
1240 25 }
1241    
1242 25 }
1243 25  
1244 25 1;