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

Dietmar Maurer dietmar at proxmox.com
Wed May 30 12:11:00 CEST 2012


committed. Thanks.

> -----Original Message-----
> From: pve-devel-bounces at pve.proxmox.com [mailto:pve-devel-
> bounces at pve.proxmox.com] On Behalf Of Alexandre Derumier
> Sent: Dienstag, 29. Mai 2012 14:02
> To: pve-devel at pve.proxmox.com
> Subject: [pve-devel] [PATCH] add basic qmp support
> 
> 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
> 
> _______________________________________________
> pve-devel mailing list
> pve-devel at pve.proxmox.com
> http://pve.proxmox.com/cgi-bin/mailman/listinfo/pve-devel





More information about the pve-devel mailing list