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 1;