PVE/QemuServer/Helpers.pm

   1 package PVE::QemuServer::Helpers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::stat;
   7
   8 use PVE::INotify;
   9 use PVE::ProcFSTools;
  10
  11 use base 'Exporter';
  12 our @EXPORT_OK = qw(
  13 min_version
  14 config_aware_timeout
  15 );
  16
  17 my $nodename = PVE::INotify::nodename();
  18
  19 # Paths and directories
  20
  21 our $var_run_tmpdir = "/var/run/qemu-server";
  22 mkdir $var_run_tmpdir;
  23
  24 sub qmp_socket {
  25     my ($vmid, $qga) = @_;
  26     my $sockettype = $qga ? 'qga' : 'qmp';
  27     return "${var_run_tmpdir}/$vmid.$sockettype";
  28 }
  29
  30 sub pidfile_name {
  31     my ($vmid) = @_;
  32     return "${var_run_tmpdir}/$vmid.pid";
  33 }
  34
  35 sub vnc_socket {
  36     my ($vmid) = @_;
  37     return "${var_run_tmpdir}/$vmid.vnc";
  38 }
  39
  40 # Parse the cmdline of a running kvm/qemu process and return arguments as hash
  41 sub parse_cmdline {
  42     my ($pid) = @_;
  43
  44     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
  45     if (defined($fh)) {
  46         my $line = <$fh>;
  47         $fh->close;
  48         return if !$line;
  49         my @param = split(/\0/, $line);
  50
  51         my $cmd = $param[0];
  52         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m@(?:^|/)qemu-system-[^/]+$@);
  53
  54         my $phash = {};
  55         my $pending_cmd;
  56         for (my $i = 0; $i < scalar (@param); $i++) {
  57             my $p = $param[$i];
  58             next if !$p;
  59
  60             if ($p =~ m/^--?(.*)$/) {
  61                 if ($pending_cmd) {
  62                     $phash->{$pending_cmd} = {};
  63                 }
  64                 $pending_cmd = $1;
  65             } elsif ($pending_cmd) {
  66                 $phash->{$pending_cmd} = { value => $p };
  67                 $pending_cmd = undef;
  68             }
  69         }
  70
  71         return $phash;
  72     }
  73     return;
  74 }
  75
  76 sub vm_running_locally {
  77     my ($vmid) = @_;
  78
  79     my $pidfile = pidfile_name($vmid);
  80
  81     if (my $fd = IO::File->new("<$pidfile")) {
  82         my $st = stat($fd);
  83         my $line = <$fd>;
  84         close($fd);
  85
  86         my $mtime = $st->mtime;
  87         if ($mtime > time()) {
  88             warn "file '$pidfile' modified in future\n";
  89         }
  90
  91         if ($line =~ m/^(\d+)$/) {
  92             my $pid = $1;
  93             my $cmdline = parse_cmdline($pid);
  94             if ($cmdline && defined($cmdline->{pidfile}) && $cmdline->{pidfile}->{value}
  95                 && $cmdline->{pidfile}->{value} eq $pidfile) {
  96                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
  97                     return $pid;
  98                 }
  99             }
 100         }
 101     }
 102
 103     return;
 104 }
 105
 106 sub min_version {
 107     my ($verstr, $major, $minor, $pve) = @_;
 108
 109     if ($verstr =~ m/^(\d+)\.(\d+)(?:\.(\d+))?(?:\+pve(\d+))?/) {
 110         return 1 if version_cmp($1, $major, $2, $minor, $4, $pve) >= 0;
 111         return 0;
 112     }
 113
 114     die "internal error: cannot check version of invalid string '$verstr'";
 115 }
 116
 117 # gets in pairs the versions you want to compares, i.e.:
 118 # ($a-major, $b-major, $a-minor, $b-minor, $a-extra, $b-extra, ...)
 119 # returns 0 if same, -1 if $a is older than $b, +1 if $a is newer than $b
 120 sub version_cmp {
 121     my @versions = @_;
 122
 123     my $size = scalar(@versions);
 124
 125     return 0 if $size == 0;
 126
 127     if ($size & 1) {
 128         my (undef, $fn, $line) = caller(0);
 129         die "cannot compare odd count of versions, called from $fn:$line\n";
 130     }
 131
 132     for (my $i = 0; $i < $size; $i += 2) {
 133         my ($a, $b) = splice(@versions, 0, 2);
 134         $a //= 0;
 135         $b //= 0;
 136
 137         return 1 if $a > $b;
 138         return -1 if $a < $b;
 139     }
 140     return 0;
 141 }
 142
 143 sub config_aware_timeout {
 144     my ($config, $is_suspended) = @_;
 145     my $memory = $config->{memory};
 146     my $timeout = 30;
 147
 148     # Based on user reported startup time for vm with 512GiB @ 4-5 minutes
 149     if (defined($memory) && $memory > 30720) {
 150         $timeout = int($memory/1024);
 151     }
 152
 153     if ($is_suspended && $timeout < 300) {
 154         $timeout = 300;
 155     }
 156
 157     if ($config->{hugepages} && $timeout < 150) {
 158         $timeout = 150;
 159     }
 160
 161     return $timeout;
 162 }
 163
 164 1;