PVE/GuestHelpers.pm

   1 package PVE::GuestHelpers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use PVE::Tools;
   7 use PVE::Storage;
   8
   9 use POSIX qw(strftime);
  10 use Scalar::Util qw(weaken);
  11
  12 use base qw(Exporter);
  13
  14 our @EXPORT_OK = qw(safe_string_ne safe_boolean_ne safe_num_ne typesafe_ne);
  15
  16 # We use a separate lock to block migration while a replication job
  17 # is running.
  18
  19 our $lockdir = '/var/lock/pve-manager';
  20
  21 # safe variable comparison functions
  22
  23 sub safe_num_ne {
  24     my ($a, $b) = @_;
  25
  26     return 0 if !defined($a) && !defined($b);
  27     return 1 if !defined($a);
  28     return 1 if !defined($b);
  29
  30     return $a != $b;
  31 }
  32
  33 sub safe_string_ne  {
  34     my ($a, $b) = @_;
  35
  36     return 0 if !defined($a) && !defined($b);
  37     return 1 if !defined($a);
  38     return 1 if !defined($b);
  39
  40     return $a ne $b;
  41 }
  42
  43 sub safe_boolean_ne {
  44     my ($a, $b) = @_;
  45
  46     # we don't check if value is defined, since undefined
  47     # is false (so it's a valid boolean)
  48
  49     # negate both values to normalize and compare
  50     return !$a != !$b;
  51 }
  52
  53 sub typesafe_ne {
  54     my ($a, $b, $type) = @_;
  55
  56     return 0 if !defined($a) && !defined($b);
  57     return 1 if !defined($a);
  58     return 1 if !defined($b);
  59
  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);
  66     }
  67
  68     die "internal error: can't compare $a and $b with type $type";
  69 }
  70
  71
  72 sub guest_migration_lock {
  73     my ($vmid, $timeout, $func, @param) = @_;
  74
  75     my $lockid = "pve-migrate-$vmid";
  76
  77     mkdir $lockdir;
  78
  79     my $res = PVE::Tools::lock_file("$lockdir/$lockid", $timeout, $func, @param);
  80     die $@ if $@;
  81
  82     return $res;
  83 }
  84
  85 sub check_hookscript {
  86     my ($volid, $storecfg) = @_;
  87
  88     $storecfg = PVE::Storage::config() if !defined($storecfg);
  89     my ($path, undef, $type) = PVE::Storage::path($storecfg, $volid);
  90
  91     die "'$volid' is not in the snippets directory\n"
  92         if $type ne 'snippets';
  93
  94     die "script '$volid' does not exist\n"
  95         if ! -f $path;
  96
  97     die "script '$volid' is not executable\n"
  98         if ! -x $path;
  99
 100     return $path;
 101 }
 102
 103 sub exec_hookscript {
 104     my ($conf, $vmid, $phase, $stop_on_error) = @_;
 105
 106     return if !$conf->{hookscript};
 107
 108     eval {
 109         my $hookscript = check_hookscript($conf->{hookscript});
 110         die $@ if $@;
 111
 112         PVE::Tools::run_command([$hookscript, $vmid, $phase]);
 113     };
 114     if (my $err = $@) {
 115         my $errmsg = "hookscript error for $vmid on $phase: $err\n";
 116         die $errmsg if ($stop_on_error);
 117         warn $errmsg;
 118     }
 119 }
 120
 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) = @_;
 125
 126     my $snapshots = { map { $_->{name} => $_ } @$snapshot_list };
 127
 128     my @roots;
 129     foreach my $e (@$snapshot_list) {
 130         my $parent;
 131         if (($parent = $e->{parent}) && defined $snapshots->{$parent}) {
 132             push @{$snapshots->{$parent}->{children}}, $e->{name};
 133         } else {
 134             push @roots, $e->{name};
 135         }
 136     }
 137
 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};
 143     };
 144
 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};
 150
 151         my $description = $e->{description} || 'no-description';
 152         ($description) = $description =~ m/(.*)$/m;
 153
 154         my $timestring = "";
 155         if (defined $e->{snaptime}) {
 156             $timestring = strftime("%F %H:%M:%S", localtime($e->{snaptime}));
 157         }
 158
 159         my $len = 30 - length($prefix); # for aligning the description
 160         printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description);
 161
 162         if ($e->{children}) {
 163             $prefix = "    $prefix";
 164             foreach my $child (sort $snaptimesort @{$e->{children}}) {
 165                 $snapshottree_weak->($prefix, $child, $snapshots);
 166             }
 167         }
 168     };
 169     my $snapshottree = $snapshottree_weak;
 170     weaken($snapshottree_weak);
 171
 172     foreach my $root (sort $snaptimesort @roots) {
 173         $snapshottree->('`->', $root, $snapshots);
 174     }
 175 }
 176
 177 sub format_pending {
 178     my ($data) = @_;
 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);
 187         }
 188         if (defined($v)) {
 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";
 194             } else {
 195                 print "cur $k: $v\n";
 196             }
 197         } elsif (defined($p)) {
 198             print "new $k: $p\n";
 199         }
 200     }
 201 }
 202
 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) = @_;
 210
 211     my $res = [];
 212
 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};
 219
 220         push @$res, $item;
 221     }
 222
 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};
 229
 230         push @$res, $item;
 231     }
 232
 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)};
 237         push @$res, $item;
 238     }
 239
 240     return $res;
 241 }
 242
 243 1;