File Coverage

backend/svirt.pm
Criterion Covered Total %
statement 230 236 97.8
total 230 236 97.8


line stmt code
1   # Copyright 2009-2013 Bernhard M. Wiedemann
2   # Copyright 2012-2020 SUSE LLC
3   # SPDX-License-Identifier: GPL-2.0-or-later
4    
5   use Mojo::Base 'backend::virt', -signatures;
6 3 use File::Basename;
  3  
  3  
7 3 use IO::Scalar;
  3  
  3  
8 3 use Time::HiRes 'usleep';
  3  
  3  
9 3 use bmwqemu;
  3  
  3  
10 3  
  3  
  3  
11   use constant SERIAL_CONSOLE_DEFAULT_PORT => 0;
12 3 use constant SERIAL_CONSOLE_DEFAULT_DEVICE => 'console';
  3  
  3  
13 3  
  3  
  3  
14   use constant SERIAL_TERMINAL_DEFAULT_PORT => 1;
15 3 use constant SERIAL_TERMINAL_DEFAULT_DEVICE => 'console';
  3  
  3  
16 3  
  3  
  3  
17   use Exporter 'import';
18 3 our @EXPORT_OK = qw(SERIAL_CONSOLE_DEFAULT_PORT SERIAL_CONSOLE_DEFAULT_DEVICE SERIAL_TERMINAL_DEFAULT_PORT SERIAL_TERMINAL_DEFAULT_DEVICE);
  3  
  3  
19    
20   # this is a fake backend to some extend. We don't start VMs, but provide ssh access
21   # to a libvirt running host (KVM for System Z in mind)
22    
23   use constant SERIAL_TERMINAL_LOG_PATH => 'serial_terminal.txt';
24 3  
  3  
  3  
25    
26 55 my $self = $class->SUPER::new;
  55  
  55  
27 33 defined $bmwqemu::vars{WORKER_HOSTNAME} or die 'Need variable WORKER_HOSTNAME';
  33  
  33  
28 16  
  16  
  16  
29   return $self;
30 6 }
  6  
  6  
31 6  
32 6 # we don't do anything actually
33   my $vars = \%bmwqemu::vars;
34 6 my $n = $vars->{NUMDISKS} // 1;
35   $vars->{NUMDISKS} //= defined($vars->{RAIDLEVEL}) ? 4 : $n;
36   $self->truncate_serial_file;
37   my $ssh = $testapi::distri->add_console(
38 4 'svirt',
  4  
  4  
39 4 'ssh-virtsh',
40 4 {
41 4 hostname => $bmwqemu::vars{VIRSH_HOSTNAME} || die('Need variables VIRSH_HOSTNAME'),
42 4 username => $bmwqemu::vars{VIRSH_USERNAME},
43   password => $bmwqemu::vars{VIRSH_PASSWORD},
44   });
45    
46   $ssh->backend($self);
47    
48   bmwqemu::save_vars(); # update variables
49   return {};
50 4 }
51    
52 4 $self->stop_serial_grab;
53    
54 4 unless ($bmwqemu::vars{SVIRT_KEEP_VM_RUNNING}) {
55 4 my $vmname = $self->console('svirt')->name;
56   bmwqemu::diag "Destroying $vmname virtual machine";
57   if (_is_hyperv) {
58 3 my $ps = 'powershell -Command';
  3  
  3  
59 3 $self->run_ssh_cmd("$ps Stop-VM -Force -VMName $vmname -TurnOff");
60   $self->run_ssh_cmd(qq($ps "\$ProgressPreference='SilentlyContinue'; Remove-VM -Force -VMName $vmname"));
61 3 }
62 3 else {
63 3 my $virsh = 'virsh';
64 3 $virsh .= ' ' . $bmwqemu::vars{VMWARE_REMOTE_VMM} if $bmwqemu::vars{VMWARE_REMOTE_VMM};
65 1 $self->run_ssh_cmd("$virsh destroy $vmname");
66 1 $self->run_ssh_cmd("$virsh undefine --snapshots-metadata $vmname");
67 1 }
68   }
69    
70 2 # TODO: stream serial_terminal.txt with scp on the fly instead
71 2 if ($self->{need_delete_log}) {
72 2 $self->scp_get($self->serial_terminal_log_file(), SERIAL_TERMINAL_LOG_PATH);
73 2 $self->delete_log();
74   }
75    
76   return {};
77   }
78 3  
79 2 # Log stdout and stderr and return them in a list (comped).
80 2 bmwqemu::log_call(@_);
81    
82   my %credentials = $self->get_ssh_credentials(_is_hyperv ? 'hyperv' : 'default');
83 3 my $ssh = $self->new_ssh_connection(%credentials);
84    
85   open(my $fh, '>', $dest) or die "Could not open file '$dest' $!";
86   bmwqemu::diag("SCP file: '$src' => '$dest'");
87 2 my $output = IO::Scalar->new;
  2  
  2  
  2  
  2  
88 2 $ssh->scp_get($src, $output) or die "SCP failed";
89   print $fh $output;
90 2 close $fh;
91 2 $ssh->disconnect();
92   }
93 2  
94 2 $args->{function} eq 'snapshots' && _vmm_family =~ qr/kvm|hyperv|vmware/ ? {ret => 1} : undef;
95 2 }
96 2  
97 2 my $vmname = $self->console('svirt')->name;
98 2 my $rsp;
99 2 if (_is_hyperv) {
100   $rsp = $self->run_ssh_cmd("powershell -Command \"if (\$(Get-VM -VMName $vmname \| Where-Object {\$_.state -eq 'Off'})) { exit 1 } else { exit 0 }\"");
101   }
102 3 else {
  3  
  3  
  3  
103 3 my $libvirt_connector = $bmwqemu::vars{VMWARE_REMOTE_VMM} // '';
104   $rsp = $self->run_ssh_cmd("! virsh $libvirt_connector dominfo $vmname | grep -w 'shut off'");
105   }
106 3 return $rsp;
  3  
  3  
107 3 }
108 3  
109 3 my $snapname = $args->{name};
110 1 my $vmname = $self->console('svirt')->name;
111   my $rsp;
112   if (_is_hyperv) {
113 2 my $ps = 'powershell -Command';
114 2 $self->run_ssh_cmd("$ps Remove-VMSnapshot -VMName $vmname -Name $snapname");
115   $rsp = $self->run_ssh_cmd(qq($ps "\$ProgressPreference='SilentlyContinue'; Checkpoint-VM -VMName $vmname -SnapshotName $snapname"));
116 3 }
117   else {
118   my $libvirt_connector = $bmwqemu::vars{VMWARE_REMOTE_VMM} // '';
119 3 $self->run_ssh_cmd("virsh $libvirt_connector snapshot-delete $vmname $snapname");
  3  
  3  
  3  
120 3 $rsp = $self->run_ssh_cmd("virsh $libvirt_connector snapshot-create-as $vmname $snapname");
121 3 }
122 3 bmwqemu::diag "SAVE VM $vmname as $snapname snapshot, return code=$rsp";
123 3 $self->die if $rsp;
124 1 return;
125 1 }
126 1  
127   my $snapname = $args->{name};
128   my $vmname = $self->console('svirt')->name;
129 2 my $rsp;
130 2 my $post_load_snapshot_command = '';
131 2 if (_is_hyperv) {
132   my $ps = 'powershell -Command';
133 3 $rsp = $self->run_ssh_cmd(qq($ps "\$ProgressPreference='SilentlyContinue'; Restore-VMSnapshot -VMName $vmname -Name $snapname -Confirm:\$false"));
134 3 $self->run_ssh_cmd("mv -v xfreerdp_${vmname}_stop xfreerdp_${vmname}_stop.bkp", $self->get_ssh_credentials('hyperv'));
135 3  
136   for my $i (1 .. 5) {
137   # Because of FreeRDP issue https://github.com/FreeRDP/FreeRDP/issues/3876,
138 3 # we can't connect too "early". Let's have a nap for a while.
  3  
  3  
  3  
139 3 sleep 10;
140 3 last
141 3 unless $self->run_ssh_cmd(
142 3 "pgrep --full --list-full xfreerdp.*\$(cat xfreerdp_${vmname}_stop.bkp)",
143 3 $self->get_ssh_credentials('hyperv'));
144 1 $self->die("xfreerdp did not start") if ($i eq 5);
145 1 }
146 1 }
147   else {
148 1 my $libvirt_connector = $bmwqemu::vars{VMWARE_REMOTE_VMM} // '';
149   $rsp = $self->run_ssh_cmd("virsh $libvirt_connector snapshot-revert $vmname $snapname");
150   $post_load_snapshot_command = 'vmware_fixup' if _is_vmware;
151 5 }
152   bmwqemu::diag "LOAD snapshot $snapname to $vmname, return code=$rsp";
153 5 $self->die if $rsp;
154   return $post_load_snapshot_command;
155   }
156 5  
157   unless ($self->{ssh_credentials}) {
158   $self->{ssh_credentials} = {
159   default => {
160 2 hostname => $bmwqemu::vars{VIRSH_HOSTNAME} || die('Need variable VIRSH_HOSTNAME'),
161 2 username => $bmwqemu::vars{VIRSH_USERNAME} // 'root',
162 2 password => $bmwqemu::vars{VIRSH_PASSWORD} || die('Need variable VIRSH_PASSWORD'),
163   }
164 2 };
165 2 if (_is_hyperv) {
166 2 # Credentials for hyperv intermediary host
167   $self->{ssh_credentials}->{hyperv} = {
168   hostname => $bmwqemu::vars{VIRSH_GUEST} || die('Need variable VIRSH_GUEST'),
169 14 password => $bmwqemu::vars{VIRSH_GUEST_PASSWORD} || die('Need variable VIRSH_GUEST_PASSWORD'),
  14  
  14  
  14  
170 14 username => 'root',
171   };
172   }
173   }
174   die("Missing SSH credentials domain '$domain'") unless ($self->{ssh_credentials}->{$domain});
175 5 return %{$self->{ssh_credentials}->{$domain}};
176   }
177    
178 5 bmwqemu::log_call(name => $name);
179    
180   my %credentials = $self->get_ssh_credentials(_is_hyperv ? 'hyperv' : 'default');
181   my ($ssh, $chan) = $self->start_ssh_serial(%credentials);
182 2 my $cmd;
183   if (_is_vmware) {
184   # libvirt esx driver does not support `virsh console', so
185   # we have to connect to VM's serial port via TCP which is
186   # provided by ESXi server.
187 14 $cmd = 'socat - TCP4:' . $bmwqemu::vars{VMWARE_HOST} . ':' . $bmwqemu::vars{VMWARE_SERIAL_PORT} . ',crnl';
188 14 }
  14  
189   elsif (_is_hyperv) {
190   # Hyper-V does not support serial console export via TCP, just
191 3 # windows named pipes (e.g. \\.\pipe\mypipe). Such a named pipe
  3  
  3  
  3  
192 3 # has to be enabled by a namedpipe-to-TCP on HYPERV_SERVER application.
193   $cmd = 'socat - TCP4:' . $bmwqemu::vars{HYPERV_SERVER} . ':' . $bmwqemu::vars{HYPERV_SERIAL_PORT} . ',crnl';
194 3 }
195 3 else {
196 3 $cmd = 'virsh console ' . $name;
197 3 }
198    
199   bmwqemu::diag('svirt: grabbing serial console');
200   $ssh->blocking(1);
201 1 if (!$chan->exec($cmd)) {
202   bmwqemu::fctwarn('svirt: unable to grab serial console at this point: ' . ($ssh->error // 'unknown SSH error'));
203   }
204   $ssh->blocking(0);
205   }
206    
207 1 =head2 open_serial_console_via_ssh
208    
209   ($ssh, $chan) = open_serial_console_via_ssh($name[, port => ''][, devname => ''])
210 1  
211   Opens SSH connection to grab serial terminal log
212   (using consoles::serial_screen, saved into serial_terminal.txt).
213 3  
214 3 This method is not supposed to be called twice for test run due logging
215 3 into file.
216 1  
217   C<$args{port}> used non-default port
218 3 C<$args{devname}> used device name
219   =cut
220   bmwqemu::log_call(name => $name, %args);
221   my ($chan, $cmd, $cmd_full, $ret, $ssh, $stderr, $stdout);
222   my $port = $args{port} // '';
223   my $devname = $args{devname} // '';
224   my $marker = "CONSOLE_EXIT_" . $bmwqemu::vars{JOBTOKEN} or die 'Need variable JOBTOKEN' . ":";
225   my $log = $self->serial_terminal_log_file();
226   my $max_tries = 10;
227    
228   if (_is_vmware) {
229   # libvirt esx driver does not support `virsh console', so
230   # we have to connect to VM's serial port via TCP which is
231   # provided by ESXi server.
232   $cmd = 'socat - TCP4:' . $bmwqemu::vars{VMWARE_HOST} . ':' . $port . ',crnl';
233   }
234 11 elsif (_is_hyperv) {
  11  
  11  
  11  
  11  
235 11 # Hyper-V does not support serial console export via TCP, just
236 11 # windows named pipes (e.g. \\.\pipe\mypipe). Such a named pipe
237 11 # has to be enabled by a namedpipe-to-TCP on HYPERV_SERVER application.
238 11 $cmd = 'socat - TCP4:' . $bmwqemu::vars{HYPERV_SERVER} . ':' . $port . ',crnl';
239 11 }
240 11 else {
241 11 $cmd = "virsh console $name $devname$port";
242   }
243 11  
244   $cmd_full = "script -f $log -c '$cmd; echo \"$marker \$?\"'";
245   bmwqemu::diag("Starting SSH connection to connect to libvirt domain '$name' (cmd: '$cmd'), full cmd: '$cmd_full'");
246    
247 2 ($ssh, $chan) = $self->run_ssh($cmd_full, blocking => 0);
248   usleep(500) while ($self->run_ssh_cmd("test -e $log") != 0 && $max_tries-- > 0);
249   $self->die("Command 'script' did not create logfile $log") if ($max_tries < 1);
250   $self->{need_delete_log} = 1;
251    
252   $ret = $self->run_ssh_cmd("grep -q '^$marker' $log");
253 5 if (!$ret) {
254   (undef, $stdout, undef) = $self->run_ssh_cmd("cat $log", wantarray => 1);
255   $self->die("problem with virsh: cmd: '$cmd', output of script wrapper: '$stdout')");
256 4 }
257    
258   return ($ssh, $chan);
259 11 }
260 11  
261   my $log = $self->serial_terminal_log_file();
262 11 $self->run_ssh_cmd("[ -f '$log' ] && rm -v $log");
263 11 }
264 11  
265 10 # Intent to use CORE::GLOBAL::die, that does not have $self.
266   if ($self->{need_delete_log}) {
267 10 bmwqemu::fctwarn("error, cleanup logs before die");
268 10 $self->delete_log();
269 1 }
270 1 die $err;
271   }
272    
273 9 defined $bmwqemu::vars{JOBTOKEN} || CORE::die 'Need variable JOBTOKEN';
274   return '/tmp/' . SERIAL_TERMINAL_LOG_PATH . '.' . $bmwqemu::vars{JOBTOKEN};
275   }
276 4  
  4  
  4  
277 4  
278 4 $self->stop_ssh_serial;
279   return;
280   }
281    
282 3 # We encountered a sporadic error when type into the here-document in the
  3  
  3  
  3  
283 3 # distribution::script_output() function (poo#60566). This issue was only
284 2 # seen by svirt backends from VMM_FAMILY hyperv or vmware.
285 2 #
286   # With wait_still_screen we actually do a sleep, but the given duration is
287 1 # the minimum and will be extended till there is no change on the screen.
288   # by comparing the screen and checking that nothing else will write on it.
289   # So if the here-document input is really slow, we hope the wait_still_screen
290 17 # takes even longer.
  17  
  17  
291 17 _vmm_family() =~ qr/^(hyperv|vmware)$/ ? 1 : 0;
292 17 }
293    
294   1;