]>
Commit | Line | Data |
---|---|---|
94d526d7 DM |
1 | package PVE::GuestHelpers; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use PVE::Tools; | |
3acb4e74 | 7 | use PVE::Storage; |
94d526d7 | 8 | |
725dcadb | 9 | use POSIX qw(strftime); |
727080ed | 10 | use Scalar::Util qw(weaken); |
725dcadb | 11 | |
b2b16cee DC |
12 | use base qw(Exporter); |
13 | ||
24d90d8d OB |
14 | our @EXPORT_OK = qw(safe_string_ne safe_boolean_ne safe_num_ne typesafe_ne); |
15 | ||
94d526d7 DM |
16 | # We use a separate lock to block migration while a replication job |
17 | # is running. | |
18 | ||
7919c482 WB |
19 | our $lockdir = '/var/lock/pve-manager'; |
20 | ||
24d90d8d OB |
21 | # safe variable comparison functions |
22 | ||
23 | sub safe_num_ne { | |
24 | my ($a, $b) = @_; | |
25 | ||
26 | return 0 if !defined($a) && !defined($b); | |
27 | return 1 if !defined($a); | |
28 | return 1 if !defined($b); | |
29 | ||
30 | return $a != $b; | |
31 | } | |
32 | ||
33 | sub safe_string_ne { | |
34 | my ($a, $b) = @_; | |
35 | ||
36 | return 0 if !defined($a) && !defined($b); | |
37 | return 1 if !defined($a); | |
38 | return 1 if !defined($b); | |
39 | ||
40 | return $a ne $b; | |
41 | } | |
42 | ||
43 | sub safe_boolean_ne { | |
44 | my ($a, $b) = @_; | |
45 | ||
46 | # we don't check if value is defined, since undefined | |
47 | # is false (so it's a valid boolean) | |
48 | ||
49 | # negate both values to normalize and compare | |
50 | return !$a != !$b; | |
51 | } | |
52 | ||
53 | sub typesafe_ne { | |
54 | my ($a, $b, $type) = @_; | |
55 | ||
56 | return 0 if !defined($a) && !defined($b); | |
57 | return 1 if !defined($a); | |
58 | return 1 if !defined($b); | |
59 | ||
60 | if ($type eq 'string') { | |
61 | return safe_string_ne($a, $b); | |
62 | } elsif ($type eq 'number' || $type eq 'integer') { | |
63 | return safe_num_ne($a, $b); | |
64 | } elsif ($type eq 'boolean') { | |
65 | return safe_boolean_ne($a, $b); | |
66 | } | |
67 | ||
68 | die "internal error: can't compare $a and $b with type $type"; | |
69 | } | |
70 | ||
71 | ||
94d526d7 DM |
72 | sub guest_migration_lock { |
73 | my ($vmid, $timeout, $func, @param) = @_; | |
74 | ||
75 | my $lockid = "pve-migrate-$vmid"; | |
94d526d7 DM |
76 | |
77 | mkdir $lockdir; | |
78 | ||
79 | my $res = PVE::Tools::lock_file("$lockdir/$lockid", $timeout, $func, @param); | |
80 | die $@ if $@; | |
81 | ||
82 | return $res; | |
83 | } | |
84 | ||
3acb4e74 DC |
85 | sub check_hookscript { |
86 | my ($volid, $storecfg) = @_; | |
87 | ||
88 | $storecfg = PVE::Storage::config() if !defined($storecfg); | |
89 | my ($path, undef, $type) = PVE::Storage::path($storecfg, $volid); | |
90 | ||
91 | die "'$volid' is not in the snippets directory\n" | |
92 | if $type ne 'snippets'; | |
93 | ||
fb73d112 | 94 | die "script '$volid' does not exist\n" |
3acb4e74 DC |
95 | if ! -f $path; |
96 | ||
97 | die "script '$volid' is not executable\n" | |
98 | if ! -x $path; | |
99 | ||
100 | return $path; | |
101 | } | |
102 | ||
103 | sub exec_hookscript { | |
104 | my ($conf, $vmid, $phase, $stop_on_error) = @_; | |
105 | ||
106 | return if !$conf->{hookscript}; | |
3acb4e74 DC |
107 | |
108 | eval { | |
1c9da8ac TL |
109 | my $hookscript = check_hookscript($conf->{hookscript}); |
110 | die $@ if $@; | |
111 | ||
3acb4e74 DC |
112 | PVE::Tools::run_command([$hookscript, $vmid, $phase]); |
113 | }; | |
3acb4e74 DC |
114 | if (my $err = $@) { |
115 | my $errmsg = "hookscript error for $vmid on $phase: $err\n"; | |
1c9da8ac TL |
116 | die $errmsg if ($stop_on_error); |
117 | warn $errmsg; | |
3acb4e74 DC |
118 | } |
119 | } | |
120 | ||
5ee5f887 TL |
121 | # takes a snapshot list (e.g., qm/pct snapshot_list API call result) and |
122 | # prints it out in a nice tree sorted by age. Can cope with multiple roots | |
123 | sub print_snapshot_tree { | |
124 | my ($snapshot_list) = @_; | |
725dcadb | 125 | |
5ee5f887 | 126 | my $snapshots = { map { $_->{name} => $_ } @$snapshot_list }; |
725dcadb OB |
127 | |
128 | my @roots; | |
5ee5f887 | 129 | foreach my $e (@$snapshot_list) { |
725dcadb OB |
130 | my $parent; |
131 | if (($parent = $e->{parent}) && defined $snapshots->{$parent}) { | |
132 | push @{$snapshots->{$parent}->{children}}, $e->{name}; | |
133 | } else { | |
134 | push @roots, $e->{name}; | |
135 | } | |
136 | } | |
137 | ||
138 | # sort the elements by snaptime - with "current" (no snaptime) highest | |
139 | my $snaptimesort = sub { | |
140 | return +1 if !defined $snapshots->{$a}->{snaptime}; | |
141 | return -1 if !defined $snapshots->{$b}->{snaptime}; | |
142 | return $snapshots->{$a}->{snaptime} <=> $snapshots->{$b}->{snaptime}; | |
143 | }; | |
144 | ||
145 | # recursion function for displaying the tree | |
727080ed WB |
146 | my $snapshottree_weak; |
147 | $snapshottree_weak = sub { | |
725dcadb OB |
148 | my ($prefix, $root, $snapshots) = @_; |
149 | my $e = $snapshots->{$root}; | |
150 | ||
151 | my $description = $e->{description} || 'no-description'; | |
152 | ($description) = $description =~ m/(.*)$/m; | |
153 | ||
154 | my $timestring = ""; | |
155 | if (defined $e->{snaptime}) { | |
156 | $timestring = strftime("%F %H:%M:%S", localtime($e->{snaptime})); | |
157 | } | |
158 | ||
159 | my $len = 30 - length($prefix); # for aligning the description | |
160 | printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description); | |
161 | ||
162 | if ($e->{children}) { | |
163 | $prefix = " $prefix"; | |
164 | foreach my $child (sort $snaptimesort @{$e->{children}}) { | |
727080ed | 165 | $snapshottree_weak->($prefix, $child, $snapshots); |
725dcadb OB |
166 | } |
167 | } | |
168 | }; | |
727080ed WB |
169 | my $snapshottree = $snapshottree_weak; |
170 | weaken($snapshottree_weak); | |
725dcadb OB |
171 | |
172 | foreach my $root (sort $snaptimesort @roots) { | |
173 | $snapshottree->('`->', $root, $snapshots); | |
174 | } | |
175 | } | |
176 | ||
bd240228 OB |
177 | sub format_pending { |
178 | my ($data) = @_; | |
179 | foreach my $item (sort { $a->{key} cmp $b->{key}} @$data) { | |
180 | my $k = $item->{key}; | |
181 | next if $k eq 'digest'; | |
182 | my $v = $item->{value}; | |
183 | my $p = $item->{pending}; | |
184 | if ($k eq 'description') { | |
185 | $v = PVE::Tools::encode_text($v) if defined($v); | |
186 | $p = PVE::Tools::encode_text($p) if defined($p); | |
187 | } | |
188 | if (defined($v)) { | |
189 | if ($item->{delete}) { | |
190 | print "del $k: $v\n"; | |
191 | } elsif (defined($p)) { | |
192 | print "cur $k: $v\n"; | |
193 | print "new $k: $p\n"; | |
194 | } else { | |
195 | print "cur $k: $v\n"; | |
196 | } | |
197 | } elsif (defined($p)) { | |
198 | print "new $k: $p\n"; | |
199 | } | |
200 | } | |
201 | } | |
202 | ||
55001030 TL |
203 | # returns the config as an array of hashes, each hash can have the following keys: |
204 | # key (the config property name, non-optional) | |
205 | # value (the current value in effect - if any) | |
206 | # pending (a new, still pending, value - if any) | |
207 | # delete (when deletions are pending, this is set to either 2 (force) or 1 (graceful)) | |
208 | sub config_with_pending_array { | |
15144481 OB |
209 | my ($conf, $pending_delete_hash) = @_; |
210 | ||
211 | my $res = []; | |
212 | ||
213 | foreach my $opt (keys %$conf) { | |
214 | next if ref($conf->{$opt}); | |
215 | my $item = { key => $opt }; | |
216 | $item->{value} = $conf->{$opt} if defined($conf->{$opt}); | |
217 | $item->{pending} = $conf->{pending}->{$opt} if defined($conf->{pending}->{$opt}); | |
218 | $item->{delete} = ($pending_delete_hash->{$opt}->{force} ? 2 : 1) if exists $pending_delete_hash->{$opt}; | |
219 | ||
220 | push @$res, $item; | |
221 | } | |
222 | ||
223 | foreach my $opt (keys %{$conf->{pending}}) { | |
224 | next if $opt eq 'delete'; | |
225 | next if ref($conf->{pending}->{$opt}); # just to be sure | |
226 | next if defined($conf->{$opt}); | |
227 | my $item = { key => $opt }; | |
228 | $item->{pending} = $conf->{pending}->{$opt}; | |
229 | ||
230 | push @$res, $item; | |
231 | } | |
232 | ||
233 | while (my ($opt, $force) = each %$pending_delete_hash) { | |
234 | next if $conf->{pending}->{$opt}; # just to be sure | |
235 | next if $conf->{$opt}; | |
236 | my $item = { key => $opt, delete => ($force ? 2 : 1)}; | |
237 | push @$res, $item; | |
238 | } | |
239 | ||
240 | return $res; | |
241 | } | |
242 | ||
94d526d7 | 243 | 1; |