File Coverage

backend/qemu.pm
Criterion Covered Total %
statement 487 790 61.6
total 487 790 61.6


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   use Mojo::Base 'backend::virt', -signatures;
6 14 use autodie ':all';
  14  
  14  
7 14 use File::Basename 'dirname';
  14  
  14  
8 14 use File::Path 'mkpath';
  14  
  14  
9 14 use File::Which;
  14  
  14  
10 14 use Time::HiRes qw(sleep gettimeofday);
  14  
  14  
11 14 use IO::Socket::UNIX 'SOCK_STREAM';
  14  
  14  
12 14 use IO::Handle;
  14  
  14  
13 14 use POSIX qw(strftime :sys_wait_h mkfifo);
  14  
  14  
14 14 use Mojo::File 'path';
  14  
  14  
15 14 use Mojo::JSON;
  14  
  14  
16 14 use Carp;
  14  
  14  
17 14 use Fcntl;
  14  
  14  
18 14 use Net::DBus;
  14  
  14  
19 14 use bmwqemu qw(diag);
  14  
  14  
20 14 require IPC::System::Simple;
  14  
  14  
21   use osutils qw(find_bin qv run_diag runcmd);
22 14 use List::Util qw(first max);
  14  
  14  
23 14 use Data::Dumper;
  14  
  14  
24 14 use Mojo::IOLoop::ReadWriteProcess::Session 'session';
  14  
  14  
25 14 use OpenQA::Qemu::Proc;
  14  
  14  
26 14  
  14  
  14  
27   # The maximum value of the system's native signed integer. Which will probably
28   # be 2^64 - 1.
29   use constant LONG_MAX => (~0 >> 1);
30 14  
  14  
  14  
31   # Folder where RAM/VM state files live. Note that the blockdevice snapshots go
32   # in a separate dir.
33   use constant VM_SNAPSHOTS_DIR => 'vm-snapshots';
34 14  
  14  
  14  
35   my $self = $class->SUPER::new;
36 23 $self->{pidfilename} = 'qemu.pid';
  23  
  23  
37 23 $self->{proc} = OpenQA::Qemu::Proc->new();
38 23 $self->{proc}->_process->pidfile($self->{pidfilename});
39 23 return $self;
40 23 }
41 23  
42   # baseclass virt method overwrite
43    
44    
45   execute => 'human-monitor-command',
46 0 arguments => {'command-line' => $cmdline}}
  0  
  0  
  0  
47   }
48 0  
  0  
  0  
49 0 # poo#66667: Since qemu 4.2, -audiodev is required to record sounds, as we need an audiodev id for 'wavcapture'
50   return (version->declare($self->{qemu_version}) ge version->declare(4.2));
51   }
52    
53    
54 18 # poo#66667: an audiodev id is required by wavcapture when audiodev is used
  18  
  18  
55 18 my $audiodev_id = $self->requires_audiodev ? 'snd0' : '';
56   $self->handle_qmp_command(_wrap_hmc("wavcapture $args->{filename} $audiodev_id 44100 16 1"));
57   }
58 0  
  0  
  0  
  0  
59   $self->handle_qmp_command(_wrap_hmc("stopcapture 0"));
60   }
61 0  
62 0 # parameters: acpi, reset, (on), off
63   my %action_to_cmd = (
64   acpi => 'system_powerdown',
65 0 reset => 'system_reset',
  0  
  0  
  0  
66 0 off => 'quit',
67   );
68   $self->handle_qmp_command({execute => $action_to_cmd{$args->{action}}});
69   }
70 2  
  2  
  2  
  2  
71 2 die "'device' parameter is not supported anymore, use 'id'" if defined $args->{device};
72   my $id = $args->{id} // 'cd0-device';
73   $self->handle_qmp_command({execute => 'eject', arguments => {
74   id => $id,
75   force => (!defined $args->{force} || $args->{force} ? Mojo::JSON->true : Mojo::JSON->false)
76 2 }});
77   $self->handle_qmp_command({execute => 'blockdev-remove-medium', arguments => {id => $id}});
78   }
79 2  
  2  
  2  
  2  
80 2  
81 2 my $stat = path("/proc/" . $self->{proc}->_process->pid . "/stat")->slurp;
82   my @a = split(" ", $stat);
83   return [@a[13, 14]];
84 2 }
85    
86 2 $self->start_qemu();
87   return {};
88   }
89 1  
  1  
  1  
  1  
  1  
90   $self->{proc}->stop_qemu;
91 0 delete_virtio_console_fifo();
  0  
  0  
92 0 $self->_stop_children_processes;
93 0 }
94 0  
95   # we intentionally do not persist the dbus connection to avoid
96   # queueing up signals we are not interested in handling:
97 8 # https://progress.opensuse.org/issues/90872
  8  
  8  
98 8 my $bus = Net::DBus->system(private => 1);
99 3 my $bus_service = $bus->get_service("org.opensuse.os_autoinst.switch");
100   my $bus_object = $bus_service->get_object("/switch", "org.opensuse.os_autoinst.switch");
101   my @result = $bus_object->$fn(@args);
102 4 $bus->get_connection->disconnect;
  4  
  4  
103 4 return @result;
104 4 }
105 4  
106   my ($rt, $message);
107   eval {
108 2 # do not die on unconfigured service
  2  
  2  
  2  
  2  
109   local $SIG{__DIE__};
110   ($rt, $message) = $self->_dbus_do_call($fn, @args);
111   chomp $message;
112 2 die $message unless $rt == 0;
113 0 };
114 0 my $error = $@;
115 0 if ($error) {
116 0 my $msg = "Open vSwitch command '$fn' with arguments '@args' failed: $error";
117 0 die "$msg\n" unless $bmwqemu::vars{QEMU_NON_FATAL_DBUS_CALL};
118   bmwqemu::diag $msg;
119   }
120 3 return ($rt, $message, ($error) x !!($error));
  3  
  3  
  3  
  3  
121 3 }
122 3  
123    
124 3 my $proc = $self->{proc};
125 3 if ($bmwqemu::vars{QEMU_WAIT_FINISH}) {
126 1 # wait until QEMU finishes on its own; used in t/18-qemu-options.t
127 1 if (my $qemu_pid = $proc->qemu_pid) {
128   waitpid $qemu_pid, 0;
129 3 }
130 3 }
131 3 $proc->save_state;
132 3 $self->stop_qemu;
133 1 }
134    
135 1 my $vars = \%bmwqemu::vars;
136    
137   return unless $args->{function} eq 'snapshots';
138 4 return if $vars->{QEMU_DISABLE_SNAPSHOTS};
  4  
  4  
139   my @models = ($vars->{HDDMODEL}, map { $vars->{"HDDMODEL_$_"} } (1 .. $vars->{NUMDISKS}));
140 4 my $nvme = first { ($_ // '') eq 'nvme' } @models;
141 4 return {ret => 1} unless $nvme;
142   bmwqemu::fctwarn('NVMe drives can not be migrated which is required for snapshotting')
143 1 unless $args->{no_warn};
144 1 return undef;
145   }
146    
147 4  
148 4 mkpath(dirname($path));
149   my $fd = POSIX::open($path, POSIX::O_CREAT() | POSIX::O_RDWR()) or die "Failed to open $path: $!";
150   my $rsp = $self->handle_qmp_command(
151 21 {execute => 'getfd', arguments => {fdname => $fdname}},
  21  
  21  
  21  
152 21 send_fd => $fd,
153   fatal => 1
154 21 );
155 21 POSIX::close($fd);
156 16 }
  16  
157 16  
  32  
158 16  
159   $self->handle_qmp_command(
160 0 {
161 0 execute => 'migrate-set-capabilities',
162   arguments => {
163   capabilities => [
164 0 {
  0  
  0  
  0  
  0  
165   capability => $name,
166 0 state => $state ? Mojo::JSON::true : Mojo::JSON::false,
167 0 }]}
168 0 },
169   fatal => 1
170   );
171   }
172    
173 0  
174   my $rsp = $self->handle_qmp_command({execute => 'query-status'}, fatal => 1);
175   my $i = 0;
176 0 while (($rsp->{return}->{status} // '') =~ $status) {
  0  
  0  
  0  
  0  
177   $i += 1;
178 0 die "$fail_msg; QEMU status is $rsp->{return}->{status}" if $i > $timeout;
179   sleep(1);
180   $rsp = $self->handle_qmp_command({execute => 'query-status'}, fatal => 1);
181   }
182   }
183    
184   my $migration_starttime = gettimeofday;
185   my $execution_time = gettimeofday;
186   # We need to wait for qemu, since it will not honor timeouts
187   # 240 seconds should be ok for 4GB
188   my $max_execution_time = $bmwqemu::vars{QEMU_MAX_MIGRATION_TIME} // 240;
189   my $rsp;
190    
191   do {
192 0 # We want to wait a decent amount of time, a file of 1GB will be
  0  
  0  
  0  
  0  
  0  
193   # migrated in about 40secs with an ssd drive. and no heavy load.
194 0 sleep 0.5;
195 0  
196 0 $execution_time = gettimeofday - $migration_starttime;
197 0 $rsp = $self->handle_qmp_command({execute => 'query-migrate'}, fatal => 1);
198 0 die 'Migrate to file failed' if $rsp->{return}->{status} eq 'failed';
199 0  
200 0 diag "Migrating total bytes: \t" . $rsp->{return}->{ram}->{total};
201   diag "Migrating remaining bytes: \t" . $rsp->{return}->{ram}->{remaining};
202    
203   if ($execution_time > $max_execution_time) {
204 0 # migrate_cancel returns an empty hash, so there is no need to check.
  0  
  0  
205 0 $rsp = $self->handle_qmp_command({execute => 'migrate_cancel'});
206 0 die "Migrate to file failed, it has been running for more than $max_execution_time seconds";
207   }
208    
209 0 } until ($rsp->{return}->{status} eq 'completed');
210 0  
211   # Avoid race condition where QEMU allows us to start the VM (set state to
212   # running) then tries to transition to post-migarte which fails
213   $self->_wait_while_status_is(qr/paused|finish-migrate/,
214   $max_execution_time - $execution_time,
215 0 'Timed out waiting for migration to finalize');
216   }
217 0  
218 0 my $fdname = 'dumpfd';
219 0 my $compress_level = $args{compress_level} || 0;
220   my $compress_threads = $args{compress_threads} // 2;
221 0 my $filename = $args{filename};
222 0 my $max_bandwidth = $args{max_bandwidth} // LONG_MAX;
223    
224 0 # Internally compressed dumps can't be opened by crash. They need to be
225   # fed back into QEMU as an incoming migration.
226 0 $self->set_migrate_capability('compress', 1) if $compress_level > 0;
227 0 $self->set_migrate_capability('events', 1);
228    
229   $self->handle_qmp_command(
230 0 {
231   execute => 'migrate-set-parameters',
232   arguments => {
233   # This is ignored if the compress capability is not set
234 0 'compress-level' => $compress_level + 0,
235   'compress-threads' => $compress_threads + 0,
236   # Ensure slow dump times are not due to a transfer rate cap
237   'max-bandwidth' => $max_bandwidth + 0,
238   }
239 0 },
  0  
  0  
  0  
240 0 fatal => 1
241 0 );
242 0  
243 0 $self->open_file_and_send_fd_to_qemu($filename, $fdname);
244 0  
245   # QEMU will freeze the VM when the RAM migration reaches a low water
246   # mark. However it is easier for QEMU if the VM is already frozen.
247   $self->freeze_vm();
248 0 # migrate consumes the file descriptor, so we do not need to call closefd
249 0 $self->handle_qmp_command(
250   {
251 0 execute => 'migrate',
252   arguments => {uri => "fd:$fdname"}
253   },
254   fatal => 1
255   );
256    
257   return $self->_wait_for_migrate();
258   }
259    
260   $self->handle_qmp_command({execute => 'set_link', arguments => {
261   name => $args->{network_link_name} // "qanet0",
262   up => (!defined $args->{network_enabled} || $args->{network_enabled} ? Mojo::JSON->true : Mojo::JSON->false)
263   }}, fatal => 1);
264   }
265 0  
266   my $fdname = 'dumpfd';
267   my $vars = \%bmwqemu::vars;
268   my $compress_method = $vars->{QEMU_DUMP_COMPRESS_METHOD} || 'xz';
269 0 my $compress_level = $vars->{QEMU_COMPRESS_LEVEL} || 6;
270   my $compress_threads = $vars->{QEMU_COMPRESS_THREADS} || $vars->{QEMUCPUS} || 2;
271 0 my $filename = $args->{filename} . '-vm-memory-dump';
272    
273   my $rsp = $self->handle_qmp_command({execute => 'query-status'}, fatal => 1);
274   bmwqemu::diag("Migrating the machine (Current VM state is $rsp->{return}->{status})");
275   my $was_running = $rsp->{return}->{status} eq 'running';
276    
277   mkpath('ulogs');
278   $self->_migrate_to_file(compress_level => $compress_method eq 'internal' ? $compress_level : 0,
279 0 compress_threads => $compress_threads,
280   filename => "ulogs/$filename",
281   max_bandwidth => $vars->{QEMU_MAX_BANDWIDTH});
282 2  
  2  
  2  
  2  
283   diag 'Memory dump completed';
284    
285 2 $self->cont_vm() if $was_running;
286    
287   return undef unless $compress_method;
288   if ($compress_method eq 'xz') {
289 0 if (defined which('xz')) {
  0  
  0  
  0  
290 0 runcmd('xz', '--no-warn', '-T', $compress_threads, "-v$compress_level", "ulogs/$filename");
291 0 }
292 0 else {
293 0 bmwqemu::fctwarn('xz not found; falling back to bzip2');
294 0 $compress_method = 'bzip2';
295 0 }
296   }
297 0 if ($compress_method eq 'bzip2') {
298 0 runcmd('bzip2', "-v$compress_level", "ulogs/$filename");
299 0 }
300   }
301 0  
302   diag "Attempting to extract disk #%d.", $args->{disk};
303   $self->do_extract_assets(
304   {
305 0 hdd_num => $args->{disk},
306   name => sprintf("%s-%d-vm_disk_file.qcow2", $args->{filename}, $args->{disk}),
307 0 dir => "ulogs",
308   format => "qcow2"
309 0 });
310    
311 0 diag "Successfully extracted disk #%d", $args->{disk};
312 0 return;
313 0 }
314 0  
315   my $vars = \%bmwqemu::vars;
316   return unless $vars->{QEMU_BALLOON_TARGET};
317 0 my $target_bytes = $vars->{QEMU_BALLOON_TARGET} * 1048576;
318 0 $self->handle_qmp_command({execute => 'balloon', arguments => {value => $target_bytes}}, fatal => 1);
319   my $rsp = $self->handle_qmp_command({execute => 'query-balloon'}, fatal => 1);
320   my $prev_actual = $rsp->{return}->{actual};
321 0 my $i = 0;
322 0 my $timeout = $vars->{QEMU_BALLOON_TIMEOUT} // 5;
323   while ($i < $timeout) {
324   $i += 1;
325   sleep(1);
326 0 $rsp = $self->handle_qmp_command({execute => 'query-balloon'}, fatal => 1);
  0  
  0  
  0  
327 0 last if $prev_actual <= $rsp->{return}->{actual};
328   }
329   }
330    
331 0 my $vars = \%bmwqemu::vars;
332   return unless $vars->{QEMU_BALLOON_TARGET};
333   my $ram_bytes = $vars->{QEMURAM} * 1048576;
334   $self->handle_qmp_command({execute => 'balloon', arguments => {value => $ram_bytes}}, fatal => 1);
335   }
336 0  
337 0 my $vars = \%bmwqemu::vars;
338   my $vmname = $args->{name};
339   my $bdc = $self->{proc}->blockdev_conf;
340 0  
  0  
  0  
341 0 my $rsp = $self->handle_qmp_command({execute => 'query-status'}, fatal => 1);
342 0 bmwqemu::diag("Saving snapshot (Current VM state is $rsp->{return}->{status})");
343 0 my $was_running = $rsp->{return}->{status} eq 'running';
344 0 if ($was_running) {
345 0 $self->inflate_balloon();
346 0 $self->freeze_vm();
347 0 }
348 0  
349 0 $self->save_console_snapshots($vmname);
350 0  
351 0 my $snapshot = $self->{proc}->snapshot_conf->add_snapshot($vmname);
352 0 $bdc->for_each_drive(sub {
353 0 local $Data::Dumper::Indent = 0;
354   local $Data::Dumper::Terse = 1;
355   local $Data::Dumper::Sortkeys = 1;
356   my $drive = shift;
357 0  
  0  
  0  
358 0 my $overlay = $bdc->add_snapshot_to_drive($drive, $snapshot);
359 0 my $req = {execute => 'blockdev-snapshot-sync',
360 0 arguments => {'node-name' => $overlay->backing_file->node_name,
361 0 'snapshot-node-name' => $overlay->node_name,
362   'snapshot-file' => $overlay->file,
363   format => $overlay->driver}};
364 0 $rsp = $self->handle_qmp_command($req);
  0  
  0  
  0  
365 0  
366 0 # Assumes errors are caused by pflash drives using an autogenerated
367 0 # blockdev node-name. Try again using the device id instead.
368   if ($rsp->{error}) {
369 0 diag('blockdev-snapshot-sync(' . Dumper($req) . ') -> ' . Dumper($rsp));
370 0 delete($req->{arguments}->{'node-name'});
371 0 $req->{arguments}->{device} = $overlay->backing_file->node_name;
372 0 $rsp = $self->handle_qmp_command($req);
373 0 }
374 0  
375   diag('blockdev-snapshot-sync(' . Dumper($req) . ') -> ' . Dumper($rsp));
376   });
377 0  
378   $self->_migrate_to_file(
379 0 filename => path(VM_SNAPSHOTS_DIR, $snapshot->name),
380   compress_level => $vars->{QEMU_COMPRESS_LEVEL} || 6,
381 0 compress_threads => $vars->{QEMU_COMPRESS_THREADS} // $vars->{QEMUCPUS},
382 0 max_bandwidth => $vars->{QEMU_MAX_BANDWIDTH});
383 0 diag('Snapshot complete');
384 0  
385   if ($was_running) {
386 0 $self->cont_vm();
387 0 $self->deflate_balloon();
388   }
389   return;
390   }
391    
392 0 my $vmname = $args->{name};
393    
394   my $rsp = $self->handle_qmp_command({execute => 'query-status'}, fatal => 1);
395   bmwqemu::diag("Loading snapshot (Current VM state is $rsp->{return}->{status})");
396 0 my $was_running = $rsp->{return}->{status} eq 'running';
397 0 $self->freeze_vm() if $was_running;
398 0  
399 0 $self->disable_consoles();
400 0  
401   # NOTE: This still needs to be handled better
402   # Between restarts we do not rewire network switches
403 0 $self->{stop_only_qemu} = 1;
404 0 $self->close_pipes();
405   $self->{stop_only_qemu} = 0;
406    
407   my $snapshot = $self->{proc}->revert_to_snapshot($vmname);
408    
409   create_virtio_console_fifo();
410 0 my $qemu_pipe = $self->{qemupipe} = $self->{proc}->exec_qemu();
411 0 $self->{qmpsocket} = $self->{proc}->connect_qmp();
412   my $init = myjsonrpc::read_json($self->{qmpsocket});
413 0 my $hash = $self->handle_qmp_command({execute => 'qmp_capabilities'});
414 0 $self->{select_read}->add($qemu_pipe, 'qemu::load_snapshot::qemu_pipe');
415 0 $self->{select_write}->add($qemu_pipe, 'qemu::load_snapshot::qemu_pipe');
416    
417 0 # Ideally we want to send a file descriptor to QEMU, but it doesn't seem
418   # to work for incoming migrations, so we are forced to use exec:cat instead.
419   #
420 0 # my $fdname = 'incoming';
  0  
  0  
  0  
421 0 # $self->open_file_and_send_fd_to_qemu(VM_SNAPSHOTS_DIR . '/' . $snapshot->name,
422   # $fdname);
423 0 $self->set_migrate_capability('compress', 1);
424 0 $self->set_migrate_capability('events', 1);
425 0 $rsp = $self->handle_qmp_command({execute => 'migrate-incoming',
426 0 arguments => {uri => 'exec:cat ' . VM_SNAPSHOTS_DIR . '/' . $snapshot->name}},
427   #arguments => { uri => "fd:$fdname" }},
428 0 fatal => 1);
429    
430   $self->load_console_snapshots($vmname);
431    
432 0 # query-migrate does not seem to work for an incoming migration
433 0 $self->_wait_while_status_is(qr/migrate/, 300, 'Timed out while loading snapshot');
434 0  
435   $self->reenable_consoles();
436 0 $self->select_console({testapi_console => 'sut'});
437   diag('Restored snapshot');
438 0 $self->cont_vm();
439 0 $self->deflate_balloon();
440 0 }
441 0  
442 0 my $name = $args->{name};
443 0 my $img_dir = $args->{dir};
444 0 my $hdd_num = $args->{hdd_num} - 1;
445   my $pattern = $args->{pflash_vars} ? qr/^pflash-vars$/ : qr/^hd$hdd_num$/;
446   $self->{proc}->load_state() unless $self->{proc}->has_state();
447   mkpath($img_dir);
448   bmwqemu::fctinfo("Extracting $pattern");
449   my $qemu_compress_qcow = $bmwqemu::vars{QEMU_COMPRESS_QCOW2} // 1;
450   my $res = $self->{proc}->export_blockdev_images($pattern, $img_dir, $name, $qemu_compress_qcow);
451   die "Expected one drive to be exported, not $res" if $res != 1;
452 0 }
453 0  
454 0 # baseclass virt method overwrite end
455    
456    
457   return () unless $bmwqemu::vars{VIRTIO_CONSOLE};
458   return map { 'virtio_console' . ($_ || '') } (0 .. ($bmwqemu::vars{VIRTIO_CONSOLE_NUM} // 1));
459 0 }
460    
461    
462 0 return bmwqemu::fctwarn("Fifo pipe '$name' already exists!") if -e $name;
463   mkfifo($name, 0666) or bmwqemu::fctwarn("Failed to create pipe $name: $!");
464 0 }
465 0  
466 0  
467 0  
468 0 my $vars = \%bmwqemu::vars;
469   $vars->{QEMUVGA} ||= "std";
470   $vars->{QEMUMACHINE} //= "usb=off";
471 2 sp('g', '1024x768');
  2  
  2  
  2  
472 2 # newer qemu needs safe cache capability level quirk settings
473 2 # https://progress.opensuse.org/issues/75259
474 2 my $caps = ',cap-cfpc=broken,cap-sbbc=broken,cap-ibs=broken';
475 2 $vars->{QEMUMACHINE} .= $caps if $vars->{QEMUMACHINE} !~ /$caps/;
476 2 $caps = ',cap-ccf-assist=off';
477 2 $vars->{QEMUMACHINE} .= $caps if $self->{qemu_version} >= version->declare(5) && $vars->{QEMUMACHINE} !~ /$caps/;
478 2 return 1;
479 2 }
480 2  
481 2 my $vars = \%bmwqemu::vars;
482   return unless ($vars->{QEMUTPM});
483   my $tpmn = $vars->{QEMUTPM} eq 'instance' ? $vars->{WORKER_INSTANCE} : $vars->{QEMUTPM};
484   my $vmpath = ($vars->{QEMUTPM_PATH_PREFIX} // '/tmp/mytpm') . $tpmn;
485   mkdir $vmpath unless -d $vmpath;
486 0 my $vmsock = "$vmpath/swtpm-sock";
  0  
  0  
  0  
487   unless (-e $vmsock) {
488 40 # Before create swtpm-sock, we should make sure there is no tpm*.permall file
  40  
489 40 # When tpm version is 2.0, the file is tpm2-00.permall.
490 40 # When tpm version is 1.x, the file is tpm-00.permall.
  80  
491   # See: https://progress.opensuse.org/issues/107155
492   unlink glob "$vmpath/tpm*.permall";
493 22  
  22  
  22  
  44  
494   my @args = ('swtpm', 'socket', '--tpmstate', "dir=$vmpath", '--ctrl', "type=unixio,path=$vmsock", '--log', 'level=20', '-d');
495 72 push @args, '--tpm2' if (($vars->{QEMUTPM_VER} // '2.0') == '2.0');
  72  
  72  
496 72 runcmd(@args);
497 36 }
498   sp('chardev', "socket,id=chrtpm,path=$vmsock");
499   sp('tpmdev', 'emulator,id=tpm0,chardev=chrtpm');
500 18 if ($arch eq 'aarch64') {
  18  
  18  
501   sp('device', 'tpm-tis-device,tpmdev=tpm0');
502 4 }
  4  
  4  
  16  
503   elsif ($arch eq 'ppc64le') {
504 5 sp('device', 'tpm-spapr,tpmdev=tpm0');
  5  
  5  
505 5 sp('device', 'spapr-vscsi,id=scsi9,reg=0x00002000');
506 5 }
507 5 else {
508 5 # x86_64
509   sp('device', 'tpm-tis,tpmdev=tpm0');
510   }
511 5 }
512 5  
513 5 my $vars = \%bmwqemu::vars;
514 5  
515 5 my $basedir = path('raid')->to_abs;
516   my $qemubin = $ENV{QEMU};
517    
518 18 my $qemuimg = find_bin('/usr/bin/', qw(kvm-img qemu-img));
  18  
  18  
  18  
519 18  
520 18 local *sp = sub (@args) { $self->{proc}->static_param(@args); };
521 7 $vars->{VIRTIO_CONSOLE} = 1 if ($vars->{VIRTIO_CONSOLE} // '') ne 0;
522 7  
523 7 unless ($qemubin) {
524 7 if ($vars->{QEMU}) {
525 7 $qemubin = find_bin('/usr/bin/', 'qemu-system-' . $vars->{QEMU});
526   }
527   else {
528   (my $class = $vars->{WORKER_CLASS} || '') =~ s/qemu_/qemu-system\-/g;
529   my @execs = qw(kvm qemu-kvm qemu qemu-system-x86_64 qemu-system-ppc64 qemu-system-aarch64);
530 6 my %allowed = map { $_ => 1 } @execs;
531   for (split(/\s*,\s*/, $class)) {
532 6 if ($allowed{$_}) {
533 6 $qemubin = find_bin('/usr/bin/', $_);
534 6 last;
535   }
536 7 }
537 7 $qemubin = find_bin('/usr/bin/', @execs) unless $qemubin;
538 7 }
539 4 }
540    
541   die "no kvm-img/qemu-img found\n" unless $qemuimg;
542 1 die "no Qemu/KVM found\n" unless $qemubin;
543 1  
544   $self->{proc}->qemu_bin($qemubin);
545   $self->{proc}->qemu_img_bin($qemuimg);
546    
547 2 # Get qemu version
548   my $qemu_version = `$qemubin -version`;
549   $qemu_version =~ /([0-9]+([.][0-9]+)+)/;
550   $qemu_version = $1;
551 18 $self->{qemu_version} = $qemu_version;
  18  
  18  
552 18 bmwqemu::diag "qemu version detected: $self->{qemu_version}";
553    
554 18 $vars->{BIOS} //= $vars->{UEFI_BIOS} if ($vars->{UEFI}); # XXX: compat with old deployment
555 18 $vars->{UEFI} = 1 if $vars->{UEFI_PFLASH};
556    
557 18  
558   if ($vars->{UEFI_PFLASH} && (($vars->{ARCH} // '') eq 'x86_64')) {
559 18 $vars->{BIOS} //= find_ovmf =~ s/-code//r;
  526  
  526  
  526  
  526  
560 18 }
561   elsif ($vars->{UEFI} && (($vars->{ARCH} // '') eq 'x86_64')) {
562 18 $vars->{UEFI_PFLASH_CODE} //= find_ovmf;
563 18 $vars->{UEFI_PFLASH_VARS} //= $vars->{UEFI_PFLASH_CODE} =~ s/code/vars/r;
564 8 die "No UEFI firmware can be found! Please specify UEFI_PFLASH_CODE/UEFI_PFLASH_VARS or BIOS or UEFI_BIOS or install an appropriate package" unless $vars->{UEFI_PFLASH_CODE};
565   }
566   if ($vars->{UEFI_PFLASH} || $vars->{BIOS}) {
567 10 bmwqemu::fctinfo('UEFI_PFLASH and BIOS are deprecated. It is recommended to use UEFI_PFLASH_CODE and UEFI_PFLASH_VARS instead. These variables can be auto-discovered, try to just remove UEFI_PFLASH.');
568 10 }
569 10  
  60  
570 10 foreach my $attribute (qw(BIOS KERNEL INITRD)) {
571 0 if ($vars->{$attribute} && $vars->{$attribute} !~ /^\//) {
572 0 # Non-absolute paths are assumed relative to /usr/share/qemu
573 0 $vars->{$attribute} = '/usr/share/qemu/' . $vars->{$attribute};
574   }
575   if ($vars->{$attribute} && !-e $vars->{$attribute}) {
576 10 die "'$vars->{$attribute}' missing, check $attribute\n";
577   }
578   }
579    
580 18 if ($vars->{LAPTOP}) {
581 18 if ($vars->{LAPTOP} =~ /\/|\.\./) {
582   die "invalid characters in LAPTOP\n";
583 18 }
584 18 $vars->{LAPTOP} = 'dell_e6330' if $vars->{LAPTOP} eq '1';
585   die "no dmi data for '$vars->{LAPTOP}'\n" unless -d "$bmwqemu::scriptdir/dmidata/$vars->{LAPTOP}";
586   }
587 18  
588 18 my $bootfrom = ''; # branch by "disk" or "cdrom", not "c" or "d"
589 18 if ($vars->{BOOT_HDD_IMAGE}) {
590 18 # skip dvd boot menu and boot directly from hdd
591 18 $vars->{BOOTFROM} //= 'c';
592   }
593 18 if (my $bootfrom_var = $vars->{BOOTFROM}) {
594 18 if ($bootfrom_var eq 'd' || $bootfrom_var eq 'cdrom') {
595   $bootfrom = 'cdrom';
596   $vars->{BOOTFROM} = 'd';
597 18 }
598 0 elsif ($bootfrom_var eq 'c' || $bootfrom_var eq 'disk') {
599   $bootfrom = 'disk';
600   $vars->{BOOTFROM} = 'c';
601 0 }
602 0 else {
603 0 die "unknown/unsupported boot order: $bootfrom_var";
604   }
605 18 }
606 0  
607   # disk settings
608   if ($vars->{MULTIPATH}) {
609 18 $vars->{HDDMODEL} ||= "scsi-hd";
610 54 $vars->{PATHCNT} ||= 2;
611   }
612 0 $vars->{NUMDISKS} //= defined($vars->{RAIDLEVEL}) ? 4 : 1;
613   $vars->{HDDSIZEGB} ||= 10;
614 54 $vars->{CDMODEL} ||= "scsi-cd";
615 0 $vars->{HDDMODEL} ||= "virtio-blk";
616    
617   # network settings
618   $vars->{NICMODEL} ||= "virtio-net";
619 18 $vars->{NICTYPE} ||= "user";
620 0 $vars->{NICMAC} ||= "52:54:00:12:34:56" if $vars->{NICTYPE} eq 'user';
621 0 if ($vars->{NICTYPE} eq "vde") {
622   $vars->{VDE_SOCKETDIR} ||= '.';
623 0 # use consistent port. port 1 is slirpvde so add + 2.
624 0 # *2 to have another slot for slirpvde. Default number
625   # of ports is 32 so enough for 14 workers per host.
626   $vars->{VDE_PORT} ||= ($vars->{WORKER_ID} // 0) * 2 + 2;
627 18 }
628 18  
629   # misc
630 0 my $arch_supports_boot_order = $vars->{UEFI} ? 0 : 1; # UEFI/OVMF supports ",bootindex=N", but not "-boot order=X"
631   my $use_usb_kbd;
632 18 my $arch = $vars->{ARCH} // '';
633 0 $arch = 'arm' if ($arch =~ /armv6|armv7/);
634 0 my $custom_video_device = $vars->{QEMU_VIDEO_DEVICE} // 'virtio-gpu-pci';
635 0  
636   if ($arch eq 'aarch64' || $arch eq 'arm') {
637   my $video_device = ($vars->{QEMU_OVERRIDE_VIDEO_DEVICE_AARCH64}) ? 'VGA' : "${custom_video_device},xres=$self->{xres},yres=$self->{yres}";
638 0 sp('device', $video_device);
639 0 $arch_supports_boot_order = 0;
640   $use_usb_kbd = 1;
641   }
642 0 elsif ($vars->{OFW}) {
643   $use_usb_kbd = $self->qemu_params_ofw;
644   }
645   sp('vga', $vars->{QEMUVGA}) if $vars->{QEMUVGA};
646    
647 18 my @nicmac;
648 0 my @nicvlan;
649 0 my @tapdev;
650   my @tapscript;
651 18 my @tapdownscript;
652 18  
653 18 @nicmac = split /\s*,\s*/, $vars->{NICMAC} if $vars->{NICMAC};
654 18 @nicvlan = split /\s*,\s*/, $vars->{NICVLAN} if $vars->{NICVLAN};
655   @tapdev = split /\s*,\s*/, $vars->{TAPDEV} if $vars->{TAPDEV};
656   @tapscript = split /\s*,\s*/, $vars->{TAPSCRIPT} if $vars->{TAPSCRIPT};
657 18 @tapdownscript = split /\s*,\s*/, $vars->{TAPDOWNSCRIPT} if $vars->{TAPDOWNSCRIPT};
658 18  
659 18 my $num_networks = $vars->{OFFLINE_SUT} ? 0 : max(1, scalar @nicmac, scalar @nicvlan, scalar @tapdev);
660 18 for (my $i = 0; $i < $num_networks; $i++) {
661 0 # ensure MAC addresses differ globally
662   # and allow MAC addresses for more than 256 workers (up to 16384)
663   my $workerid = $vars->{WORKER_ID};
664   $nicmac[$i] //= sprintf('52:54:00:12:%02x:%02x', int($workerid / 256) + $i * 64, $workerid % 256);
665 0  
666   # always set proper TAPDEV for os-autoinst when using tap network mode
667   my $instance = ($vars->{WORKER_INSTANCE} || 'manual') eq 'manual' ? 255 : $vars->{WORKER_INSTANCE};
668   # use $instance for tap name so it is predicable, network is still configured staticaly
669 18 $tapdev[$i] = 'tap' . ($instance - 1 + $i * 64) if !defined($tapdev[$i]) || $tapdev[$i] eq 'auto';
670 18 my $vlan = (@nicvlan) ? $nicvlan[-1] : 0;
671 18 $nicvlan[$i] //= $vlan;
672 18 }
673 18 push @tapscript, 'no' until @tapscript >= $num_networks; #no TAPSCRIPT by default
674   push @tapdownscript, 'no' until @tapdownscript >= $num_networks; #no TAPDOWNSCRIPT by default
675 18  
676 4 # put it back to the vars for saving
677 4 $vars->{NICMAC} = join ',', @nicmac;
678 4 $vars->{NICVLAN} = join ',', @nicvlan;
679 4 $vars->{TAPDEV} = join ',', @tapdev if $vars->{NICTYPE} eq "tap";
680   $vars->{TAPSCRIPT} = join ',', @tapscript if $vars->{NICTYPE} eq "tap";
681   $vars->{TAPDOWNSCRIPT} = join ',', @tapdownscript if $vars->{NICTYPE} eq "tap";
682 5  
683   if ($vars->{NICTYPE} eq "vde") {
684 18 my $mgmtsocket = $vars->{VDE_SOCKETDIR} . '/vde.mgmt';
685   my $port = $vars->{VDE_PORT};
686 18 my $vlan = $nicvlan[0];
687   # XXX: no useful return value from those commands
688 18 runcmd('vdecmd', '-s', $mgmtsocket, 'port/remove', $port);
689 18 runcmd('vdecmd', '-s', $mgmtsocket, 'port/create', $port);
690 18 if ($vlan) {
691   runcmd('vdecmd', '-s', $mgmtsocket, 'vlan/create', $vlan);
692 18 runcmd('vdecmd', '-s', $mgmtsocket, 'port/setvlan', $port, $vlan);
693 18 }
694 18  
695 18 if ($vars->{VDE_USE_SLIRP}) {
696 18 my @cmd = ('slirpvde', '--dhcp', '-s', "$vars->{VDE_SOCKETDIR}/vde.ctl", '--port', $port + 1);
697   my $child_pid = $self->_child_process(
698 18 sub {
699 18 $SIG{__DIE__} = undef; # overwrite the default - just exit
700   exec(@cmd);
701   die "failed to exec slirpvde";
702 18 });
703 18 diag join(' ', @cmd) . " started with pid $child_pid";
704    
705   runcmd('vdecmd', '-s', $mgmtsocket, 'port/setvlan', $port + 1, $vlan) if $vlan;
706 18 }
707   }
708 18  
709 18 bmwqemu::save_vars(); # update variables
710 18  
711   mkpath($basedir);
712 18  
713 18 # do not use autodie here, it can fail on tmpfs, xfs, ...
714   run_diag('/usr/bin/chattr', '+C', $basedir);
715    
716 18 bmwqemu::diag('Configuring storage controllers and block devices');
717 18 my $keephdds = $vars->{KEEPHDDS} || $vars->{SKIPTO};
718 18 if ($keephdds) {
719 18 $self->{proc}->load_state();
720 18 } else {
721   $self->{proc}->configure_controllers($vars);
722 18 $self->{proc}->configure_blockdevs($bootfrom, $basedir, $vars);
723 0 $self->{proc}->configure_pflash($vars);
724 0 }
725 0 bmwqemu::diag('Initializing block device images');
726   $self->{proc}->init_blockdev_images();
727 0  
728 0 sp('only-migratable') if $self->can_handle({function => 'snapshots', no_warn => 1});
729 0 sp('chardev', 'ringbuf,id=serial0,logfile=serial0,logappend=on');
730 0 sp('serial', 'chardev:serial0');
731 0  
732   if ($self->requires_audiodev) {
733   my $audiodev = $vars->{QEMU_AUDIODEV} // 'intel-hda';
734 0 my $audiobackend = $vars->{QEMU_AUDIOBACKEND} // 'none';
735 0 sp('audiodev', $audiobackend . ',id=snd0');
736   if ("$audiodev" eq "intel-hda") {
737   sp('device', $audiodev);
738 0 $audiodev = "hda-output";
739 0 }
740 0 sp('device', $audiodev . ',audiodev=snd0');
741 0 }
742 0 else {
743   my $soundhw = $vars->{QEMU_SOUNDHW} // 'hda';
744 0 sp('soundhw', $soundhw);
745   }
746   {
747   # Remove floppy drive device on architectures
748 18 sp('global', 'isa-fdc.fdtypeA=none') unless ($arch eq 'aarch64' || $arch eq 'arm' || $vars->{QEMU_NO_FDC_SET});
749    
750 18 sp('m', $vars->{QEMURAM}) if $vars->{QEMURAM};
751   sp('machine', $vars->{QEMUMACHINE}) if $vars->{QEMUMACHINE};
752   sp('cpu', $vars->{QEMUCPU}) if $vars->{QEMUCPU};
753 18 sp('net', 'none') if $vars->{OFFLINE_SUT};
754   if (my $path = $vars->{QEMU_HUGE_PAGES_PATH}) {
755 18 sp('mem-prealloc');
756 18 sp('mem-path', $path);
757 18 }
758 0  
759   sp('device', 'virtio-balloon,deflate-on-oom=on') if $vars->{QEMU_BALLOON_TARGET};
760 18  
761 18 for (my $i = 0; $i < $num_networks; $i++) {
762 18 if ($vars->{NICTYPE} eq "user") {
763   my $nictype_user_options = $vars->{NICTYPE_USER_OPTIONS} ? ',' . $vars->{NICTYPE_USER_OPTIONS} : '';
764 18 $nictype_user_options .= ",smb=${\(dirname($basedir))}" if ($vars->{QEMU_ENABLE_SMBD});
765 18 sp('netdev', [qv "user id=qanet$i$nictype_user_options"]);
766   }
767 18 elsif ($vars->{NICTYPE} eq "tap") {
768 18 sp('netdev', [qv "tap id=qanet$i ifname=$tapdev[$i] script=$tapscript[$i] downscript=$tapdownscript[$i]"]);
769 18 }
770   elsif ($vars->{NICTYPE} eq "vde") {
771 18 sp('netdev', [qv "vde id=qanet0 sock=$vars->{VDE_SOCKETDIR}/vde.ctl port=$vars->{VDE_PORT}"]);
772 18 }
773 18 else {
774 18 die "unknown NICTYPE $vars->{NICTYPE}\n";
775 18 }
776 18 sp('device', [qv "$vars->{NICMODEL} netdev=qanet$i mac=$nicmac[$i]"]);
777 18 }
778    
779 18 # Keep additional virtio _after_ Ethernet setup to keep virtio-net as eth0
780   if ($vars->{QEMU_VIRTIO_RNG} // 1) {
781   sp('object', 'rng-random,filename=/dev/urandom,id=rng0');
782 0 sp('device', 'virtio-rng-pci,rng=rng0');
783 0 }
784    
785   sp('smbios', $vars->{QEMU_SMBIOS}) if $vars->{QEMU_SMBIOS};
786    
787 18 if ($vars->{LAPTOP}) {
  18  
788   my $laptop_path = "$bmwqemu::scriptdir/dmidata/$vars->{LAPTOP}";
789 18 for my $f (glob "$laptop_path/*.bin") {
790 18 sp('smbios', "file=$f");
791 18 }
792 18 }
793 18 if ($vars->{NBF}) {
794 1 die "Need variable WORKER_HOSTNAME\n" unless $vars->{WORKER_HOSTNAME};
795 1 sp('kernel', '/usr/share/qemu/ipxe.lkrn');
796   sp('append', "dhcp && sanhook iscsi:$vars->{WORKER_HOSTNAME}::3260:1:$vars->{NBF}", no_quotes => 1);
797   }
798 18  
799   $self->setup_tpm($arch);
800 18  
801 18 my @boot_args;
802 18 # Enable boot menu for aarch64 workaround, see bsc#1022064 for details
803 18 $vars->{BOOT_MENU} //= 1 if ($vars->{BOOTFROM} && ($arch eq 'aarch64'));
  0  
804 18 push @boot_args, ('menu=on,splash-time=' . ($vars->{BOOT_MENU_TIMEOUT} // '5000')) if $vars->{BOOT_MENU};
805   if ($arch_supports_boot_order) {
806   if (($vars->{PXEBOOT} // '') eq 'once') {
807 0 push @boot_args, 'once=n';
808   }
809   elsif ($vars->{PXEBOOT}) {
810 0 push @boot_args, 'n';
811   }
812   elsif ($vars->{BOOTFROM}) {
813 0 push @boot_args, "order=$vars->{BOOTFROM}";
814   }
815 18 else {
816   push @boot_args, 'once=d';
817   }
818   }
819 18 sp('boot', join(',', @boot_args)) if @boot_args;
820 18  
821 18 if (!$vars->{UEFI} && $vars->{BIOS}) {
822   sp("bios", $vars->{BIOS});
823   }
824 18  
825   foreach my $attribute (qw(KERNEL INITRD APPEND)) {
826 18 sp(lc($attribute), $vars->{$attribute}) if $vars->{$attribute};
827 0 }
828 0  
829 0 unless ($vars->{QEMU_NO_TABLET}) {
830   sp('device', ($vars->{OFW} || $arch eq 'aarch64') ? 'nec-usb-xhci' : 'qemu-xhci');
831   sp('device', 'usb-tablet');
832 18 }
833 0  
834 0 sp('device', 'usb-kbd') if $use_usb_kbd;
835 0 sp('smp', $vars->{QEMUTHREADS} ? [qv "$vars->{QEMUCPUS} threads=$vars->{QEMUTHREADS}"] : $vars->{QEMUCPUS});
836   if ($vars->{QEMU_NUMA}) {
837   for my $i (0 .. ($vars->{QEMUCPUS} - 1)) {
838 18 my $m = int($vars->{QEMURAM} / $vars->{QEMUCPUS});
839   # add the rest to the first node to ensure all memory is
840 18 # allocated
841   $m += $vars->{QEMURAM} % $vars->{QEMUCPUS} if $i == 0;
842 18 sp('object', "memory-backend-ram,size=${m}m,id=m$i");
843 18 sp('numa', [qv "node nodeid=$i,memdev=m$i"]);
844 18 }
845 14 }
846 0  
847   sp('enable-kvm') if -r '/dev/kvm' && !$vars->{QEMU_NO_KVM};
848   sp('no-shutdown');
849 0  
850   if ($vars->{VNC}) {
851   my $vncport = $vars->{VNC} !~ /:/ ? ":$vars->{VNC}" : $vars->{VNC};
852 0 sp('vnc', [qv "$vncport share=force-shared"]);
853   sp('k', $vars->{VNCKB}) if $vars->{VNCKB};
854   }
855 14  
856   my @virtio_consoles = virtio_console_names;
857   if (@virtio_consoles) {
858 18 sp('device', 'virtio-serial');
859   for my $name (@virtio_consoles) {
860 18 sp('chardev', [qv "pipe id=$name path=$name logfile=$name.log logappend=on"]);
861 0 sp('device', [qv "virtconsole chardev=$name name=org.openqa.console.$name"]);
862   }
863   }
864 18  
865 54 my $qmpid = 'qmp_socket';
866   sp('chardev', [qv "socket path=$qmpid server=on wait=off id=$qmpid logfile=$qmpid.log logappend=on"]);
867   sp('qmp', "chardev:$qmpid");
868 18 sp('S');
869 16 }
870 16  
871   # Add parameters from QEMU_APPEND var, if any.
872   # The first item will have '-' prepended to it.
873 18 if ($vars->{QEMU_APPEND}) {
874 18 # Split multiple options, if needed
875 18 my @spl = split(' -', $vars->{QEMU_APPEND});
876 0 sp(split(' ', $_)) for @spl;
877 0 }
878    
879   create_virtio_console_fifo();
880 0 my $qemu_pipe = $self->{qemupipe} = $self->{proc}->exec_qemu();
881 0 return bmwqemu::fctinfo('Not connecting to QEMU as requested by QEMU_ONLY_EXEC') if $vars->{QEMU_ONLY_EXEC};
882 0 $self->{qmpsocket} = $self->{proc}->connect_qmp();
883   my $init = myjsonrpc::read_json($self->{qmpsocket});
884   my $hash = $self->handle_qmp_command({execute => 'qmp_capabilities'});
885    
886 18 my $vnc = $testapi::distri->add_console(
887 18 'sut',
888   'vnc-base',
889 18 {
890 18 hostname => 'localhost',
891 18 connect_timeout => 3,
892 18 port => 5900 + $bmwqemu::vars{VNC},
893   description => "QEMU's VNC"});
894    
895 18 $vnc->backend($self);
896 18 $self->select_console({testapi_console => 'sut'});
897 18  
898 18 if ($vars->{NICTYPE} eq "tap") {
899 36 $self->{allocated_networks} = $num_networks;
900 36 $self->{allocated_tap_devices} = \@tapdev;
901   $self->{allocated_vlan_tags} = \@nicvlan;
902   for (my $i = 0; $i < $num_networks; $i++) {
903   $self->_dbus_call('set_vlan', $tapdev[$i], $nicvlan[$i]);
904 18 }
905 18 $self->{proc}->_process->on(collected => sub {
906 18 $self->{proc}->_process->emit('cleanup') unless exists $self->{stop_only_qemu} && $self->{stop_only_qemu} == 1;
907 18 });
908    
909   $self->{proc}->_process->on(cleanup => sub {
910   eval {
911   for (my $i = 0; $i < $self->{allocated_networks}; $i++) {
912 18 $self->_dbus_call('unset_vlan', (@{$self->{allocated_tap_devices}})[$i], (@{$self->{allocated_vlan_tags}})[$i]);
913   }
914 14 }
915 14 });
916    
917   if (exists $vars->{OVS_DEBUG} && $vars->{OVS_DEBUG} == 1) {
918 18 my (undef, $output) = $self->_dbus_call('show');
919 18 bmwqemu::diag "Open vSwitch networking status:";
920 14 bmwqemu::diag $output;
921 13 }
922 12 }
923 12  
924   if ($bmwqemu::vars{DELAYED_START}) {
925   bmwqemu::diag("DELAYED_START set, not starting CPU, waiting for resume_vm()");
926   }
927   else {
928   bmwqemu::diag("Start CPU");
929   $self->handle_qmp_command({execute => 'cont'});
930   }
931    
932 12 $self->{select_read}->add($qemu_pipe, 'qemu::start_qemu::qemu_pipe');
933   $self->{select_write}->add($qemu_pipe, 'qemu::start_qemu::qemu_pipe');
934 12 }
935 12  
936   =head2 handle_qmp_command
937 12  
938 0 Send a QMP command and wait for the result
939 0  
940 0 Pass fatal => 1 to die on failure.
941 0 Pass send_fd => $fd to send $fd to QEMU using SCM rights. Probably only useful
942 0 with the getfd command.
943    
944   =cut
945 0 $optargs{fatal} ||= 0;
946 0 my $sk = $self->{qmpsocket};
947    
948   my $line = Mojo::JSON::to_json($cmd) . "\n";
949 0 if ($bmwqemu::vars{QEMU_ONLY_EXEC}) {
950 0 bmwqemu::fctinfo("Skipping the following qmp_command because QEMU_ONLY_EXEC is enabled:\n$line");
951 0 return undef;
  0  
  0  
952   }
953   my $wb = defined $optargs{send_fd} ? tinycv::send_with_fd($sk, $line, $optargs{send_fd}) : syswrite($sk, $line);
954 0 die "handle_qmp_command: syswrite failed $!" unless ($wb == length($line));
955    
956 0 my $hash;
957 0 do {
958 0 $hash = myjsonrpc::read_json($sk);
959 0 if ($hash->{event}) {
960   bmwqemu::diag "EVENT " . Mojo::JSON::to_json($hash);
961   # ignore
962   $hash = undef;
963 12 }
964 0 } until ($hash);
965   die "QMP command $cmd->{execute} failed: $hash->{error}->{class}; $hash->{error}->{desc}"
966   if $optargs{fatal} && defined($hash->{error});
967 12 return $hash;
968 12 }
969    
970   for my $line (split(/\n/, $buffer)) {
971 12 die "QEMU: Shutting down the job" if $line =~ m/key event queue full/;
972 12 if ($line =~ /^\s*qemu-system-[^:]+: (?!terminating on signal)/) {
973   bmwqemu::fctwarn $line, '';
974   }
975   else {
976   bmwqemu::diag "QEMU: $line";
977   }
978   }
979   }
980    
981   my $buffer;
982   my $bytes = sysread($self->{qemupipe}, $buffer, 1000);
983   chomp $buffer;
984 14 process_qemu_output($buffer);
  14  
  14  
  14  
  14  
985 14 return $bytes;
986 14 }
987    
988 14 $self->do_stop_vm() if $self->{started};
989 14  
990 0 if (my $qemu_pipe = $self->{qemupipe}) {
991 0 # one last word?
992   fcntl($qemu_pipe, Fcntl::F_SETFL, Fcntl::O_NONBLOCK);
993 14 $self->read_qemupipe();
994 14 $self->{select_read}->remove($qemu_pipe);
995   $self->{select_write}->remove($qemu_pipe);
996 14 close($qemu_pipe);
997 14 $self->{qemupipe} = undef;
998 25 }
999 25  
1000 11 if ($self->{qmpsocket}) {
1001   close($self->{qmpsocket}) || die "close $!\n";
1002 11 $self->{qmpsocket} = undef;
1003   }
1004    
1005   $self->SUPER::close_pipes() unless exists $self->{stop_only_qemu} && $self->{stop_only_qemu};
1006 14 }
1007 14  
1008   my $ret = $self->handle_qmp_command({execute => 'query-status'})->{return}->{status}
1009   || 'unknown';
1010 7  
  7  
  7  
1011 7 diag("QEMU status is not 'shutdown', it is '$ret'") if $ret ne 'shutdown';
1012 25  
1013 25 return $ret eq 'shutdown';
1014 1 }
1015    
1016   # this is called for all sockets ready to read from. return 1 if socket
1017 24 # detected and -1 if there was an error
1018    
1019   if ($self->{qemupipe} && $fh == $self->{qemupipe}) {
1020   $self->close_pipes() if !$write && !$self->read_qemupipe();
1021   return 1;
1022 6 }
  6  
  6  
1023 6 return $self->SUPER::check_socket($fh);
1024 6 }
1025 6  
1026 6 # qemu specific - all other backends will crash
1027 6 my $ret = $self->handle_qmp_command({execute => 'stop'}, fatal => 1);
1028   # once we stopped, there is no point in querying VNC
1029   if (!defined $self->{_qemu_saved_request_interval}) {
1030 4 $self->{_qemu_saved_request_interval} = $self->update_request_interval;
  4  
  4  
1031 4 $self->update_request_interval(1000);
1032   }
1033 4 return $ret;
1034   }
1035 4  
1036 4 $self->update_request_interval(delete $self->{_qemu_saved_request_interval}) if $self->{_qemu_saved_request_interval};
1037 4 return $self->handle_qmp_command({execute => 'cont'});
1038 4 }
1039 4  
1040 4 1;