diff --git a/Makefile b/Makefile index 8d48d3e7..016831e6 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ RELEASE=2.1 VERSION=2.0 PACKAGE=qemu-server -PKGREL=42 +PKGREL=43 DESTDIR= PREFIX=/usr diff --git a/PVE/Makefile b/PVE/Makefile index d2a05e10..232c881e 100644 --- a/PVE/Makefile +++ b/PVE/Makefile @@ -1,7 +1,11 @@ +PERLSOURCE = \ + QemuServer.pm \ + QemuMigrate.pm \ + QMPClient.pm .PHONY: install install: - install -D -m 0644 QemuServer.pm ${DESTDIR}${PERLDIR}/PVE/QemuServer.pm - install -D -m 0644 QemuMigrate.pm ${DESTDIR}${PERLDIR}/PVE/QemuMigrate.pm + install -d ${DESTDIR}${PERLDIR}/PVE + install -m 0644 ${PERLSOURCE} ${DESTDIR}${PERLDIR}/PVE/ make -C VZDump install make -C API2 install \ No newline at end of file diff --git a/PVE/QMPClient.pm b/PVE/QMPClient.pm index a06b2e0d..b4c79367 100755 --- a/PVE/QMPClient.pm +++ b/PVE/QMPClient.pm @@ -1,5 +1,3 @@ -#!/usr/bin/perl -w - package PVE::QMPClient; use strict; @@ -91,9 +89,6 @@ my $close_connection = sub { delete $self->{fhs_lookup}->{$fh}; $self->{mux}->close($fh); - - print "CLOSE SOCKET to $vmid\n"; - }; my $open_connection = sub { @@ -104,8 +99,6 @@ my $open_connection = sub { my $fh = IO::Socket::UNIX->new(Peer => $sname, Blocking => 0, Timeout => 1) || die "unable to connect to VM $vmid socket - $!\n"; - print "OPEN SOCKET to $vmid \n"; - $self->{fhs}->{$vmid} = $fh; $self->{fhs_lookup}->{$fh} = $vmid; $self->{mux}->add($fh); @@ -147,12 +140,10 @@ my $check_queue = sub { arguments => $cmd->{arguments}, id => $cmd->{id}}); - print "WRITECMD:$vmid: $qmpcmd\n"; $self->{mux}->write($fh, $qmpcmd); }; if (my $err = $@) { $self->{errors}->{$vmid} = $err; - # fixme: close fh? } else { $running++; } @@ -169,8 +160,6 @@ sub queue_execute { $timeout = 3 if !$timeout; - print "start exec queue\n"; - $self->{current} = {}; $self->{errors} = {}; @@ -207,9 +196,6 @@ sub queue_execute { } $self->{queue} = $self->{current} = $self->{fhs} = $self->{fhs_lookup} = {}; - - print "end exec queue $running\n"; - } # mux_input is called when input is available on one of @@ -217,8 +203,6 @@ sub queue_execute { sub mux_input { my ($self, $mux, $fh, $input) = @_; - print "GOT: $$input\n"; - return if $$input !~ m/}\r\n$/; my $raw = $$input; @@ -246,11 +230,6 @@ sub mux_input { next; } - # die $obj->{error}->{desc} if defined($obj->{error}->{desc}); - - #print "GOTOBJ: " . Dumper($obj); - - # we do not need events for now if (defined($obj->{event})) { if (my $eventcb = $self->{eventcb}) { &$eventcb($obj); @@ -287,121 +266,10 @@ sub mux_timeout { my ($self, $mux, $fh) = @_; if (my $vmid = $self->{fhs_lookup}->{$fh}) { - - print "GOT timeout for $vmid\n"; - $self->{errors}->{$vmid} = "got timeout\n"; } &$check_queue($self); } - - -package test; - -use strict; -use PVE::SafeSyslog; -use PVE::INotify; -use PVE::QemuServer; -use PVE::Cluster; -use Data::Dumper; - -initlog($0); - -$ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin'; - -die "please run as root\n" if $> != 0; - -PVE::INotify::inotify_init(); - -my $nodename = PVE::INotify::nodename(); - -sub vm_qmp_command { - my ($vmid, $cmd, $nocheck) = @_; - - my $res; - - eval { - die "VM $vmid not running\n" if !PVE::QemuServer::check_running($vmid, $nocheck); - - my $qmpclient = PVE::QMPClient->new(); - - $res = $qmpclient->cmd($vmid, $cmd); - - }; - if (my $err = $@) { - syslog("err", "VM $vmid qmp command failed - $err"); - die $err; - } - - return $res; -} - -# print Dumper(vm_qmp_command(100, { execute => 'query-status' })); - -sub update_qemu_stats { - - print "start update\n"; - - my $ctime = time(); - - my $vmstatus = PVE::QemuServer::vmstatus(); - - my $qmpclient = PVE::QMPClient->new(); - - my $res = {}; - - my $blockstatscb = sub { - my ($vmid, $resp) = @_; - my $data = $resp->{'return'} || []; - my $totalrdbytes = 0; - my $totalwrbytes = 0; - for my $blockstat (@$data) { - $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes}; - $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes}; - } - $res->{$vmid}->{diskread} = $totalrdbytes; - $res->{$vmid}->{diskwrite} = $totalwrbytes; - }; - - my $statuscb = sub { - my ($vmid, $resp) = @_; - $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats'); - - my $status = 'unknown'; - if (!defined($status = $resp->{'return'}->{status})) { - warn "unable to get VM status\n"; - return; - } - - $res->{$vmid}->{status} = $resp->{'return'}->{status}; - }; - - foreach my $vmid (keys %$vmstatus) { - my $d = $vmstatus->{$vmid}; - my $data; - if ($d->{pid}) { # running - - $qmpclient->queue_cmd($vmid, $statuscb, 'query-status'); - - } - } - print "start loop\n"; - $qmpclient->queue_execute(); - print "end loop\n"; - print Dumper($res); - foreach my $vmid (keys %{$qmpclient->{errors}}) { - my $msg = "qmp error on VM $vmid: $qmpclient->{errors}->{$vmid}"; - chomp $msg; - warn "$msg\n"; - } - - print "end update\n"; -} - -for(;;) { - PVE::Cluster::cfs_update(); - update_qemu_stats(); - sleep(3); -} +1; diff --git a/PVE/QemuServer.pm b/PVE/QemuServer.pm index 89b8454a..4927cc87 100644 --- a/PVE/QemuServer.pm +++ b/PVE/QemuServer.pm @@ -25,6 +25,7 @@ use PVE::Tools qw(run_command lock_file file_read_firstline); use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file); use PVE::INotify; use PVE::ProcFSTools; +use PVE::QMPClient; use Time::HiRes qw(gettimeofday); my $cpuinfo = PVE::ProcFSTools::read_cpuinfo(); @@ -2677,46 +2678,6 @@ sub vm_start { }); } -my $qmp_read_avail = sub { - 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 if $buf =~ (m/}\r\n$/); - } else { - if (!defined($count)) { - die "$!\n"; - } - last; - } - } - - die "qmp read timeout\n" if !scalar(@ready); - - my @jsons = split("\n", $res); - my $obj = {}; - my $event = {}; - my $return = {}; - foreach my $json (@jsons) { - $obj = from_json($json); - $event = $obj->{event} if exists $obj->{event}; - $return = $obj->{QMP} if exists $obj->{QMP}; - $return = $obj->{"return"} if exists $obj->{"return"}; - die $obj->{error}->{desc} if exists $obj->{error}->{desc} && $obj->{error}->{desc} !~ m/Connection can not be completed immediately/; - } - - return ($return,$event); -}; - sub __read_avail { my ($fh, $timeout) = @_; @@ -2826,96 +2787,31 @@ sub vm_monitor_command { sub vm_mon_cmd { my ($vmid, $execute, %params) = @_; - my $cmd = {}; - $cmd->{execute} = $execute; - $cmd->{arguments} = \%params; - vm_qmp_command($vmid,$cmd); + my $cmd = { execute => $execute, arguments => \%params }; + vm_qmp_command($vmid, $cmd); } sub vm_mon_cmd_nocheck { my ($vmid, $execute, %params) = @_; - my $cmd = {}; - $cmd->{execute} = $execute; - $cmd->{arguments} = \%params; - vm_qmp_command($vmid,$cmd,1); + my $cmd = { execute => $execute, arguments => \%params }; + vm_qmp_command($vmid, $cmd, 1); } sub vm_qmp_command { my ($vmid, $cmd, $nocheck) = @_; - #http://git.qemu.org/?p=qemu.git;a=blob;f=qmp-commands.hx;h=db980fa811325aeca8ad43472ba468702d4a25a2;hb=HEAD my $res; - my $event; + 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 $qmpclient = PVE::QMPClient->new(); - my $timeout = 3; + $res = $qmpclient->cmd($vmid, $cmd); - # maybe this works with qmp, need to be tested - - # hack: migrate sometime blocks the monitor (when migrate_downtime - # is set) - - $timeout = 60*60 if ($cmd->{execute} =~ m/(migrate)$/); - - - # 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; - - 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; - - $timeout = 20; - - my $cmdjson; - - #generate json from hash for complex cmd - $cmdjson = to_json($cmd); - - if ($cmd->{execute} =~ m/(migrate)$/) { - $timeout = 60*60; # 1 hour - } elsif ($cmd->{execute} =~ m/^(eject|change)/) { - $timeout = 60; # note: cdrom mount command is slow - } - - - if (!($b = $sock->syswrite($cmdjson)) || ($b != length($cmdjson))) { - die "monitor write error - $!"; - } - - - return if ($cmd->{execute} eq 'q') || ($cmd->{execute} eq 'quit'); - - - ($res,$event) = &$qmp_read_avail($sock, $timeout); }; - - my $err = $@; - - if ($err) { + if (my $err = $@) { syslog("err", "VM $vmid qmp command failed - $err"); die $err; } diff --git a/changelog.Debian b/changelog.Debian index 7ac37d96..6e434d18 100644 --- a/changelog.Debian +++ b/changelog.Debian @@ -1,3 +1,9 @@ +qemu-server (2.0-43) unstable; urgency=low + + * use new QMPClient code + + -- Proxmox Support Team Fri, 13 Jul 2012 07:05:28 +0200 + qemu-server (2.0-42) unstable; urgency=low * fix pool permission checks on create diff --git a/control.in b/control.in index 1c672494..49cb5e2c 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, libjson-perl, libjson-xs-perl +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, libio-multiplex-perl Conflicts: netcat-openbsd Maintainer: Proxmox Support Team Description: Qemu Server Tools