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 sub snapshot_tree {
  66     my ($res) = @_;
  67
  68     my $snapshots = { map { $_->{name} => $_ } @$res };
  69
  70     my @roots;
  71     foreach my $e (@$res) {
  72         my $parent;
  73         if (($parent = $e->{parent}) && defined $snapshots->{$parent}) {
  74             push @{$snapshots->{$parent}->{children}}, $e->{name};
  75         } else {
  76             push @roots, $e->{name};
  77         }
  78     }
  79
  80     # sort the elements by snaptime - with "current" (no snaptime) highest
  81     my $snaptimesort = sub {
  82         return +1 if !defined $snapshots->{$a}->{snaptime};
  83         return -1 if !defined $snapshots->{$b}->{snaptime};
  84         return $snapshots->{$a}->{snaptime} <=> $snapshots->{$b}->{snaptime};
  85     };
  86
  87     # recursion function for displaying the tree
  88     my $snapshottree;
  89     $snapshottree = sub {
  90         my ($prefix, $root, $snapshots) = @_;
  91         my $e = $snapshots->{$root};
  92
  93         my $description = $e->{description} || 'no-description';
  94         ($description) = $description =~ m/(.*)$/m;
  95
  96         my $timestring = "";
  97         if (defined $e->{snaptime}) {
  98             $timestring = strftime("%F %H:%M:%S", localtime($e->{snaptime}));
  99         }
 100
 101         my $len = 30 - length($prefix); # for aligning the description
 102         printf("%s %-${len}s %-23s %s\n", $prefix, $root, $timestring, $description);
 103
 104         if ($e->{children}) {
 105             $prefix = "    $prefix";
 106             foreach my $child (sort $snaptimesort @{$e->{children}}) {
 107                 $snapshottree->($prefix, $child, $snapshots);
 108             }
 109         }
 110     };
 111
 112     foreach my $root (sort $snaptimesort @roots) {
 113         $snapshottree->('`->', $root, $snapshots);
 114     }
 115 }
 116
 117 1;