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