]> git.proxmox.com Git - pve-guest-common.git/blame - PVE/GuestHelpers.pm
helpers: s/conf_table_with_pending/config_with_pending_array/ and comment
[pve-guest-common.git] / PVE / GuestHelpers.pm
CommitLineData
94d526d7
DM
1package PVE::GuestHelpers;
2
3use strict;
4use warnings;
5
6use PVE::Tools;
3acb4e74 7use PVE::Storage;
94d526d7 8
725dcadb
OB
9use POSIX qw(strftime);
10
94d526d7
DM
11# We use a separate lock to block migration while a replication job
12# is running.
13
7919c482
WB
14our $lockdir = '/var/lock/pve-manager';
15
94d526d7
DM
16sub guest_migration_lock {
17 my ($vmid, $timeout, $func, @param) = @_;
18
19 my $lockid = "pve-migrate-$vmid";
94d526d7
DM
20
21 mkdir $lockdir;
22
23 my $res = PVE::Tools::lock_file("$lockdir/$lockid", $timeout, $func, @param);
24 die $@ if $@;
25
26 return $res;
27}
28
3acb4e74
DC
29sub check_hookscript {
30 my ($volid, $storecfg) = @_;
31
32 $storecfg = PVE::Storage::config() if !defined($storecfg);
33 my ($path, undef, $type) = PVE::Storage::path($storecfg, $volid);
34
35 die "'$volid' is not in the snippets directory\n"
36 if $type ne 'snippets';
37
38 die "script '$volid' does not exists\n"
39 if ! -f $path;
40
41 die "script '$volid' is not executable\n"
42 if ! -x $path;
43
44 return $path;
45}
46
47sub exec_hookscript {
48 my ($conf, $vmid, $phase, $stop_on_error) = @_;
49
50 return if !$conf->{hookscript};
3acb4e74
DC
51
52 eval {
1c9da8ac
TL
53 my $hookscript = check_hookscript($conf->{hookscript});
54 die $@ if $@;
55
3acb4e74
DC
56 PVE::Tools::run_command([$hookscript, $vmid, $phase]);
57 };
3acb4e74
DC
58 if (my $err = $@) {
59 my $errmsg = "hookscript error for $vmid on $phase: $err\n";
1c9da8ac
TL
60 die $errmsg if ($stop_on_error);
61 warn $errmsg;
3acb4e74
DC
62 }
63}
64
5ee5f887
TL
65# takes a snapshot list (e.g., qm/pct snapshot_list API call result) and
66# prints it out in a nice tree sorted by age. Can cope with multiple roots
67sub print_snapshot_tree {
68 my ($snapshot_list) = @_;
725dcadb 69
5ee5f887 70 my $snapshots = { map { $_->{name} => $_ } @$snapshot_list };
725dcadb
OB
71
72 my @roots;
5ee5f887 73 foreach my $e (@$snapshot_list) {
725dcadb
OB
74 my $parent;
75 if (($parent = $e->{parent}) && defined $snapshots->{$parent}) {
76 push @{$snapshots->{$parent}->{children}}, $e->{name};
77 } else {
78 push @roots, $e->{name};
79 }
80 }
81
82 # sort the elements by snaptime - with "current" (no snaptime) highest
83 my $snaptimesort = sub {
84 return +1 if !defined $snapshots->{$a}->{snaptime};
85 return -1 if !defined $snapshots->{$b}->{snaptime};
86 return $snapshots->{$a}->{snaptime} <=> $snapshots->{$b}->{snaptime};
87 };
88
89 # recursion function for displaying the tree
90 my $snapshottree;
91 $snapshottree = sub {
92 my ($prefix, $root, $snapshots) = @_;
93 my $e = $snapshots->{$root};
94
95 my $description = $e->{description} || 'no-description';
96 ($description) = $description =~ m/(.*)$/m;
97
98 my $timestring = "";
99 if (defined $e->{snaptime}) {
100 $timestring = strftime("%F %H:%M:%S", localtime($e->{snaptime}));
101 }
102
103 my $len = 30 - length($prefix); # for aligning the description
104 printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description);
105
106 if ($e->{children}) {
107 $prefix = " $prefix";
108 foreach my $child (sort $snaptimesort @{$e->{children}}) {
109 $snapshottree->($prefix, $child, $snapshots);
110 }
111 }
112 };
113
114 foreach my $root (sort $snaptimesort @roots) {
115 $snapshottree->('`->', $root, $snapshots);
116 }
117}
118
bd240228
OB
119sub format_pending {
120 my ($data) = @_;
121 foreach my $item (sort { $a->{key} cmp $b->{key}} @$data) {
122 my $k = $item->{key};
123 next if $k eq 'digest';
124 my $v = $item->{value};
125 my $p = $item->{pending};
126 if ($k eq 'description') {
127 $v = PVE::Tools::encode_text($v) if defined($v);
128 $p = PVE::Tools::encode_text($p) if defined($p);
129 }
130 if (defined($v)) {
131 if ($item->{delete}) {
132 print "del $k: $v\n";
133 } elsif (defined($p)) {
134 print "cur $k: $v\n";
135 print "new $k: $p\n";
136 } else {
137 print "cur $k: $v\n";
138 }
139 } elsif (defined($p)) {
140 print "new $k: $p\n";
141 }
142 }
143}
144
55001030
TL
145# returns the config as an array of hashes, each hash can have the following keys:
146# key (the config property name, non-optional)
147# value (the current value in effect - if any)
148# pending (a new, still pending, value - if any)
149# delete (when deletions are pending, this is set to either 2 (force) or 1 (graceful))
150sub config_with_pending_array {
15144481
OB
151 my ($conf, $pending_delete_hash) = @_;
152
153 my $res = [];
154
155 foreach my $opt (keys %$conf) {
156 next if ref($conf->{$opt});
157 my $item = { key => $opt };
158 $item->{value} = $conf->{$opt} if defined($conf->{$opt});
159 $item->{pending} = $conf->{pending}->{$opt} if defined($conf->{pending}->{$opt});
160 $item->{delete} = ($pending_delete_hash->{$opt}->{force} ? 2 : 1) if exists $pending_delete_hash->{$opt};
161
162 push @$res, $item;
163 }
164
165 foreach my $opt (keys %{$conf->{pending}}) {
166 next if $opt eq 'delete';
167 next if ref($conf->{pending}->{$opt}); # just to be sure
168 next if defined($conf->{$opt});
169 my $item = { key => $opt };
170 $item->{pending} = $conf->{pending}->{$opt};
171
172 push @$res, $item;
173 }
174
175 while (my ($opt, $force) = each %$pending_delete_hash) {
176 next if $conf->{pending}->{$opt}; # just to be sure
177 next if $conf->{$opt};
178 my $item = { key => $opt, delete => ($force ? 2 : 1)};
179 push @$res, $item;
180 }
181
182 return $res;
183}
184
94d526d7 1851;