mirror of
https://git.proxmox.com/git/qemu-server
synced 2025-04-30 05:10:21 +00:00
292 lines
6.7 KiB
Perl
292 lines
6.7 KiB
Perl
package PVE::QemuServer::Helpers;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use File::stat;
|
|
use JSON;
|
|
|
|
use PVE::INotify;
|
|
use PVE::ProcFSTools;
|
|
use PVE::Tools qw(get_host_arch);
|
|
|
|
use base 'Exporter';
|
|
our @EXPORT_OK = qw(
|
|
min_version
|
|
config_aware_timeout
|
|
kvm_user_version
|
|
parse_number_sets
|
|
windows_version
|
|
);
|
|
|
|
my $nodename = PVE::INotify::nodename();
|
|
|
|
my $arch_to_qemu_binary = {
|
|
aarch64 => '/usr/bin/qemu-system-aarch64',
|
|
x86_64 => '/usr/bin/qemu-system-x86_64',
|
|
};
|
|
sub get_command_for_arch($) {
|
|
my ($arch) = @_;
|
|
return '/usr/bin/kvm' if get_host_arch() eq $arch; # i.e. native arch
|
|
|
|
my $cmd = $arch_to_qemu_binary->{$arch}
|
|
or die "don't know how to emulate architecture '$arch'\n";
|
|
return $cmd;
|
|
}
|
|
|
|
sub get_vm_arch {
|
|
my ($conf) = @_;
|
|
return $conf->{arch} // get_host_arch();
|
|
}
|
|
|
|
my $kvm_user_version = {};
|
|
my $kvm_mtime = {};
|
|
|
|
sub kvm_user_version {
|
|
my ($binary) = @_;
|
|
|
|
$binary //= get_command_for_arch(get_host_arch()); # get the native arch by default
|
|
my $st = stat($binary);
|
|
|
|
my $cachedmtime = $kvm_mtime->{$binary} // -1;
|
|
return $kvm_user_version->{$binary} if $kvm_user_version->{$binary} &&
|
|
$cachedmtime == $st->mtime;
|
|
|
|
$kvm_user_version->{$binary} = 'unknown';
|
|
$kvm_mtime->{$binary} = $st->mtime;
|
|
|
|
my $code = sub {
|
|
my $line = shift;
|
|
if ($line =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)(\.\d+)?[,\s]/) {
|
|
$kvm_user_version->{$binary} = $2;
|
|
}
|
|
};
|
|
|
|
eval { PVE::Tools::run_command([$binary, '--version'], outfunc => $code); };
|
|
warn $@ if $@;
|
|
|
|
return $kvm_user_version->{$binary};
|
|
}
|
|
|
|
# Paths and directories
|
|
|
|
our $var_run_tmpdir = "/var/run/qemu-server";
|
|
mkdir $var_run_tmpdir;
|
|
|
|
sub qmp_socket {
|
|
my ($vmid, $qga) = @_;
|
|
my $sockettype = $qga ? 'qga' : 'qmp';
|
|
return "${var_run_tmpdir}/$vmid.$sockettype";
|
|
}
|
|
|
|
sub pidfile_name {
|
|
my ($vmid) = @_;
|
|
return "${var_run_tmpdir}/$vmid.pid";
|
|
}
|
|
|
|
sub vnc_socket {
|
|
my ($vmid) = @_;
|
|
return "${var_run_tmpdir}/$vmid.vnc";
|
|
}
|
|
|
|
# Parse the cmdline of a running kvm/qemu process and return arguments as hash
|
|
sub parse_cmdline {
|
|
my ($pid) = @_;
|
|
|
|
my $fh = IO::File->new("/proc/$pid/cmdline", "r");
|
|
if (defined($fh)) {
|
|
my $line = <$fh>;
|
|
$fh->close;
|
|
return if !$line;
|
|
my @param = split(/\0/, $line);
|
|
|
|
my $cmd = $param[0];
|
|
return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m@(?:^|/)qemu-system-[^/]+$@);
|
|
|
|
my $phash = {};
|
|
my $pending_cmd;
|
|
for (my $i = 0; $i < scalar (@param); $i++) {
|
|
my $p = $param[$i];
|
|
next if !$p;
|
|
|
|
if ($p =~ m/^--?(.*)$/) {
|
|
if ($pending_cmd) {
|
|
$phash->{$pending_cmd} = {};
|
|
}
|
|
$pending_cmd = $1;
|
|
} elsif ($pending_cmd) {
|
|
$phash->{$pending_cmd} = { value => $p };
|
|
$pending_cmd = undef;
|
|
}
|
|
}
|
|
|
|
return $phash;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub vm_running_locally {
|
|
my ($vmid) = @_;
|
|
|
|
my $pidfile = pidfile_name($vmid);
|
|
|
|
if (my $fd = IO::File->new("<$pidfile")) {
|
|
my $st = stat($fd);
|
|
my $line = <$fd>;
|
|
close($fd);
|
|
|
|
my $mtime = $st->mtime;
|
|
if ($mtime > time()) {
|
|
warn "file '$pidfile' modified in future\n";
|
|
}
|
|
|
|
if ($line =~ m/^(\d+)$/) {
|
|
my $pid = $1;
|
|
my $cmdline = parse_cmdline($pid);
|
|
if ($cmdline && defined($cmdline->{pidfile}) && $cmdline->{pidfile}->{value}
|
|
&& $cmdline->{pidfile}->{value} eq $pidfile) {
|
|
if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
|
|
return $pid;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub min_version {
|
|
my ($verstr, $major, $minor, $pve) = @_;
|
|
|
|
if ($verstr =~ m/^(\d+)\.(\d+)(?:\.(\d+))?(?:\+pve(\d+))?/) {
|
|
return 1 if version_cmp($1, $major, $2, $minor, $4, $pve) >= 0;
|
|
return 0;
|
|
}
|
|
|
|
die "internal error: cannot check version of invalid string '$verstr'";
|
|
}
|
|
|
|
# gets in pairs the versions you want to compares, i.e.:
|
|
# ($a-major, $b-major, $a-minor, $b-minor, $a-extra, $b-extra, ...)
|
|
# returns 0 if same, -1 if $a is older than $b, +1 if $a is newer than $b
|
|
sub version_cmp {
|
|
my @versions = @_;
|
|
|
|
my $size = scalar(@versions);
|
|
|
|
return 0 if $size == 0;
|
|
|
|
if ($size & 1) {
|
|
my (undef, $fn, $line) = caller(0);
|
|
die "cannot compare odd count of versions, called from $fn:$line\n";
|
|
}
|
|
|
|
for (my $i = 0; $i < $size; $i += 2) {
|
|
my ($a, $b) = splice(@versions, 0, 2);
|
|
$a //= 0;
|
|
$b //= 0;
|
|
|
|
return 1 if $a > $b;
|
|
return -1 if $a < $b;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub config_aware_timeout {
|
|
my ($config, $memory, $is_suspended) = @_;
|
|
my $timeout = 30;
|
|
|
|
# Based on user reported startup time for vm with 512GiB @ 4-5 minutes
|
|
if (defined($memory) && $memory > 30720) {
|
|
$timeout = int($memory/1024);
|
|
}
|
|
|
|
# When using PCI passthrough, users reported much higher startup times,
|
|
# growing with the amount of memory configured. Constant factor chosen
|
|
# based on user reports.
|
|
if (grep(/^hostpci[0-9]+$/, keys %$config)) {
|
|
$timeout *= 4;
|
|
}
|
|
|
|
if ($is_suspended && $timeout < 300) {
|
|
$timeout = 300;
|
|
}
|
|
|
|
if ($config->{hugepages} && $timeout < 150) {
|
|
$timeout = 150;
|
|
}
|
|
|
|
# Some testing showed that adding a NIC increased the start time by ~450ms
|
|
# consistently across different NIC models, options and already existing
|
|
# number of NICs.
|
|
# So 10x that to account for any potential system differences seemed
|
|
# reasonable. User reports with real-life values (20+: ~50s, 25: 45s, 17: 42s)
|
|
# also make this seem a good value.
|
|
my $nic_count = scalar (grep { /^net\d+/ } keys %{$config});
|
|
$timeout += $nic_count * 5;
|
|
|
|
return $timeout;
|
|
}
|
|
|
|
sub get_node_pvecfg_version {
|
|
my ($node) = @_;
|
|
|
|
my $nodes_version_info = PVE::Cluster::get_node_kv('version-info', $node);
|
|
return if !$nodes_version_info->{$node};
|
|
|
|
my $version_info = decode_json($nodes_version_info->{$node});
|
|
return $version_info->{version};
|
|
}
|
|
|
|
sub pvecfg_min_version {
|
|
my ($verstr, $major, $minor, $release) = @_;
|
|
|
|
return 0 if !$verstr;
|
|
|
|
if ($verstr =~ m/^(\d+)\.(\d+)(?:[.-](\d+))?/) {
|
|
return 1 if version_cmp($1, $major, $2, $minor, $3 // 0, $release) >= 0;
|
|
return 0;
|
|
}
|
|
|
|
die "internal error: cannot check version of invalid string '$verstr'";
|
|
}
|
|
|
|
sub parse_number_sets {
|
|
my ($set) = @_;
|
|
my $res = [];
|
|
foreach my $part (split(/;/, $set)) {
|
|
if ($part =~ /^\s*(\d+)(?:-(\d+))?\s*$/) {
|
|
die "invalid range: $part ($2 < $1)\n" if defined($2) && $2 < $1;
|
|
push @$res, [ $1, $2 ];
|
|
} else {
|
|
die "invalid range: $part\n";
|
|
}
|
|
}
|
|
return $res;
|
|
}
|
|
|
|
sub windows_version {
|
|
my ($ostype) = @_;
|
|
|
|
return 0 if !$ostype;
|
|
|
|
my $winversion = 0;
|
|
|
|
if($ostype eq 'wxp' || $ostype eq 'w2k3' || $ostype eq 'w2k') {
|
|
$winversion = 5;
|
|
} elsif($ostype eq 'w2k8' || $ostype eq 'wvista') {
|
|
$winversion = 6;
|
|
} elsif ($ostype =~ m/^win(\d+)$/) {
|
|
$winversion = $1;
|
|
}
|
|
|
|
return $winversion;
|
|
}
|
|
|
|
sub needs_extraction {
|
|
my ($vtype, $fmt) = @_;
|
|
return $vtype eq 'import' && $fmt =~ m/^ova\+(.*)$/;
|
|
}
|
|
|
|
1;
|