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