[pve-devel] [PATCH] add basic qmp support

[Alexandre Derumier]

this add qmp socket to kvm process
and anew sub copied from vm_monitor_command:

vm_qmp_command ($vmid, $cmdstr, $nocheck)

$cmdstr could be a simple command to be executed, without argument

vm_qmp_command($vmid,"stop");

or a complex hash with arguments

$cmdstr->{execute}="eject";
$cmdstr->{arguments}->{device}="ide1-cd0";
vm_qmp_command($vmid,$cmdstr);

documentation about qmp commands is here
http://git.qemu.org/?p=qemu.git;a=blob;f=qmp-commands.hx;h=db980fa811325aeca8ad43472ba468702d4a25a2;hb=HEAD

Code must be polish a little more, but it's a start.

Signed-off-by: Alexandre Derumier <aderumier at odiso.com>
---
 PVE/QemuServer.pm |  127 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 control.in        |    2 +-
 2 files changed, 128 insertions(+), 1 deletions(-)

diff --git a/PVE/QemuServer.pm b/PVE/QemuServer.pm
index ad8dff1..e41f8dd 100644
--- a/PVE/QemuServer.pm
+++ b/PVE/QemuServer.pm
@@ -15,6 +15,7 @@ use Digest::SHA;
 use Fcntl ':flock';
 use Cwd 'abs_path';
 use IPC::Open3;
+use JSON;
 use Fcntl;
 use PVE::SafeSyslog;
 use Storable qw(dclone);
@@ -2061,6 +2062,10 @@ sub config_to_command {
     push @$cmd, '-chardev', "socket,id=monitor,path=$socket,server,nowait";
     push @$cmd, '-mon', "chardev=monitor,mode=readline";
 
+    my $qmpsocket = qmp_socket($vmid);
+    push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
+    push @$cmd, '-mon', "chardev=qmp,mode=control";
+
     $socket = vnc_socket($vmid);
     push @$cmd,  '-vnc', "unix:$socket,x509,password";
 
@@ -2326,6 +2331,11 @@ sub monitor_socket {
     return "${var_run_tmpdir}/$vmid.mon";
 }
 
+sub qmp_socket {
+    my ($vmid) = @_;
+    return "${var_run_tmpdir}/$vmid.qmp";
+}
+
 sub pidfile_name {
     my ($vmid) = @_;
     return "${var_run_tmpdir}/$vmid.pid";
@@ -2668,6 +2678,34 @@ sub vm_start {
     });
 }
 
+sub qmp__read_avail {
+    my ($fh, $timeout) = @_;
+
+    my $sel = new IO::Select;
+    $sel->add($fh);
+
+    my $res = '';
+    my $buf;
+
+    my @ready;
+    while (scalar (@ready = $sel->can_read($timeout))) {
+	my $count;
+	if ($count = $fh->sysread($buf, 8192)) {
+		$res .= $buf;
+		last;
+	} else {
+	    if (!defined($count)) {
+		die "$!\n";
+	    }
+	    last;
+	}
+    }
+
+    die "qmp read timeout\n" if !scalar(@ready);
+    my $obj = from_json($res);
+    return $obj;
+}
+
 sub __read_avail {
     my ($fh, $timeout) = @_;
 
@@ -2774,6 +2812,95 @@ sub vm_monitor_command {
     return $res;
 }
 
+sub vm_qmp_command {
+    my ($vmid, $cmdstr, $nocheck) = @_;
+    #http://git.qemu.org/?p=qemu.git;a=blob;f=qmp-commands.hx;h=db980fa811325aeca8ad43472ba468702d4a25a2;hb=HEAD
+    my $res;
+
+    eval {
+	die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
+
+	my $sname = qmp_socket($vmid);
+	my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
+            die "unable to connect to VM $vmid socket - $!\n";
+
+
+	my $timeout = 3;
+        
+	# maybe this works with qmp, need to be tested 
+
+	# hack: migrate sometime blocks the monitor (when migrate_downtime
+	# is set)
+	#if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
+	#    $timeout = 60*60; # 1 hour
+	#}
+
+	# read banner;
+	my $data = qmp__read_avail($sock, $timeout);
+	# '{"QMP": {"version": {"qemu": {"micro": 93, "minor": 0, "major": 1}, "package": " (qemu-kvm-devel)"}, "capabilities": []}} ';
+	die "got unexpected qemu qmp banner\n" if !$data->{QMP};
+
+	my $sel = new IO::Select;
+	$sel->add($sock);
+
+        #negociation
+        my $negociation = '{ "execute": "qmp_capabilities" }';
+        
+        if (!scalar(my @ready = $sel->can_write($timeout))) {
+	    die "monitor write error - timeout";
+        }
+
+        my $b;
+        if (!($b = $sock->syswrite($negociation)) || ($b != length($negociation))) {
+            die "monitor write error - $!";
+        }
+
+        $res = qmp__read_avail($sock, $timeout);
+        #  res = '{"return": {}}
+        die "qmp negociation error\n" if !$res->{return};
+
+
+	$timeout = 20;
+
+
+	my $fullcmd = undef;	
+	#generate json from hash for complex cmd
+	if (ref($cmdstr) eq "HASH") {
+		$fullcmd = to_json($cmdstr);
+
+		if ($fullcmd->{execute}  =~ m/^(info\s+migrate|migrate\s)/) {
+		      $timeout = 60*60; # 1 hour
+		} elsif ($fullcmd->{execute} =~ m/^(eject|change)/) {
+		      $timeout = 60; # note: cdrom mount command is slow
+		}
+	}
+	#execute command for simple action
+	else {
+		$fullcmd = '{ "execute": "'.$cmdstr.'" }';
+	}
+	
+	if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
+	    die "monitor write error - $!";
+	}
+
+	if (ref($cmdstr) ne "HASH") {
+	  return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
+	}
+
+	$res = qmp__read_avail($sock, $timeout);
+
+    };
+
+    my $err = $@;
+
+    if ($err) {
+	syslog("err", "VM $vmid qmp command failed - $err");
+	die $err;
+    }
+
+    return $res;
+}
+
 sub vm_commandline {
     my ($storecfg, $vmid) = @_;
 
diff --git a/control.in b/control.in
index df6ee9c..1c67249 100644
--- a/control.in
+++ b/control.in
@@ -3,7 +3,7 @@ Version: @@VERSION@@-@@PKGRELEASE@@
 Section: admin
 Priority: optional
 Architecture: @@ARCH@@
-Depends: libc6 (>= 2.7-18), perl (>= 5.10.0-19), libterm-readline-gnu-perl, pve-qemu-kvm (>= 0.11.1) | pve-qemu-kvm-2.6.18, netcat-traditional, libpve-storage-perl, pve-cluster, redhat-cluster-pve
+Depends: libc6 (>= 2.7-18), perl (>= 5.10.0-19), libterm-readline-gnu-perl, pve-qemu-kvm (>= 0.11.1) | pve-qemu-kvm-2.6.18, netcat-traditional, libpve-storage-perl, pve-cluster, redhat-cluster-pve, libjson-perl, libjson-xs-perl
 Conflicts: netcat-openbsd
 Maintainer: Proxmox Support Team <support at proxmox.com>
 Description: Qemu Server Tools
-- 
1.7.2.5