include additional info in snapshot list

[qemu-server.git] / PVE / QMPClient.pm

diff --git a/PVE/QMPClient.pm b/PVE/QMPClient.pm
index b4c79367c3c1abc3db1cb50b7c233902e71c84d9..6fcce685aefd0e92ce79ab631acacdfdaeaf5360 100755 (executable)
--- a/PVE/QMPClient.pm
+++ b/PVE/QMPClient.pm
@@ -4,7 +4,10 @@ use strict;
 #use PVE::SafeSyslog;
 use PVE::QemuServer;
 use IO::Multiplex;
+use POSIX qw(EINTR EAGAIN);
 use JSON;
+use Time::HiRes qw(usleep gettimeofday tv_interval);
+
 use Data::Dumper;
 
 # Qemu Monitor Protocol (QMP) client.
@@ -50,7 +53,7 @@ sub queue_cmd {
 
 # execute a single command
 sub cmd {
-    my ($self, $vmid, $cmd) = @_;
+    my ($self, $vmid, $cmd, $timeout) = @_;
 
     my $result;
 
@@ -59,12 +62,30 @@ sub cmd {
        $result = $resp->{'return'};
     };
 
+    die "no command specified" if !($cmd &&  $cmd->{execute});
+
     $cmd->{callback} = $callback;
     $cmd->{arguments} = {} if !defined($cmd->{arguments});
 
     $self->{queue}->{$vmid} = [ $cmd ];
 
-    $self->queue_execute();
+    if (!$timeout) {
+       # hack: monitor sometime blocks
+       if ($cmd->{execute} eq 'query-migrate') {
+           $timeout = 60*60; # 1 hour
+       } elsif ($cmd->{execute} =~ m/^(eject|change)/) {
+           $timeout = 60; # note: cdrom mount command is slow
+       } elsif ($cmd->{execute} eq 'snapshot-start' ||
+                $cmd->{execute} eq 'snapshot-end' ||
+                $cmd->{execute} eq 'delete-drive-snapshot' ||
+                $cmd->{execute} eq 'snapshot-drive'  ) {
+           $timeout = 10*60; # 10 mins ?
+       } else {
+           $timeout = 3; # default
+       }
+    }
+
+    $self->queue_execute($timeout);
 
     my $cmdstr = $cmd->{execute} || '';
     die "VM $vmid qmp command '$cmdstr' failed - $self->{errors}->{$vmid}"
@@ -96,8 +117,22 @@ my $open_connection = sub {
 
     my $sname = PVE::QemuServer::qmp_socket($vmid);
 
-    my $fh = IO::Socket::UNIX->new(Peer => $sname, Blocking => 0, Timeout => 1) ||
-       die "unable to connect to VM $vmid socket - $!\n";
+    my $fh;
+    my $starttime = [gettimeofday];
+    my $count = 0;
+    for (;;) {
+       $count++;
+       $fh = IO::Socket::UNIX->new(Peer => $sname, Blocking => 0, Timeout => 1);
+       last if $fh;
+       if ($! != EINTR && $! != EAGAIN) {
+           die "unable to connect to VM $vmid socket - $!\n";
+       }
+       my $elapsed = tv_interval($starttime, [gettimeofday]);
+       if ($elapsed > 1) {
+           die "unable to connect to VM $vmid socket - timeout after $count retries\n";
+       }
+       usleep(100000);
+    }
 
     $self->{fhs}->{$vmid} = $fh;
     $self->{fhs_lookup}->{$fh} = $vmid;