1 package PVE
::GuestHelpers
;
9 use POSIX
qw(strftime);
10 use Scalar
::Util
qw(weaken);
12 use base
qw(Exporter);
14 our @EXPORT_OK = qw(safe_string_ne safe_boolean_ne safe_num_ne typesafe_ne);
16 # We use a separate lock to block migration while a replication job
19 our $lockdir = '/var/lock/pve-manager';
21 # safe variable comparison functions
26 return 0 if !defined($a) && !defined($b);
27 return 1 if !defined($a);
28 return 1 if !defined($b);
36 return 0 if !defined($a) && !defined($b);
37 return 1 if !defined($a);
38 return 1 if !defined($b);
46 # we don't check if value is defined, since undefined
47 # is false (so it's a valid boolean)
49 # negate both values to normalize and compare
54 my ($a, $b, $type) = @_;
56 return 0 if !defined($a) && !defined($b);
57 return 1 if !defined($a);
58 return 1 if !defined($b);
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);
68 die "internal error: can't compare $a and $b with type $type";
72 sub guest_migration_lock
{
73 my ($vmid, $timeout, $func, @param) = @_;
75 my $lockid = "pve-migrate-$vmid";
79 my $res = PVE
::Tools
::lock_file
("$lockdir/$lockid", $timeout, $func, @param);
85 sub check_hookscript
{
86 my ($volid, $storecfg) = @_;
88 $storecfg = PVE
::Storage
::config
() if !defined($storecfg);
89 my ($path, undef, $type) = PVE
::Storage
::path
($storecfg, $volid);
91 die "'$volid' is not in the snippets directory\n"
92 if $type ne 'snippets';
94 die "script '$volid' does not exist\n"
97 die "script '$volid' is not executable\n"
103 sub exec_hookscript
{
104 my ($conf, $vmid, $phase, $stop_on_error) = @_;
106 return if !$conf->{hookscript
};
109 my $hookscript = check_hookscript
($conf->{hookscript
});
112 PVE
::Tools
::run_command
([$hookscript, $vmid, $phase]);
115 my $errmsg = "hookscript error for $vmid on $phase: $err\n";
116 die $errmsg if ($stop_on_error);
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) = @_;
126 my $snapshots = { map { $_->{name
} => $_ } @$snapshot_list };
129 foreach my $e (@$snapshot_list) {
131 if (($parent = $e->{parent
}) && defined $snapshots->{$parent}) {
132 push @{$snapshots->{$parent}->{children
}}, $e->{name
};
134 push @roots, $e->{name
};
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
};
145 # recursion function for displaying the tree
146 my $snapshottree_weak;
147 $snapshottree_weak = sub {
148 my ($prefix, $root, $snapshots) = @_;
149 my $e = $snapshots->{$root};
151 my $description = $e->{description
} || 'no-description';
152 ($description) = $description =~ m/(.*)$/m;
155 if (defined $e->{snaptime
}) {
156 $timestring = strftime
("%F %H:%M:%S", localtime($e->{snaptime
}));
159 my $len = 30 - length($prefix); # for aligning the description
160 printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description);
162 if ($e->{children
}) {
163 $prefix = " $prefix";
164 foreach my $child (sort $snaptimesort @{$e->{children
}}) {
165 $snapshottree_weak->($prefix, $child, $snapshots);
169 my $snapshottree = $snapshottree_weak;
170 weaken
($snapshottree_weak);
172 foreach my $root (sort $snaptimesort @roots) {
173 $snapshottree->('`->', $root, $snapshots);
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);
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";
195 print "cur $k: $v\n";
197 } elsif (defined($p)) {
198 print "new $k: $p\n";
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
{
209 my ($conf, $pending_delete_hash) = @_;
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};
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};
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)};