]>
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 OB |
9 | use 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 |
14 | our $lockdir = '/var/lock/pve-manager'; |
15 | ||
94d526d7 DM |
16 | sub 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 |
29 | sub 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 | ||
47 | sub 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 | |
67 | sub 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 |
119 | sub 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)) | |
150 | sub 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 | 185 | 1; |