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
  11 # We use a separate lock to block migration while a replication job
  12 # is running.
  13
  14 our $lockdir = '/var/lock/pve-manager';
  15
  16 sub guest_migration_lock {
  17     my ($vmid, $timeout, $func, @param) = @_;
  18
  19     my $lockid = "pve-migrate-$vmid";
  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
  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};
  51
  52     eval {
  53         my $hookscript = check_hookscript($conf->{hookscript});
  54         die $@ if $@;
  55
  56         PVE::Tools::run_command([$hookscript, $vmid, $phase]);
  57     };
  58     if (my $err = $@) {
  59         my $errmsg = "hookscript error for $vmid on $phase: $err\n";
  60         die $errmsg if ($stop_on_error);
  61         warn $errmsg;
  62     }
  63 }
  64
  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) = @_;
  69
  70     my $snapshots = { map { $_->{name} => $_ } @$snapshot_list };
  71
  72     my @roots;
  73     foreach my $e (@$snapshot_list) {
  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
 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
 145 sub conf_table_with_pending {
 146     my ($conf, $pending_delete_hash) = @_;
 147
 148     my $res = [];
 149
 150     foreach my $opt (keys %$conf) {
 151         next if ref($conf->{$opt});
 152         my $item = { key => $opt };
 153         $item->{value} = $conf->{$opt} if defined($conf->{$opt});
 154         $item->{pending} = $conf->{pending}->{$opt} if defined($conf->{pending}->{$opt});
 155         $item->{delete} = ($pending_delete_hash->{$opt}->{force} ? 2 : 1) if exists $pending_delete_hash->{$opt};
 156
 157         push @$res, $item;
 158     }
 159
 160     foreach my $opt (keys %{$conf->{pending}}) {
 161         next if $opt eq 'delete';
 162         next if ref($conf->{pending}->{$opt}); # just to be sure
 163         next if defined($conf->{$opt});
 164         my $item = { key => $opt };
 165         $item->{pending} = $conf->{pending}->{$opt};
 166
 167         push @$res, $item;
 168     }
 169
 170     while (my ($opt, $force) = each %$pending_delete_hash) {
 171         next if $conf->{pending}->{$opt}; # just to be sure
 172         next if $conf->{$opt};
 173         my $item = { key => $opt, delete => ($force ? 2 : 1)};
 174         push @$res, $item;
 175     }
 176
 177     return $res;
 178 }
 179
 180 1;