1 package PVE
::GuestHelpers
;
6 use PVE
::Exception
qw(raise_perm_exc);
7 use PVE
::Tools
qw(split_list);
10 use POSIX
qw(strftime);
11 use Scalar
::Util
qw(weaken);
13 use base
qw(Exporter);
16 assert_tag_permissions
24 # We use a separate lock to block migration while a replication job
27 our $lockdir = '/var/lock/pve-manager';
29 # safe variable comparison functions
34 return 0 if !defined($a) && !defined($b);
35 return 1 if !defined($a);
36 return 1 if !defined($b);
44 return 0 if !defined($a) && !defined($b);
45 return 1 if !defined($a);
46 return 1 if !defined($b);
54 # we don't check if value is defined, since undefined
55 # is false (so it's a valid boolean)
57 # negate both values to normalize and compare
62 my ($a, $b, $type) = @_;
64 return 0 if !defined($a) && !defined($b);
65 return 1 if !defined($a);
66 return 1 if !defined($b);
68 if ($type eq 'string') {
69 return safe_string_ne
($a, $b);
70 } elsif ($type eq 'number' || $type eq 'integer') {
71 return safe_num_ne
($a, $b);
72 } elsif ($type eq 'boolean') {
73 return safe_boolean_ne
($a, $b);
76 die "internal error: can't compare $a and $b with type $type";
80 sub guest_migration_lock
{
81 my ($vmid, $timeout, $func, @param) = @_;
83 my $lockid = "pve-migrate-$vmid";
87 my $res = PVE
::Tools
::lock_file
("$lockdir/$lockid", $timeout, $func, @param);
93 sub check_hookscript
{
94 my ($volid, $storecfg) = @_;
96 $storecfg = PVE
::Storage
::config
() if !defined($storecfg);
97 my ($path, undef, $type) = PVE
::Storage
::path
($storecfg, $volid);
99 die "'$volid' is not in the snippets directory\n"
100 if $type ne 'snippets';
102 die "script '$volid' does not exist\n"
105 die "script '$volid' is not executable\n"
111 sub exec_hookscript
{
112 my ($conf, $vmid, $phase, $stop_on_error) = @_;
114 return if !$conf->{hookscript
};
117 my $hookscript = check_hookscript
($conf->{hookscript
});
120 PVE
::Tools
::run_command
([$hookscript, $vmid, $phase]);
123 my $errmsg = "hookscript error for $vmid on $phase: $err\n";
124 die $errmsg if ($stop_on_error);
129 # takes a snapshot list (e.g., qm/pct snapshot_list API call result) and
130 # prints it out in a nice tree sorted by age. Can cope with multiple roots
131 sub print_snapshot_tree
{
132 my ($snapshot_list) = @_;
134 my $snapshots = { map { $_->{name
} => $_ } @$snapshot_list };
137 foreach my $e (@$snapshot_list) {
139 if (($parent = $e->{parent
}) && defined $snapshots->{$parent}) {
140 push @{$snapshots->{$parent}->{children
}}, $e->{name
};
142 push @roots, $e->{name
};
146 # sort the elements by snaptime - with "current" (no snaptime) highest
147 my $snaptimesort = sub {
148 return +1 if !defined $snapshots->{$a}->{snaptime
};
149 return -1 if !defined $snapshots->{$b}->{snaptime
};
150 return $snapshots->{$a}->{snaptime
} <=> $snapshots->{$b}->{snaptime
};
153 # recursion function for displaying the tree
154 my $snapshottree_weak;
155 $snapshottree_weak = sub {
156 my ($prefix, $root, $snapshots) = @_;
157 my $e = $snapshots->{$root};
159 my $description = $e->{description
} || 'no-description';
160 ($description) = $description =~ m/(.*)$/m;
163 if (defined $e->{snaptime
}) {
164 $timestring = strftime
("%F %H:%M:%S", localtime($e->{snaptime
}));
167 my $len = 30 - length($prefix); # for aligning the description
168 $len = 0 if $len < 0;
169 printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description);
171 if ($e->{children
}) {
172 $prefix = " $prefix";
173 foreach my $child (sort $snaptimesort @{$e->{children
}}) {
174 $snapshottree_weak->($prefix, $child, $snapshots);
178 my $snapshottree = $snapshottree_weak;
179 weaken
($snapshottree_weak);
181 foreach my $root (sort $snaptimesort @roots) {
182 $snapshottree->('`->', $root, $snapshots);
188 foreach my $item (sort { $a->{key
} cmp $b->{key
}} @$data) {
189 my $k = $item->{key
};
190 next if $k eq 'digest';
191 my $v = $item->{value
};
192 my $p = $item->{pending
};
193 if ($k eq 'description') {
194 $v = PVE
::Tools
::encode_text
($v) if defined($v);
195 $p = PVE
::Tools
::encode_text
($p) if defined($p);
198 if ($item->{delete}) {
199 print "del $k: $v\n";
200 } elsif (defined($p)) {
201 print "cur $k: $v\n";
202 print "new $k: $p\n";
204 print "cur $k: $v\n";
206 } elsif (defined($p)) {
207 print "new $k: $p\n";
212 # returns the config as an array of hashes, each hash can have the following keys:
213 # key: the config property name, non-optional
214 # value: the current value in effect - if any
215 # pending: a new, still pending, value - if any
216 # delete: when deletions are pending, this is set to either 2 (force) or 1 (graceful)
217 sub config_with_pending_array
{
218 my ($conf, $pending_delete_hash) = @_;
220 my $pending = delete $conf->{pending
};
221 # we don't care for snapshots in pending and it makes our loops throw up
222 delete $conf->{snapshots
};
225 foreach my $opt (keys %$conf) {
226 next if ref($conf->{$opt}); # e.g., "raw" lxc.* keys are added as array ref
230 value
=> $conf->{$opt},
232 $item->{pending
} = delete $pending->{$opt} if defined($pending->{$opt});
233 my $delete = delete $pending_delete_hash->{$opt};
234 $item->{delete} = $delete->{force
} ?
2 : 1 if defined($delete);
239 foreach my $opt (keys %$pending) {
240 next if $opt eq 'delete';
243 pending
=> $pending->{$opt},
247 while (my ($opt, $force) = each %$pending_delete_hash) {
250 delete => $force ?
2 : 1,
257 # returns the allowed tags for the given user
258 # in scalar context, returns the list of allowed tags that exist
259 # in list context, returns a tuple of allowed tags, privileged tags, and if freeform is enabled
261 # first parameter is a bool if the user is 'privileged' (normally Sys.Modify on /)
262 # second parameter is a closure which takes the vmid. should check if the user can see the vm tags
263 sub get_allowed_tags
{
264 my ($rpcenv, $user, $privileged_user) = @_;
266 $privileged_user //= ($rpcenv->check($user, '/', ['Sys.Modify'], 1) // 0);
268 my $datacenter_config = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
270 my $allowed_tags = {};
271 my $privileged_tags = {};
272 if (my $tags = $datacenter_config->{'registered-tags'}) {
273 $privileged_tags->{$_} = 1 for $tags->@*;
275 my $user_tag_privs = $datacenter_config->{'user-tag-access'} // {};
276 my $user_allow = $user_tag_privs->{'user-allow'} // 'free';
277 my $freeform = $user_allow eq 'free';
279 if ($user_allow ne 'none' || $privileged_user) {
280 $allowed_tags->{$_} = 1 for ($user_tag_privs->{'user-allow-list'} // [])->@*;
283 if ($user_allow eq 'free' || $user_allow eq 'existing' || $privileged_user) {
284 my $props = PVE
::Cluster
::get_guest_config_properties
(['tags']);
285 for my $vmid (keys $props->%*) {
286 next if !$privileged_user && !$rpcenv->check_vm_perm($user, $vmid, undef, ['VM.Audit'], 0, 1);
287 $allowed_tags->{$_} = 1 for split_list
($props->{$vmid}->{tags
});
291 if ($privileged_user) {
292 $allowed_tags->{$_} = 1 for keys $privileged_tags->%*;
294 delete $allowed_tags->{$_} for keys $privileged_tags->%*;
297 return wantarray ?
($allowed_tags, $privileged_tags, $freeform) : $allowed_tags;
300 # checks the permissions for setting/updating/removing tags for guests
301 # tagopt_old and tagopt_new expect the tags as they are in the config
303 # either returns gracefully or raises a permission exception
304 sub assert_tag_permissions
{
305 my ($vmid, $tagopt_old, $tagopt_new, $rpcenv, $authuser) = @_;
307 $rpcenv->check_vm_perm($authuser, $vmid, undef, ['VM.Config.Options']);
309 my $privileged_user = $rpcenv->check($authuser, '/', ['Sys.Modify'], 1) // 0;
311 my ($allowed_tags, $privileged_tags, $freeform);
312 my $check_single_tag = sub {
314 return if $privileged_user;
316 if (!defined($allowed_tags // $privileged_tags // $freeform)) { # cache
317 ($allowed_tags, $privileged_tags, $freeform) = get_allowed_tags
($rpcenv, $authuser, $privileged_user);
320 if ((!$allowed_tags->{$tag} && !$freeform) || $privileged_tags->{$tag}) {
321 raise_perm_exc
("/, Sys.Modify for modifying tag '$tag'");
327 my ($old_tags, $new_tags, $all_tags) = ({}, {}, {});
329 $all_tags->{$_} = $old_tags->{$_} += 1 for split_list
($tagopt_old // '');
330 $all_tags->{$_} = $new_tags->{$_} += 1 for split_list
($tagopt_new // '');
332 for my $tag (keys $all_tags->%*) {
333 next if ($new_tags->{$tag} // 0) == ($old_tags->{$tag} // 0);
334 $check_single_tag->($tag);