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; |