PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use POSIX;
   5 use IO::Handle;
   6 use IO::Select;
   7 use IO::File;
   8 use IO::Dir;
   9 use IO::Socket::UNIX;
  10 use File::Basename;
  11 use File::Path;
  12 use File::stat;
  13 use Getopt::Long;
  14 use Digest::SHA;
  15 use Fcntl ':flock';
  16 use Cwd 'abs_path';
  17 use IPC::Open3;
  18 use JSON;
  19 use Fcntl;
  20 use PVE::SafeSyslog;
  21 use Storable qw(dclone);
  22 use PVE::Exception qw(raise raise_param_exc);
  23 use PVE::Storage;
  24 use PVE::Tools qw(run_command lock_file file_read_firstline);
  25 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  26 use PVE::INotify;
  27 use PVE::ProcFSTools;
  28 use PVE::QMPClient;
  29 use Time::HiRes qw(gettimeofday);
  30
  31 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  32
  33 # Note about locking: we use flock on the config file protect
  34 # against concurent actions.
  35 # Aditionaly, we have a 'lock' setting in the config file. This
  36 # can be set to 'migrate' or 'backup'. Most actions are not
  37 # allowed when such lock is set. But you can ignore this kind of
  38 # lock with the --skiplock flag.
  39
  40 cfs_register_file('/qemu-server/',
  41                   \&parse_vm_config,
  42                   \&write_vm_config);
  43
  44 PVE::JSONSchema::register_standard_option('skiplock', {
  45     description => "Ignore locks - only root is allowed to use this option.",
  46     type => 'boolean',
  47     optional => 1,
  48 });
  49
  50 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  51     description => "Some command save/restore state from this location.",
  52     type => 'string',
  53     maxLength => 128,
  54     optional => 1,
  55 });
  56
  57 #no warnings 'redefine';
  58
  59 unless(defined(&_VZSYSCALLS_H_)) {
  60     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  61     require 'sys/syscall.ph';
  62     if(defined(&__x86_64__)) {
  63         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  64         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  65         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  66         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  67         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  68         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  69         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  70         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  71     }
  72     elsif(defined( &__i386__) ) {
  73         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  74         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  75         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  76         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  77         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  78         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  79         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  80         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  81     } else {
  82         die("no fairsched syscall for this arch");
  83     }
  84     require 'asm/ioctl.ph';
  85     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  86 }
  87
  88 sub fairsched_mknod {
  89     my ($parent, $weight, $desired) = @_;
  90
  91     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
  92 }
  93
  94 sub fairsched_rmnod {
  95     my ($id) = @_;
  96
  97     return syscall(&__NR_fairsched_rmnod, int($id));
  98 }
  99
 100 sub fairsched_mvpr {
 101     my ($pid, $newid) = @_;
 102
 103     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 104 }
 105
 106 sub fairsched_vcpus {
 107     my ($id, $vcpus) = @_;
 108
 109     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 110 }
 111
 112 sub fairsched_rate {
 113     my ($id, $op, $rate) = @_;
 114
 115     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 116 }
 117
 118 use constant FAIRSCHED_SET_RATE  => 0;
 119 use constant FAIRSCHED_DROP_RATE => 1;
 120 use constant FAIRSCHED_GET_RATE  => 2;
 121
 122 sub fairsched_cpulimit {
 123     my ($id, $limit) = @_;
 124
 125     my $cpulim1024 = int($limit * 1024 / 100);
 126     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 127
 128     return fairsched_rate($id, $op, $cpulim1024);
 129 }
 130
 131 my $nodename = PVE::INotify::nodename();
 132
 133 mkdir "/etc/pve/nodes/$nodename";
 134 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 135 mkdir $confdir;
 136
 137 my $var_run_tmpdir = "/var/run/qemu-server";
 138 mkdir $var_run_tmpdir;
 139
 140 my $lock_dir = "/var/lock/qemu-server";
 141 mkdir $lock_dir;
 142
 143 my $pcisysfs = "/sys/bus/pci";
 144
 145 my $confdesc = {
 146     onboot => {
 147         optional => 1,
 148         type => 'boolean',
 149         description => "Specifies whether a VM will be started during system bootup.",
 150         default => 0,
 151     },
 152     autostart => {
 153         optional => 1,
 154         type => 'boolean',
 155         description => "Automatic restart after crash (currently ignored).",
 156         default => 0,
 157     },
 158     hotplug => {
 159         optional => 1,
 160         type => 'boolean',
 161         description => "Activate hotplug for disk and network device",
 162         default => 0,
 163     },
 164     reboot => {
 165         optional => 1,
 166         type => 'boolean',
 167         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 168         default => 1,
 169     },
 170     lock => {
 171         optional => 1,
 172         type => 'string',
 173         description => "Lock/unlock the VM.",
 174         enum => [qw(migrate backup)],
 175     },
 176     cpulimit => {
 177         optional => 1,
 178         type => 'integer',
 179         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 180         minimum => 0,
 181         default => 0,
 182     },
 183     cpuunits => {
 184         optional => 1,
 185         type => 'integer',
 186         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 187         minimum => 0,
 188         maximum => 500000,
 189         default => 1000,
 190     },
 191     memory => {
 192         optional => 1,
 193         type => 'integer',
 194         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 195         minimum => 16,
 196         default => 512,
 197     },
 198     balloon => {
 199         optional => 1,
 200         type => 'integer',
 201         description => "Amount of target RAM for the VM in MB.",
 202         minimum => 16,
 203     },
 204     keyboard => {
 205         optional => 1,
 206         type => 'string',
 207         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 208         enum => PVE::Tools::kvmkeymaplist(),
 209         default => 'en-us',
 210     },
 211     name => {
 212         optional => 1,
 213         type => 'string', format => 'dns-name',
 214         description => "Set a name for the VM. Only used on the configuration web interface.",
 215     },
 216     scsihw => {
 217         optional => 1,
 218         type => 'string',
 219         description => "scsi controller model",
 220         enum => [qw(lsi virtio-scsi-pci)],
 221         default => 'lsi',
 222     },
 223     description => {
 224         optional => 1,
 225         type => 'string',
 226         description => "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
 227     },
 228     ostype => {
 229         optional => 1,
 230         type => 'string',
 231         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26)],
 232         description => <<EODESC,
 233 Used to enable special optimization/features for specific
 234 operating systems:
 235
 236 other  => unspecified OS
 237 wxp    => Microsoft Windows XP
 238 w2k    => Microsoft Windows 2000
 239 w2k3   => Microsoft Windows 2003
 240 w2k8   => Microsoft Windows 2008
 241 wvista => Microsoft Windows Vista
 242 win7   => Microsoft Windows 7
 243 l24    => Linux 2.4 Kernel
 244 l26    => Linux 2.6/3.X Kernel
 245
 246 other|l24|l26                  ... no special behaviour
 247 wxp|w2k|w2k3|w2k8|wvista|win7  ... use --localtime switch
 248 EODESC
 249     },
 250     boot => {
 251         optional => 1,
 252         type => 'string',
 253         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 254         pattern => '[acdn]{1,4}',
 255         default => 'cdn',
 256     },
 257     bootdisk => {
 258         optional => 1,
 259         type => 'string', format => 'pve-qm-bootdisk',
 260         description => "Enable booting from specified disk.",
 261         pattern => '(ide|scsi|virtio)\d+',
 262     },
 263     smp => {
 264         optional => 1,
 265         type => 'integer',
 266         description => "The number of CPUs. Please use option -sockets instead.",
 267         minimum => 1,
 268         default => 1,
 269     },
 270     sockets => {
 271         optional => 1,
 272         type => 'integer',
 273         description => "The number of CPU sockets.",
 274         minimum => 1,
 275         default => 1,
 276     },
 277     cores => {
 278         optional => 1,
 279         type => 'integer',
 280         description => "The number of cores per socket.",
 281         minimum => 1,
 282         default => 1,
 283     },
 284     acpi => {
 285         optional => 1,
 286         type => 'boolean',
 287         description => "Enable/disable ACPI.",
 288         default => 1,
 289     },
 290     kvm => {
 291         optional => 1,
 292         type => 'boolean',
 293         description => "Enable/disable KVM hardware virtualization.",
 294         default => 1,
 295     },
 296     tdf => {
 297         optional => 1,
 298         type => 'boolean',
 299         description => "Enable/disable time drift fix. This is ignored for kvm versions newer that 1.0 (not needed anymore).",
 300         default => 1,
 301     },
 302     localtime => {
 303         optional => 1,
 304         type => 'boolean',
 305         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 306     },
 307     freeze => {
 308         optional => 1,
 309         type => 'boolean',
 310         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 311     },
 312     vga => {
 313         optional => 1,
 314         type => 'string',
 315         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win7/w2k8, and 'cirrur' for other OS types",
 316         enum => [qw(std cirrus vmware)],
 317     },
 318     watchdog => {
 319         optional => 1,
 320         type => 'string', format => 'pve-qm-watchdog',
 321         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 322         description => "Create a virtual hardware watchdog device.  Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
 323     },
 324     startdate => {
 325         optional => 1,
 326         type => 'string',
 327         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 328         description => "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
 329         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 330         default => 'now',
 331     },
 332     startup => {
 333         optional => 1,
 334         type => 'string', format => 'pve-qm-startup',
 335         typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 336         description => "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
 337     },
 338     args => {
 339         optional => 1,
 340         type => 'string',
 341         description => <<EODESCR,
 342 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 343
 344 args: -no-reboot -no-hpet
 345 EODESCR
 346     },
 347     tablet => {
 348         optional => 1,
 349         type => 'boolean',
 350         default => 1,
 351         description => "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
 352     },
 353     migrate_speed => {
 354         optional => 1,
 355         type => 'integer',
 356         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 357         minimum => 0,
 358         default => 0,
 359     },
 360     migrate_downtime => {
 361         optional => 1,
 362         type => 'integer',
 363         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 364         minimum => 0,
 365         default => 1,
 366     },
 367     cdrom => {
 368         optional => 1,
 369         type => 'string', format => 'pve-qm-drive',
 370         typetext => 'volume',
 371         description => "This is an alias for option -ide2",
 372     },
 373     cpu => {
 374         optional => 1,
 375         description => "Emulated CPU type.",
 376         type => 'string',
 377         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom cpu64-rhel6 cpu64-rhel5 Conroe Penryn Nehalem Westmere Opteron_G1 Opteron_G2 Opteron_G3 host) ],
 378         default => 'qemu64',
 379     },
 380 };
 381
 382 # what about other qemu settings ?
 383 #cpu => 'string',
 384 #machine => 'string',
 385 #fda => 'file',
 386 #fdb => 'file',
 387 #mtdblock => 'file',
 388 #sd => 'file',
 389 #pflash => 'file',
 390 #snapshot => 'bool',
 391 #bootp => 'file',
 392 ##tftp => 'dir',
 393 ##smb => 'dir',
 394 #kernel => 'file',
 395 #append => 'string',
 396 #initrd => 'file',
 397 ##soundhw => 'string',
 398
 399 while (my ($k, $v) = each %$confdesc) {
 400     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 401 }
 402
 403 my $MAX_IDE_DISKS = 4;
 404 my $MAX_SCSI_DISKS = 14;
 405 my $MAX_VIRTIO_DISKS = 6;
 406 my $MAX_SATA_DISKS = 6;
 407 my $MAX_USB_DEVICES = 5;
 408 my $MAX_NETS = 6;
 409 my $MAX_UNUSED_DISKS = 8;
 410 my $MAX_HOSTPCI_DEVICES = 2;
 411 my $MAX_SERIAL_PORTS = 4;
 412 my $MAX_PARALLEL_PORTS = 3;
 413
 414 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 415                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
 416 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 417
 418 # fixme:
 419 my $netdesc = {
 420     optional => 1,
 421     type => 'string', format => 'pve-qm-net',
 422     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
 423     description => <<EODESCR,
 424 Specify network devices.
 425
 426 MODEL is one of: $nic_model_list_txt
 427
 428 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 429 automatically generated if not specified.
 430
 431 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 432
 433 Option 'rate' is used to limit traffic bandwidth from and to this interface. It is specified as floating point number, unit is 'Megabytes per second'.
 434
 435 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 436
 437 10.0.2.2   Gateway
 438 10.0.2.3   DNS Server
 439 10.0.2.4   SMB Server
 440
 441 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 442
 443 EODESCR
 444 };
 445 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 446
 447 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 448     $confdesc->{"net$i"} = $netdesc;
 449 }
 450
 451 my $drivename_hash;
 452
 453 my $idedesc = {
 454     optional => 1,
 455     type => 'string', format => 'pve-qm-drive',
 456     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 457     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to 3).",
 458 };
 459 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 460
 461 my $scsidesc = {
 462     optional => 1,
 463     type => 'string', format => 'pve-qm-drive',
 464     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 465     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to 13).",
 466 };
 467 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 468
 469 my $satadesc = {
 470     optional => 1,
 471     type => 'string', format => 'pve-qm-drive',
 472     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 473     description => "Use volume as SATA hard disk or CD-ROM (n is 0 to 5).",
 474 };
 475 PVE::JSONSchema::register_standard_option("pve-qm-sata", $satadesc);
 476
 477 my $virtiodesc = {
 478     optional => 1,
 479     type => 'string', format => 'pve-qm-drive',
 480     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 481     description => "Use volume as VIRTIO hard disk (n is 0 to 5).",
 482 };
 483 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 484
 485 my $usbdesc = {
 486     optional => 1,
 487     type => 'string', format => 'pve-qm-usb-device',
 488     typetext => 'host=HOSTUSBDEVICE',
 489     description => <<EODESCR,
 490 Configure an USB device (n is 0 to 4). This can be used to
 491 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 492
 493 'bus-port(.port)*' (decimal numbers) or
 494 'vendor_id:product_id' (hexadeciaml numbers)
 495
 496 You can use the 'lsusb -t' command to list existing usb devices.
 497
 498 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 499
 500 EODESCR
 501 };
 502 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 503
 504 my $hostpcidesc = {
 505         optional => 1,
 506         type => 'string', format => 'pve-qm-hostpci',
 507         typetext => "HOSTPCIDEVICE",
 508         description => <<EODESCR,
 509 Map host pci devices. HOSTPCIDEVICE syntax is:
 510
 511 'bus:dev.func' (hexadecimal numbers)
 512
 513 You can us the 'lspci' command to list existing pci devices.
 514
 515 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 516
 517 Experimental: user reported problems with this option.
 518 EODESCR
 519 };
 520 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 521
 522 my $serialdesc = {
 523         optional => 1,
 524         type => 'string',
 525         pattern => '/dev/ttyS\d+',
 526         description =>  <<EODESCR,
 527 Map host serial devices (n is 0 to 3).
 528
 529 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 530
 531 Experimental: user reported problems with this option.
 532 EODESCR
 533 };
 534
 535 my $paralleldesc= {
 536         optional => 1,
 537         type => 'string',
 538         pattern => '/dev/parport\d+',
 539         description =>  <<EODESCR,
 540 Map host parallel devices (n is 0 to 2).
 541
 542 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 543
 544 Experimental: user reported problems with this option.
 545 EODESCR
 546 };
 547
 548 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 549     $confdesc->{"parallel$i"} = $paralleldesc;
 550 }
 551
 552 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 553     $confdesc->{"serial$i"} = $serialdesc;
 554 }
 555
 556 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 557     $confdesc->{"hostpci$i"} = $hostpcidesc;
 558 }
 559
 560 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 561     $drivename_hash->{"ide$i"} = 1;
 562     $confdesc->{"ide$i"} = $idedesc;
 563 }
 564
 565 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++)  {
 566     $drivename_hash->{"sata$i"} = 1;
 567     $confdesc->{"sata$i"} = $satadesc;
 568 }
 569
 570 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 571     $drivename_hash->{"scsi$i"} = 1;
 572     $confdesc->{"scsi$i"} = $scsidesc ;
 573 }
 574
 575 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 576     $drivename_hash->{"virtio$i"} = 1;
 577     $confdesc->{"virtio$i"} = $virtiodesc;
 578 }
 579
 580 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 581     $confdesc->{"usb$i"} = $usbdesc;
 582 }
 583
 584 my $unuseddesc = {
 585     optional => 1,
 586     type => 'string', format => 'pve-volume-id',
 587     description => "Reference to unused volumes.",
 588 };
 589
 590 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 591     $confdesc->{"unused$i"} = $unuseddesc;
 592 }
 593
 594 my $kvm_api_version = 0;
 595
 596 sub kvm_version {
 597
 598     return $kvm_api_version if $kvm_api_version;
 599
 600     my $fh = IO::File->new("</dev/kvm") ||
 601         return 0;
 602
 603     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 604         $kvm_api_version = $v;
 605     }
 606
 607     $fh->close();
 608
 609     return  $kvm_api_version;
 610 }
 611
 612 my $kvm_user_version;
 613
 614 sub kvm_user_version {
 615
 616     return $kvm_user_version if $kvm_user_version;
 617
 618     $kvm_user_version = 'unknown';
 619
 620     my $tmp = `kvm -help 2>/dev/null`;
 621
 622     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?) /) {
 623         $kvm_user_version = $2;
 624     }
 625
 626     return $kvm_user_version;
 627
 628 }
 629
 630 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 631
 632 sub disknames {
 633     # order is important - used to autoselect boot disk
 634     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 635             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 636             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
 637             (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
 638 }
 639
 640 sub valid_drivename {
 641     my $dev = shift;
 642
 643     return defined($drivename_hash->{$dev});
 644 }
 645
 646 sub option_exists {
 647     my $key = shift;
 648     return defined($confdesc->{$key});
 649 }
 650
 651 sub nic_models {
 652     return $nic_model_list;
 653 }
 654
 655 sub os_list_description {
 656
 657     return {
 658         other => 'Other',
 659         wxp => 'Windows XP',
 660         w2k => 'Windows 2000',
 661         w2k3 =>, 'Windows 2003',
 662         w2k8 => 'Windows 2008',
 663         wvista => 'Windows Vista',
 664         win7 => 'Windows 7',
 665         l24 => 'Linux 2.4',
 666         l26 => 'Linux 2.6',
 667     };
 668 }
 669
 670 my $cdrom_path;
 671
 672 sub get_cdrom_path {
 673
 674     return  $cdrom_path if $cdrom_path;
 675
 676     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 677     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 678     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 679 }
 680
 681 sub get_iso_path {
 682     my ($storecfg, $vmid, $cdrom) = @_;
 683
 684     if ($cdrom eq 'cdrom') {
 685         return get_cdrom_path();
 686     } elsif ($cdrom eq 'none') {
 687         return '';
 688     } elsif ($cdrom =~ m|^/|) {
 689         return $cdrom;
 690     } else {
 691         return PVE::Storage::path($storecfg, $cdrom);
 692     }
 693 }
 694
 695 # try to convert old style file names to volume IDs
 696 sub filename_to_volume_id {
 697     my ($vmid, $file, $media) = @_;
 698
 699     if (!($file eq 'none' || $file eq 'cdrom' ||
 700           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 701
 702         return undef if $file =~ m|/|;
 703
 704         if ($media && $media eq 'cdrom') {
 705             $file = "local:iso/$file";
 706         } else {
 707             $file = "local:$vmid/$file";
 708         }
 709     }
 710
 711     return $file;
 712 }
 713
 714 sub verify_media_type {
 715     my ($opt, $vtype, $media) = @_;
 716
 717     return if !$media;
 718
 719     my $etype;
 720     if ($media eq 'disk') {
 721         $etype = 'images';
 722     } elsif ($media eq 'cdrom') {
 723         $etype = 'iso';
 724     } else {
 725         die "internal error";
 726     }
 727
 728     return if ($vtype eq $etype);
 729
 730     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 731 }
 732
 733 sub cleanup_drive_path {
 734     my ($opt, $storecfg, $drive) = @_;
 735
 736     # try to convert filesystem paths to volume IDs
 737
 738     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 739         ($drive->{file} !~ m|^/dev/.+|) &&
 740         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 741         ($drive->{file} !~ m/^\d+$/)) {
 742         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 743         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 744         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 745         verify_media_type($opt, $vtype, $drive->{media});
 746         $drive->{file} = $volid;
 747     }
 748
 749     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 750 }
 751
 752 sub create_conf_nolock {
 753     my ($vmid, $settings) = @_;
 754
 755     my $filename = config_file($vmid);
 756
 757     die "configuration file '$filename' already exists\n" if -f $filename;
 758
 759     my $defaults = load_defaults();
 760
 761     $settings->{name} = "vm$vmid" if !$settings->{name};
 762     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 763
 764     my $data = '';
 765     foreach my $opt (keys %$settings) {
 766         next if !$confdesc->{$opt};
 767
 768         my $value = $settings->{$opt};
 769         next if !$value;
 770
 771         $data .= "$opt: $value\n";
 772     }
 773
 774     PVE::Tools::file_set_contents($filename, $data);
 775 }
 776
 777 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 778 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 779 #        [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
 780 #        [,aio=native|threads]
 781
 782 sub parse_drive {
 783     my ($key, $data) = @_;
 784
 785     my $res = {};
 786
 787     # $key may be undefined - used to verify JSON parameters
 788     if (!defined($key)) {
 789         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 790         $res->{index} = 0;
 791     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 792         $res->{interface} = $1;
 793         $res->{index} = $2;
 794     } else {
 795         return undef;
 796     }
 797
 798     foreach my $p (split (/,/, $data)) {
 799         next if $p =~ m/^\s*$/;
 800
 801         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|bps_rd|bps_wr|iops|iops_rd|iops_wr|size)=(.+)$/) {
 802             my ($k, $v) = ($1, $2);
 803
 804             $k = 'file' if $k eq 'volume';
 805
 806             return undef if defined $res->{$k};
 807
 808             $res->{$k} = $v;
 809         } else {
 810             if (!$res->{file} && $p !~ m/=/) {
 811                 $res->{file} = $p;
 812             } else {
 813                 return undef;
 814             }
 815         }
 816     }
 817
 818     return undef if !$res->{file};
 819
 820     return undef if $res->{cache} &&
 821         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
 822     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 823     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 824     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 825     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 826     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 827     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
 828     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
 829     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
 830     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
 831     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 832     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
 833
 834     return undef if $res->{bps_rd} && $res->{bps};
 835     return undef if $res->{bps_wr} && $res->{bps};
 836     return undef if $res->{iops_rd} && $res->{iops};
 837     return undef if $res->{iops_wr} && $res->{iops};
 838
 839     return undef if $res->{bps} && $res->{bps} !~ m/^\d+$/;
 840     return undef if $res->{bps_rd} && $res->{bps_rd} !~ m/^\d+$/;
 841     return undef if $res->{bps_wr} && $res->{bps_wr} !~ m/^\d+$/;
 842     return undef if $res->{iops} && $res->{iops} !~ m/^\d+$/;
 843     return undef if $res->{iops_rd} && $res->{iops_rd} !~ m/^\d+$/;
 844     return undef if $res->{iops_wr} && $res->{iops_wr} !~ m/^\d+$/;
 845
 846
 847     if ($res->{size}) {
 848         return undef if $res->{size} !~ m/^([1-9]\d*(\.\d+)?)([KMG])?$/;
 849         my ($size, $unit) = ($1, $3);
 850         if ($unit) {
 851             if ($unit eq 'K') {
 852                 $size = $size * 1024;
 853             } elsif ($unit eq 'M') {
 854                 $size = $size * 1024 * 1024;
 855             } elsif ($unit eq 'G') {
 856                 $size = $size * 1024 * 1024 * 1024;
 857             }
 858         }
 859         $res->{size} = int($size);
 860     }
 861
 862     if ($res->{media} && ($res->{media} eq 'cdrom')) {
 863         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
 864         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
 865         return undef if $res->{interface} eq 'virtio';
 866     }
 867
 868     # rerror does not work with scsi drives
 869     if ($res->{rerror}) {
 870         return undef if $res->{interface} eq 'scsi';
 871     }
 872
 873     return $res;
 874 }
 875
 876 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio bps bps_rd bps_wr iops iops_rd iops_wr);
 877
 878 my $format_size = sub {
 879     my ($size) = @_;
 880
 881     $size = int($size);
 882
 883     my $kb = int($size/1024);
 884     return $size if $kb*1024 != $size;
 885
 886     my $mb = int($kb/1024);
 887     return "${kb}K" if $mb*1024 != $kb;
 888
 889     my $gb = int($mb/1024);
 890     return "${mb}M" if $gb*1024 != $mb;
 891
 892     return "${gb}G";
 893 };
 894
 895 sub print_drive {
 896     my ($vmid, $drive) = @_;
 897
 898     my $opts = '';
 899     foreach my $o (@qemu_drive_options, 'backup') {
 900         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 901     }
 902
 903     if ($drive->{size}) {
 904         $opts .= ",size=" . &$format_size($drive->{size});
 905     }
 906
 907     return "$drive->{file}$opts";
 908 }
 909
 910 sub scsi_inquiry {
 911     my($fh, $noerr) = @_;
 912
 913     my $SG_IO = 0x2285;
 914     my $SG_GET_VERSION_NUM = 0x2282;
 915
 916     my $versionbuf = "\x00" x 8;
 917     my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
 918     if (!$ret) {
 919         die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
 920         return undef;
 921     }
 922     my $version = unpack("I", $versionbuf);
 923     if ($version < 30000) {
 924         die "scsi generic interface too old\n"  if !$noerr;
 925         return undef;
 926     }
 927
 928     my $buf = "\x00" x 36;
 929     my $sensebuf = "\x00" x 8;
 930     my $cmd = pack("C x3 C x11", 0x12, 36);
 931
 932     # see /usr/include/scsi/sg.h
 933     my $sg_io_hdr_t = "i i C C s I P P P I I i P C C C C S S i I I";
 934
 935     my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
 936                       length($sensebuf), 0, length($buf), $buf,
 937                       $cmd, $sensebuf, 6000);
 938
 939     $ret = ioctl($fh, $SG_IO, $packet);
 940     if (!$ret) {
 941         die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
 942         return undef;
 943     }
 944
 945     my @res = unpack($sg_io_hdr_t, $packet);
 946     if ($res[17] || $res[18]) {
 947         die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
 948         return undef;
 949     }
 950
 951     my $res = {};
 952     ($res->{device}, $res->{removable}, $res->{venodor},
 953      $res->{product}, $res->{revision}) = unpack("C C x6 A8 A16 A4", $buf);
 954
 955     return $res;
 956 }
 957
 958 sub path_is_scsi {
 959     my ($path) = @_;
 960
 961     my $fh = IO::File->new("+<$path") || return undef;
 962     my $res = scsi_inquiry($fh, 1);
 963     close($fh);
 964
 965     return $res;
 966 }
 967
 968 sub print_drivedevice_full {
 969     my ($storecfg, $conf, $vmid, $drive) = @_;
 970
 971     my $device = '';
 972     my $maxdev = 0;
 973
 974     if ($drive->{interface} eq 'virtio') {
 975         my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}");
 976         $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
 977     } elsif ($drive->{interface} eq 'scsi') {
 978         $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
 979         my $controller = int($drive->{index} / $maxdev);
 980         my $unit = $drive->{index} % $maxdev;
 981         my $devicetype = 'hd';
 982         my $path = '';
 983         if (drive_is_cdrom($drive)) {
 984               $devicetype = 'cd';
 985           } else {
 986               if ($drive->{file} =~ m|^/|) {
 987                   $path = $drive->{file};
 988               } else {
 989                   $path = PVE::Storage::path($storecfg, $drive->{file});
 990               }
 991               $devicetype = 'block' if path_is_scsi($path);
 992          }
 993
 994         if (!$conf->{scsihw} || $conf->{scsihw} eq 'lsi'){
 995             $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}" if !$conf->{scsihw} || $conf->{scsihw} eq 'lsi';
 996         } else {
 997             $device = "scsi-$devicetype,bus=scsihw$controller.0,channel=0,scsi-id=0,lun=$drive->{index},drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
 998         }
 999
1000     } elsif ($drive->{interface} eq 'ide'){
1001         $maxdev = 2;
1002         my $controller = int($drive->{index} / $maxdev);
1003         my $unit = $drive->{index} % $maxdev;
1004         my $devicetype = ($drive->{media} && $drive->{media} eq 'cdrom') ? "cd" : "hd";
1005
1006         $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1007     } elsif ($drive->{interface} eq 'sata'){
1008         my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1009         my $unit = $drive->{index} % $MAX_SATA_DISKS;
1010         $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1011     } elsif ($drive->{interface} eq 'usb') {
1012         die "implement me";
1013         #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1014     } else {
1015         die "unsupported interface type";
1016     }
1017
1018     $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex};
1019
1020     return $device;
1021 }
1022
1023 sub print_drive_full {
1024     my ($storecfg, $vmid, $drive) = @_;
1025
1026     my $opts = '';
1027     foreach my $o (@qemu_drive_options) {
1028         next if $o eq 'bootindex';
1029         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1030     }
1031
1032     # use linux-aio by default (qemu default is threads)
1033     $opts .= ",aio=native" if !$drive->{aio};
1034
1035     my $path;
1036     my $volid = $drive->{file};
1037     if (drive_is_cdrom($drive)) {
1038         $path = get_iso_path($storecfg, $vmid, $volid);
1039     } else {
1040         if ($volid =~ m|^/|) {
1041             $path = $volid;
1042         } else {
1043             $path = PVE::Storage::path($storecfg, $volid);
1044         }
1045         if (!$drive->{cache} && ($path =~ m|^/dev/| || $path =~ m|\.raw$|)) {
1046             $opts .= ",cache=none";
1047         }
1048     }
1049
1050     my $pathinfo = $path ? "file=$path," : '';
1051
1052     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1053 }
1054
1055 sub print_netdevice_full {
1056     my ($vmid, $conf, $net, $netid) = @_;
1057
1058     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
1059
1060     my $device = $net->{model};
1061     if ($net->{model} eq 'virtio') {
1062          $device = 'virtio-net-pci';
1063      };
1064
1065     # qemu > 0.15 always try to boot from network - we disable that by
1066     # not loading the pxe rom file
1067     my $extra = ($bootorder !~ m/n/) ? "romfile=," : '';
1068     my $pciaddr = print_pci_addr("$netid");
1069     my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1070     $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
1071     return $tmpstr;
1072 }
1073
1074 sub print_netdev_full {
1075     my ($vmid, $conf, $net, $netid) = @_;
1076
1077     my $i = '';
1078     if ($netid =~ m/^net(\d+)$/) {
1079         $i = int($1);
1080     }
1081
1082     die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
1083
1084     my $ifname = "tap${vmid}i$i";
1085
1086     # kvm uses TUNSETIFF ioctl, and that limits ifname length
1087     die "interface name '$ifname' is too long (max 15 character)\n"
1088         if length($ifname) >= 16;
1089
1090     my $vhostparam = '';
1091     $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model} eq 'virtio';
1092
1093     my $vmname = $conf->{name} || "vm$vmid";
1094
1095     if ($net->{bridge}) {
1096         return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1097     } else {
1098         return "type=user,id=$netid,hostname=$vmname";
1099     }
1100 }
1101
1102 sub drive_is_cdrom {
1103     my ($drive) = @_;
1104
1105     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
1106
1107 }
1108
1109 sub parse_hostpci {
1110     my ($value) = @_;
1111
1112     return undef if !$value;
1113
1114     my $res = {};
1115
1116     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1117        $res->{pciid} = $value;
1118     } else {
1119        return undef;
1120     }
1121
1122     return $res;
1123 }
1124
1125 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1126 sub parse_net {
1127     my ($data) = @_;
1128
1129     my $res = {};
1130
1131     foreach my $kvp (split(/,/, $data)) {
1132
1133         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1134             my $model = lc($1);
1135             my $mac = uc($3) || PVE::Tools::random_ether_addr();
1136             $res->{model} = $model;
1137             $res->{macaddr} = $mac;
1138         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1139             $res->{bridge} = $1;
1140         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1141             $res->{rate} = $1;
1142         } elsif ($kvp =~ m/^tag=(\d+)$/) {
1143             $res->{tag} = $1;
1144         } else {
1145             return undef;
1146         }
1147
1148     }
1149
1150     return undef if !$res->{model};
1151
1152     return $res;
1153 }
1154
1155 sub print_net {
1156     my $net = shift;
1157
1158     my $res = "$net->{model}";
1159     $res .= "=$net->{macaddr}" if $net->{macaddr};
1160     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1161     $res .= ",rate=$net->{rate}" if $net->{rate};
1162     $res .= ",tag=$net->{tag}" if $net->{tag};
1163
1164     return $res;
1165 }
1166
1167 sub add_random_macs {
1168     my ($settings) = @_;
1169
1170     foreach my $opt (keys %$settings) {
1171         next if $opt !~ m/^net(\d+)$/;
1172         my $net = parse_net($settings->{$opt});
1173         next if !$net;
1174         $settings->{$opt} = print_net($net);
1175     }
1176 }
1177
1178 sub add_unused_volume {
1179     my ($config, $volid) = @_;
1180
1181     my $key;
1182     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1183         my $test = "unused$ind";
1184         if (my $vid = $config->{$test}) {
1185             return if $vid eq $volid; # do not add duplicates
1186         } else {
1187             $key = $test;
1188         }
1189     }
1190
1191     die "To many unused volume - please delete them first.\n" if !$key;
1192
1193     $config->{$key} = $volid;
1194
1195     return $key;
1196 }
1197
1198 # fixme: remove all thos $noerr parameters?
1199
1200 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1201 sub verify_bootdisk {
1202     my ($value, $noerr) = @_;
1203
1204     return $value if valid_drivename($value);
1205
1206     return undef if $noerr;
1207
1208     die "invalid boot disk '$value'\n";
1209 }
1210
1211 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1212 sub verify_net {
1213     my ($value, $noerr) = @_;
1214
1215     return $value if parse_net($value);
1216
1217     return undef if $noerr;
1218
1219     die "unable to parse network options\n";
1220 }
1221
1222 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1223 sub verify_drive {
1224     my ($value, $noerr) = @_;
1225
1226     return $value if parse_drive(undef, $value);
1227
1228     return undef if $noerr;
1229
1230     die "unable to parse drive options\n";
1231 }
1232
1233 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1234 sub verify_hostpci {
1235     my ($value, $noerr) = @_;
1236
1237     return $value if parse_hostpci($value);
1238
1239     return undef if $noerr;
1240
1241     die "unable to parse pci id\n";
1242 }
1243
1244 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1245 sub verify_watchdog {
1246     my ($value, $noerr) = @_;
1247
1248     return $value if parse_watchdog($value);
1249
1250     return undef if $noerr;
1251
1252     die "unable to parse watchdog options\n";
1253 }
1254
1255 sub parse_watchdog {
1256     my ($value) = @_;
1257
1258     return undef if !$value;
1259
1260     my $res = {};
1261
1262     foreach my $p (split(/,/, $value)) {
1263         next if $p =~ m/^\s*$/;
1264
1265         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1266             $res->{model} = $2;
1267         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1268             $res->{action} = $2;
1269         } else {
1270             return undef;
1271         }
1272     }
1273
1274     return $res;
1275 }
1276
1277 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1278 sub verify_startup {
1279     my ($value, $noerr) = @_;
1280
1281     return $value if parse_startup($value);
1282
1283     return undef if $noerr;
1284
1285     die "unable to parse startup options\n";
1286 }
1287
1288 sub parse_startup {
1289     my ($value) = @_;
1290
1291     return undef if !$value;
1292
1293     my $res = {};
1294
1295     foreach my $p (split(/,/, $value)) {
1296         next if $p =~ m/^\s*$/;
1297
1298         if ($p =~ m/^(order=)?(\d+)$/) {
1299             $res->{order} = $2;
1300         } elsif ($p =~ m/^up=(\d+)$/) {
1301             $res->{up} = $1;
1302         } elsif ($p =~ m/^down=(\d+)$/) {
1303             $res->{down} = $1;
1304         } else {
1305             return undef;
1306         }
1307     }
1308
1309     return $res;
1310 }
1311
1312 sub parse_usb_device {
1313     my ($value) = @_;
1314
1315     return undef if !$value;
1316
1317     my @dl = split(/,/, $value);
1318     my $found;
1319
1320     my $res = {};
1321     foreach my $v (@dl) {
1322         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1323             $found = 1;
1324             $res->{vendorid} = $2;
1325             $res->{productid} = $4;
1326         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1327             $found = 1;
1328             $res->{hostbus} = $1;
1329             $res->{hostport} = $2;
1330         } else {
1331             return undef;
1332         }
1333     }
1334     return undef if !$found;
1335
1336     return $res;
1337 }
1338
1339 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1340 sub verify_usb_device {
1341     my ($value, $noerr) = @_;
1342
1343     return $value if parse_usb_device($value);
1344
1345     return undef if $noerr;
1346
1347     die "unable to parse usb device\n";
1348 }
1349
1350 # add JSON properties for create and set function
1351 sub json_config_properties {
1352     my $prop = shift;
1353
1354     foreach my $opt (keys %$confdesc) {
1355         $prop->{$opt} = $confdesc->{$opt};
1356     }
1357
1358     return $prop;
1359 }
1360
1361 sub check_type {
1362     my ($key, $value) = @_;
1363
1364     die "unknown setting '$key'\n" if !$confdesc->{$key};
1365
1366     my $type = $confdesc->{$key}->{type};
1367
1368     if (!defined($value)) {
1369         die "got undefined value\n";
1370     }
1371
1372     if ($value =~ m/[\n\r]/) {
1373         die "property contains a line feed\n";
1374     }
1375
1376     if ($type eq 'boolean') {
1377         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1378         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1379         die "type check ('boolean') failed - got '$value'\n";
1380     } elsif ($type eq 'integer') {
1381         return int($1) if $value =~ m/^(\d+)$/;
1382         die "type check ('integer') failed - got '$value'\n";
1383     } elsif ($type eq 'string') {
1384         if (my $fmt = $confdesc->{$key}->{format}) {
1385             if ($fmt eq 'pve-qm-drive') {
1386                 # special case - we need to pass $key to parse_drive()
1387                 my $drive = parse_drive($key, $value);
1388                 return $value if $drive;
1389                 die "unable to parse drive options\n";
1390             }
1391             PVE::JSONSchema::check_format($fmt, $value);
1392             return $value;
1393         }
1394         $value =~ s/^\"(.*)\"$/$1/;
1395         return $value;
1396     } else {
1397         die "internal error"
1398     }
1399 }
1400
1401 sub lock_config_full {
1402     my ($vmid, $timeout, $code, @param) = @_;
1403
1404     my $filename = config_file_lock($vmid);
1405
1406     my $res = lock_file($filename, $timeout, $code, @param);
1407
1408     die $@ if $@;
1409
1410     return $res;
1411 }
1412
1413 sub lock_config {
1414     my ($vmid, $code, @param) = @_;
1415
1416     return lock_config_full($vmid, 10, $code, @param);
1417 }
1418
1419 sub cfs_config_path {
1420     my ($vmid, $node) = @_;
1421
1422     $node = $nodename if !$node;
1423     return "nodes/$node/qemu-server/$vmid.conf";
1424 }
1425
1426 sub check_iommu_support{
1427     #fixme : need to check IOMMU support
1428     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1429
1430     my $iommu=1;
1431     return $iommu;
1432
1433 }
1434
1435 sub config_file {
1436     my ($vmid, $node) = @_;
1437
1438     my $cfspath = cfs_config_path($vmid, $node);
1439     return "/etc/pve/$cfspath";
1440 }
1441
1442 sub config_file_lock {
1443     my ($vmid) = @_;
1444
1445     return "$lock_dir/lock-$vmid.conf";
1446 }
1447
1448 sub touch_config {
1449     my ($vmid) = @_;
1450
1451     my $conf = config_file($vmid);
1452     utime undef, undef, $conf;
1453 }
1454
1455 sub destroy_vm {
1456     my ($storecfg, $vmid, $keep_empty_config) = @_;
1457
1458     my $conffile = config_file($vmid);
1459
1460     my $conf = load_config($vmid);
1461
1462     check_lock($conf);
1463
1464     # only remove disks owned by this VM
1465     foreach_drive($conf, sub {
1466         my ($ds, $drive) = @_;
1467
1468         return if drive_is_cdrom($drive);
1469
1470         my $volid = $drive->{file};
1471         return if !$volid || $volid =~ m|^/|;
1472
1473         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1474         return if !$path || !$owner || ($owner != $vmid);
1475
1476         PVE::Storage::vdisk_free($storecfg, $volid);
1477     });
1478
1479     if ($keep_empty_config) {
1480         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1481     } else {
1482         unlink $conffile;
1483     }
1484
1485     # also remove unused disk
1486     eval {
1487         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1488
1489         eval {
1490             PVE::Storage::foreach_volid($dl, sub {
1491                 my ($volid, $sid, $volname, $d) = @_;
1492                 PVE::Storage::vdisk_free($storecfg, $volid);
1493             });
1494         };
1495         warn $@ if $@;
1496
1497     };
1498     warn $@ if $@;
1499 }
1500
1501 sub load_config {
1502     my ($vmid) = @_;
1503
1504     my $cfspath = cfs_config_path($vmid);
1505
1506     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1507
1508     die "no such VM ('$vmid')\n" if !defined($conf);
1509
1510     return $conf;
1511 }
1512
1513 sub parse_vm_config {
1514     my ($filename, $raw) = @_;
1515
1516     return undef if !defined($raw);
1517
1518     my $res = {
1519         digest => Digest::SHA::sha1_hex($raw),
1520     };
1521
1522     $filename =~ m|/qemu-server/(\d+)\.conf$|
1523         || die "got strange filename '$filename'";
1524
1525     my $vmid = $1;
1526
1527     my $descr = '';
1528
1529     while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
1530         my $line = $1;
1531
1532         next if $line =~ m/^\s*$/;
1533
1534         if ($line =~ m/^\#(.*)\s*$/) {
1535             $descr .= PVE::Tools::decode_text($1) . "\n";
1536             next;
1537         }
1538
1539         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1540             $descr .= PVE::Tools::decode_text($2);
1541         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1542             my $key = $1;
1543             my $value = $2;
1544             $res->{$key} = $value;
1545         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1546             my $key = $1;
1547             my $value = $2;
1548             eval { $value = check_type($key, $value); };
1549             if ($@) {
1550                 warn "vm $vmid - unable to parse value of '$key' - $@";
1551             } else {
1552                 my $fmt = $confdesc->{$key}->{format};
1553                 if ($fmt && $fmt eq 'pve-qm-drive') {
1554                     my $v = parse_drive($key, $value);
1555                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1556                         $v->{file} = $volid;
1557                         $value = print_drive($vmid, $v);
1558                     } else {
1559                         warn "vm $vmid - unable to parse value of '$key'\n";
1560                         next;
1561                     }
1562                 }
1563
1564                 if ($key eq 'cdrom') {
1565                     $res->{ide2} = $value;
1566                 } else {
1567                     $res->{$key} = $value;
1568                 }
1569             }
1570         }
1571     }
1572
1573     $res->{description} = $descr if $descr;
1574
1575     # convert old smp to sockets
1576     if ($res->{smp} && !$res->{sockets}) {
1577         $res->{sockets} = $res->{smp};
1578     }
1579     delete $res->{smp};
1580
1581     return $res;
1582 }
1583
1584 sub write_vm_config {
1585     my ($filename, $conf) = @_;
1586
1587     if ($conf->{cdrom}) {
1588         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1589         $conf->{ide2} = $conf->{cdrom};
1590         delete $conf->{cdrom};
1591     }
1592
1593     # we do not use 'smp' any longer
1594     if ($conf->{sockets}) {
1595         delete $conf->{smp};
1596     } elsif ($conf->{smp}) {
1597         $conf->{sockets} = $conf->{smp};
1598         delete $conf->{cores};
1599         delete $conf->{smp};
1600     }
1601
1602     my $new_volids = {};
1603     foreach my $key (keys %$conf) {
1604         next if $key eq 'digest' || $key eq 'description';
1605         my $value = $conf->{$key};
1606         eval { $value = check_type($key, $value); };
1607         die "unable to parse value of '$key' - $@" if $@;
1608
1609         $conf->{$key} = $value;
1610
1611         if (valid_drivename($key)) {
1612             my $drive = PVE::QemuServer::parse_drive($key, $value);
1613             $new_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1614         }
1615     }
1616
1617     # remove 'unusedX' settings if we re-add a volume
1618     foreach my $key (keys %$conf) {
1619         my $value = $conf->{$key};
1620         if ($key =~ m/^unused/ && $new_volids->{$value}) {
1621             delete $conf->{$key};
1622         }
1623     }
1624
1625     # gererate RAW data
1626     my $raw = '';
1627
1628     # add description as comment to top of file
1629     my $descr = $conf->{description} || '';
1630     foreach my $cl (split(/\n/, $descr)) {
1631         $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1632     }
1633
1634     foreach my $key (sort keys %$conf) {
1635         next if $key eq 'digest' || $key eq 'description';
1636         $raw .= "$key: $conf->{$key}\n";
1637     }
1638
1639     return $raw;
1640 }
1641
1642 sub update_config_nolock {
1643     my ($vmid, $conf, $skiplock) = @_;
1644
1645     check_lock($conf) if !$skiplock;
1646
1647     my $cfspath = cfs_config_path($vmid);
1648
1649     PVE::Cluster::cfs_write_file($cfspath, $conf);
1650 }
1651
1652 sub update_config {
1653     my ($vmid, $conf, $skiplock) = @_;
1654
1655     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1656 }
1657
1658 sub load_defaults {
1659
1660     my $res = {};
1661
1662     # we use static defaults from our JSON schema configuration
1663     foreach my $key (keys %$confdesc) {
1664         if (defined(my $default = $confdesc->{$key}->{default})) {
1665             $res->{$key} = $default;
1666         }
1667     }
1668
1669     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1670     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1671
1672     return $res;
1673 }
1674
1675 sub config_list {
1676     my $vmlist = PVE::Cluster::get_vmlist();
1677     my $res = {};
1678     return $res if !$vmlist || !$vmlist->{ids};
1679     my $ids = $vmlist->{ids};
1680
1681     foreach my $vmid (keys %$ids) {
1682         my $d = $ids->{$vmid};
1683         next if !$d->{node} || $d->{node} ne $nodename;
1684         next if !$d->{type} || $d->{type} ne 'qemu';
1685         $res->{$vmid}->{exists} = 1;
1686     }
1687     return $res;
1688 }
1689
1690 # test if VM uses local resources (to prevent migration)
1691 sub check_local_resources {
1692     my ($conf, $noerr) = @_;
1693
1694     my $loc_res = 0;
1695
1696     $loc_res = 1 if $conf->{hostusb}; # old syntax
1697     $loc_res = 1 if $conf->{hostpci}; # old syntax
1698
1699     foreach my $k (keys %$conf) {
1700         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1701     }
1702
1703     die "VM uses local resources\n" if $loc_res && !$noerr;
1704
1705     return $loc_res;
1706 }
1707
1708 # check is used storages are available on all nodes (use by migrate)
1709 sub check_storage_availability {
1710     my ($storecfg, $conf, $node) = @_;
1711
1712     foreach_drive($conf, sub {
1713         my ($ds, $drive) = @_;
1714
1715         my $volid = $drive->{file};
1716         return if !$volid;
1717
1718         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1719         return if !$sid;
1720
1721         # check if storage is available on both nodes
1722         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1723         PVE::Storage::storage_check_node($storecfg, $sid, $node);
1724    });
1725 }
1726
1727 sub check_lock {
1728     my ($conf) = @_;
1729
1730     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1731 }
1732
1733 sub check_cmdline {
1734     my ($pidfile, $pid) = @_;
1735
1736     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1737     if (defined($fh)) {
1738         my $line = <$fh>;
1739         $fh->close;
1740         return undef if !$line;
1741         my @param = split(/\0/, $line);
1742
1743         my $cmd = $param[0];
1744         return if !$cmd || ($cmd !~ m|kvm$|);
1745
1746         for (my $i = 0; $i < scalar (@param); $i++) {
1747             my $p = $param[$i];
1748             next if !$p;
1749             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1750                 my $p = $param[$i+1];
1751                 return 1 if $p && ($p eq $pidfile);
1752                 return undef;
1753             }
1754         }
1755     }
1756     return undef;
1757 }
1758
1759 sub check_running {
1760     my ($vmid, $nocheck) = @_;
1761
1762     my $filename = config_file($vmid);
1763
1764     die "unable to find configuration file for VM $vmid - no such machine\n"
1765         if !$nocheck && ! -f $filename;
1766
1767     my $pidfile = pidfile_name($vmid);
1768
1769     if (my $fd = IO::File->new("<$pidfile")) {
1770         my $st = stat($fd);
1771         my $line = <$fd>;
1772         close($fd);
1773
1774         my $mtime = $st->mtime;
1775         if ($mtime > time()) {
1776             warn "file '$filename' modified in future\n";
1777         }
1778
1779         if ($line =~ m/^(\d+)$/) {
1780             my $pid = $1;
1781             if (check_cmdline($pidfile, $pid)) {
1782                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1783                     return $pid;
1784                 }
1785             }
1786         }
1787     }
1788
1789     return undef;
1790 }
1791
1792 sub vzlist {
1793
1794     my $vzlist = config_list();
1795
1796     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1797
1798     while (defined(my $de = $fd->read)) {
1799         next if $de !~ m/^(\d+)\.pid$/;
1800         my $vmid = $1;
1801         next if !defined($vzlist->{$vmid});
1802         if (my $pid = check_running($vmid)) {
1803             $vzlist->{$vmid}->{pid} = $pid;
1804         }
1805     }
1806
1807     return $vzlist;
1808 }
1809
1810 sub disksize {
1811     my ($storecfg, $conf) = @_;
1812
1813     my $bootdisk = $conf->{bootdisk};
1814     return undef if !$bootdisk;
1815     return undef if !valid_drivename($bootdisk);
1816
1817     return undef if !$conf->{$bootdisk};
1818
1819     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1820     return undef if !defined($drive);
1821
1822     return undef if drive_is_cdrom($drive);
1823
1824     my $volid = $drive->{file};
1825     return undef if !$volid;
1826
1827     return $drive->{size};
1828 }
1829
1830 my $last_proc_pid_stat;
1831
1832 # get VM status information
1833 # This must be fast and should not block ($full == false)
1834 # We only query KVM using QMP if $full == true (this can be slow)
1835 sub vmstatus {
1836     my ($opt_vmid, $full) = @_;
1837
1838     my $res = {};
1839
1840     my $storecfg = PVE::Storage::config();
1841
1842     my $list = vzlist();
1843     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
1844
1845     my $cpucount = $cpuinfo->{cpus} || 1;
1846
1847     foreach my $vmid (keys %$list) {
1848         next if $opt_vmid && ($vmid ne $opt_vmid);
1849
1850         my $cfspath = cfs_config_path($vmid);
1851         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
1852
1853         my $d = {};
1854         $d->{pid} = $list->{$vmid}->{pid};
1855
1856         # fixme: better status?
1857         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
1858
1859         my $size = disksize($storecfg, $conf);
1860         if (defined($size)) {
1861             $d->{disk} = 0; # no info available
1862             $d->{maxdisk} = $size;
1863         } else {
1864             $d->{disk} = 0;
1865             $d->{maxdisk} = 0;
1866         }
1867
1868         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
1869         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
1870
1871         $d->{name} = $conf->{name} || "VM $vmid";
1872         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1873
1874         $d->{uptime} = 0;
1875         $d->{cpu} = 0;
1876         $d->{mem} = 0;
1877
1878         $d->{netout} = 0;
1879         $d->{netin} = 0;
1880
1881         $d->{diskread} = 0;
1882         $d->{diskwrite} = 0;
1883
1884         $res->{$vmid} = $d;
1885     }
1886
1887     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1888     foreach my $dev (keys %$netdev) {
1889         next if $dev !~ m/^tap([1-9]\d*)i/;
1890         my $vmid = $1;
1891         my $d = $res->{$vmid};
1892         next if !$d;
1893
1894         $d->{netout} += $netdev->{$dev}->{receive};
1895         $d->{netin} += $netdev->{$dev}->{transmit};
1896     }
1897
1898     my $ctime = gettimeofday;
1899
1900     foreach my $vmid (keys %$list) {
1901
1902         my $d = $res->{$vmid};
1903         my $pid = $d->{pid};
1904         next if !$pid;
1905
1906         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
1907         next if !$pstat; # not running
1908
1909         my $used = $pstat->{utime} + $pstat->{stime};
1910
1911         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
1912
1913         if ($pstat->{vsize}) {
1914             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
1915         }
1916
1917         my $old = $last_proc_pid_stat->{$pid};
1918         if (!$old) {
1919             $last_proc_pid_stat->{$pid} = {
1920                 time => $ctime,
1921                 used => $used,
1922                 cpu => 0,
1923             };
1924             next;
1925         }
1926
1927         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
1928
1929         if ($dtime > 1000) {
1930             my $dutime = $used -  $old->{used};
1931
1932             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
1933             $last_proc_pid_stat->{$pid} = {
1934                 time => $ctime,
1935                 used => $used,
1936                 cpu => $d->{cpu},
1937             };
1938         } else {
1939             $d->{cpu} = $old->{cpu};
1940         }
1941     }
1942
1943     return $res if !$full;
1944
1945     my $qmpclient = PVE::QMPClient->new();
1946
1947     my $blockstatscb = sub {
1948         my ($vmid, $resp) = @_;
1949         my $data = $resp->{'return'} || [];
1950         my $totalrdbytes = 0;
1951         my $totalwrbytes = 0;
1952         for my $blockstat (@$data) {
1953             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
1954             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
1955         }
1956         $res->{$vmid}->{diskread} = $totalrdbytes;
1957         $res->{$vmid}->{diskwrite} = $totalwrbytes;
1958     };
1959
1960     my $statuscb = sub {
1961         my ($vmid, $resp) = @_;
1962         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
1963
1964         my $status = 'unknown';
1965         if (!defined($status = $resp->{'return'}->{status})) {
1966             warn "unable to get VM status\n";
1967             return;
1968         }
1969
1970         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
1971     };
1972
1973     foreach my $vmid (keys %$list) {
1974         next if $opt_vmid && ($vmid ne $opt_vmid);
1975         next if !$res->{$vmid}->{pid}; # not running
1976         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
1977     }
1978
1979     $qmpclient->queue_execute();
1980
1981     foreach my $vmid (keys %$list) {
1982         next if $opt_vmid && ($vmid ne $opt_vmid);
1983         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
1984     }
1985
1986     return $res;
1987 }
1988
1989 sub foreach_drive {
1990     my ($conf, $func) = @_;
1991
1992     foreach my $ds (keys %$conf) {
1993         next if !valid_drivename($ds);
1994
1995         my $drive = parse_drive($ds, $conf->{$ds});
1996         next if !$drive;
1997
1998         &$func($ds, $drive);
1999     }
2000 }
2001
2002 sub config_to_command {
2003     my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
2004
2005     my $cmd = [];
2006     my $pciaddr = '';
2007     my $kvmver = kvm_user_version();
2008     my $vernum = 0; # unknown
2009     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2010         $vernum = $1*1000000+$2*1000;
2011     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2012         $vernum = $1*1000000+$2*1000+$3;
2013     }
2014
2015     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2016
2017     my $have_ovz = -f '/proc/vz/vestat';
2018
2019     push @$cmd, '/usr/bin/kvm';
2020
2021     push @$cmd, '-id', $vmid;
2022
2023     my $use_virtio = 0;
2024
2025     my $qmpsocket = qmp_socket($vmid);
2026     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2027     push @$cmd, '-mon', "chardev=qmp,mode=control";
2028
2029     my $socket = vnc_socket($vmid);
2030     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2031
2032     push @$cmd, '-pidfile' , pidfile_name($vmid);
2033
2034     push @$cmd, '-daemonize';
2035
2036     push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
2037
2038     my $use_usb2 = 0;
2039     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2040         next if !$conf->{"usb$i"};
2041         $use_usb2 = 1;
2042     }
2043     # include usb device config
2044     push @$cmd, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2045
2046     # enable absolute mouse coordinates (needed by vnc)
2047     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
2048     if ($tablet) {
2049         if ($use_usb2) {
2050             push @$cmd, '-device', 'usb-tablet,bus=ehci.0,port=6';
2051         } else {
2052             push @$cmd, '-usbdevice', 'tablet';
2053         }
2054     }
2055
2056     # host pci devices
2057     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2058           my $d = parse_hostpci($conf->{"hostpci$i"});
2059           next if !$d;
2060           $pciaddr = print_pci_addr("hostpci$i");
2061           push @$cmd, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2062     }
2063
2064     # usb devices
2065     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2066         my $d = parse_usb_device($conf->{"usb$i"});
2067         next if !$d;
2068         if ($d->{vendorid} && $d->{productid}) {
2069             push @$cmd, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2070         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2071             push @$cmd, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2072         }
2073     }
2074
2075     # serial devices
2076     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2077         if (my $path = $conf->{"serial$i"}) {
2078             die "no such serial device\n" if ! -c $path;
2079             push @$cmd, '-chardev', "tty,id=serial$i,path=$path";
2080             push @$cmd, '-device', "isa-serial,chardev=serial$i";
2081         }
2082     }
2083
2084     # parallel devices
2085     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2086         if (my $path = $conf->{"parallel$i"}) {
2087             die "no such parallel device\n" if ! -c $path;
2088             push @$cmd, '-chardev', "parport,id=parallel$i,path=$path";
2089             push @$cmd, '-device', "isa-parallel,chardev=parallel$i";
2090         }
2091     }
2092
2093     my $vmname = $conf->{name} || "vm$vmid";
2094
2095     push @$cmd, '-name', $vmname;
2096
2097     my $sockets = 1;
2098     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2099     $sockets = $conf->{sockets} if  $conf->{sockets};
2100
2101     my $cores = $conf->{cores} || 1;
2102
2103     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2104
2105     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2106
2107     push @$cmd, '-nodefaults';
2108
2109     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2110
2111     my $bootindex_hash = {};
2112     my $i = 1;
2113     foreach my $o (split(//, $bootorder)) {
2114         $bootindex_hash->{$o} = $i*100;
2115         $i++;
2116     }
2117
2118     push @$cmd, '-boot', "menu=on";
2119
2120     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2121
2122     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2123
2124     my $vga = $conf->{vga};
2125     if (!$vga) {
2126         if ($conf->{ostype} && ($conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2127             $vga = 'std';
2128         } else {
2129             $vga = 'cirrus';
2130         }
2131     }
2132
2133     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2134
2135     # time drift fix
2136     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2137     # ignore - no longer supported by newer kvm
2138     # push @$cmd, '-tdf' if $tdf;
2139
2140     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2141
2142     if (my $ost = $conf->{ostype}) {
2143         # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2144
2145         if ($ost =~ m/^w/) { # windows
2146             push @$cmd, '-localtime' if !defined($conf->{localtime});
2147
2148             # use rtc-td-hack when acpi is enabled
2149             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2150                 push @$cmd, '-rtc-td-hack';
2151             }
2152         }
2153
2154         if ($ost eq 'win7' || $ost eq 'w2k8' || $ost eq 'wvista') {
2155             push @$cmd, '-no-kvm-pit-reinjection';
2156             push @$cmd, '-no-hpet';
2157         }
2158
2159         # -tdf ?
2160         # -no-acpi
2161         # -no-kvm
2162         # -win2k-hack ?
2163     }
2164
2165     if ($nokvm) {
2166         push @$cmd, '-no-kvm';
2167     } else {
2168         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2169     }
2170
2171     push @$cmd, '-localtime' if $conf->{localtime};
2172
2173     push @$cmd, '-startdate', $conf->{startdate} if $conf->{startdate};
2174
2175     push @$cmd, '-S' if $conf->{freeze};
2176
2177     # set keyboard layout
2178     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2179     push @$cmd, '-k', $kb if $kb;
2180
2181     # enable sound
2182     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2183     #push @$cmd, '-soundhw', 'es1370';
2184     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2185     $pciaddr = print_pci_addr("balloon0");
2186     push @$cmd, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2187
2188     if ($conf->{watchdog}) {
2189         my $wdopts = parse_watchdog($conf->{watchdog});
2190         $pciaddr = print_pci_addr("watchdog");
2191         my $watchdog = $wdopts->{model} || 'i6300esb';
2192         push @$cmd, '-device', "$watchdog$pciaddr";
2193         push @$cmd, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2194     }
2195
2196     my $vollist = [];
2197     my $scsicontroller = {};
2198     my $ahcicontroller = {};
2199     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2200
2201     foreach_drive($conf, sub {
2202         my ($ds, $drive) = @_;
2203
2204         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2205             push @$vollist, $drive->{file};
2206         }
2207
2208         $use_virtio = 1 if $ds =~ m/^virtio/;
2209
2210         if (drive_is_cdrom ($drive)) {
2211             if ($bootindex_hash->{d}) {
2212                 $drive->{bootindex} = $bootindex_hash->{d};
2213                 $bootindex_hash->{d} += 1;
2214             }
2215         } else {
2216             if ($bootindex_hash->{c}) {
2217                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2218                 $bootindex_hash->{c} += 1;
2219             }
2220         }
2221
2222         if ($drive->{interface} eq 'scsi') {
2223
2224             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2225             my $controller = int($drive->{index} / $maxdev);
2226             $pciaddr = print_pci_addr("scsihw$controller");
2227             push @$cmd, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2228             $scsicontroller->{$controller}=1;
2229         }
2230
2231         if ($drive->{interface} eq 'sata') {
2232            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2233            $pciaddr = print_pci_addr("ahci$controller");
2234            push @$cmd, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2235            $ahcicontroller->{$controller}=1;
2236         }
2237
2238         push @$cmd, '-drive',print_drive_full($storecfg, $vmid, $drive);
2239         push @$cmd, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive);
2240     });
2241
2242     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2243
2244     for (my $i = 0; $i < $MAX_NETS; $i++) {
2245          next if !$conf->{"net$i"};
2246          my $d = parse_net($conf->{"net$i"});
2247          next if !$d;
2248
2249          $use_virtio = 1 if $d->{model} eq 'virtio';
2250
2251          if ($bootindex_hash->{n}) {
2252             $d->{bootindex} = $bootindex_hash->{n};
2253             $bootindex_hash->{n} += 1;
2254          }
2255
2256          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2257          push @$cmd, '-netdev', $netdevfull;
2258
2259          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i");
2260          push @$cmd, '-device', $netdevicefull;
2261     }
2262
2263
2264     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2265     # when the VM uses virtio devices.
2266     if (!$use_virtio && $have_ovz) {
2267
2268         my $cpuunits = defined($conf->{cpuunits}) ?
2269             $conf->{cpuunits} : $defaults->{cpuunits};
2270
2271         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2272
2273         # fixme: cpulimit is currently ignored
2274         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2275     }
2276
2277     # add custom args
2278     if ($conf->{args}) {
2279         my $aa = PVE::Tools::split_args($conf->{args});
2280         push @$cmd, @$aa;
2281     }
2282
2283     return wantarray ? ($cmd, $vollist) : $cmd;
2284 }
2285
2286 sub vnc_socket {
2287     my ($vmid) = @_;
2288     return "${var_run_tmpdir}/$vmid.vnc";
2289 }
2290
2291 sub qmp_socket {
2292     my ($vmid) = @_;
2293     return "${var_run_tmpdir}/$vmid.qmp";
2294 }
2295
2296 sub pidfile_name {
2297     my ($vmid) = @_;
2298     return "${var_run_tmpdir}/$vmid.pid";
2299 }
2300
2301 sub next_migrate_port {
2302
2303     for (my $p = 60000; $p < 60010; $p++) {
2304
2305         my $sock = IO::Socket::INET->new(Listen => 5,
2306                                          LocalAddr => 'localhost',
2307                                          LocalPort => $p,
2308                                          ReuseAddr => 1,
2309                                          Proto     => 0);
2310
2311         if ($sock) {
2312             close($sock);
2313             return $p;
2314         }
2315     }
2316
2317     die "unable to find free migration port";
2318 }
2319
2320 sub vm_devices_list {
2321     my ($vmid) = @_;
2322
2323     my $res = vm_mon_cmd($vmid, 'query-pci');
2324
2325     my $devices = {};
2326     foreach my $pcibus (@$res) {
2327         foreach my $device (@{$pcibus->{devices}}) {
2328             next if !$device->{'qdev_id'};
2329             $devices->{$device->{'qdev_id'}} = $device;
2330         }
2331     }
2332
2333     return $devices;
2334 }
2335
2336 sub vm_deviceplug {
2337     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2338
2339     return 1 if !check_running($vmid) || !$conf->{hotplug};
2340
2341     my $devices_list = vm_devices_list($vmid);
2342     return 1 if defined($devices_list->{$deviceid});
2343
2344     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2345         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2346         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2347         qemu_deviceadd($vmid, $devicefull);
2348         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2349            qemu_drivedel($vmid, $deviceid);
2350            return undef;
2351         }
2352     }
2353
2354     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2355         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2356         my $pciaddr = print_pci_addr($deviceid);
2357         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2358         qemu_deviceadd($vmid, $devicefull);
2359         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2360     }
2361
2362     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2363         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2364         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2365         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2366         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2367         if(!qemu_deviceadd($vmid, $devicefull)) {
2368            qemu_drivedel($vmid, $deviceid);
2369            return undef;
2370         }
2371     }
2372
2373     if ($deviceid =~ m/^(net)(\d+)$/) {
2374         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2375         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2376         qemu_deviceadd($vmid, $netdevicefull);
2377         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2378            qemu_netdevdel($vmid, $deviceid);
2379            return undef;
2380         }
2381     }
2382
2383     return 1;
2384 }
2385
2386 sub vm_deviceunplug {
2387     my ($vmid, $conf, $deviceid) = @_;
2388
2389     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2390
2391     my $devices_list = vm_devices_list($vmid);
2392     return 1 if !defined($devices_list->{$deviceid});
2393
2394     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2395
2396     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2397         return undef if !qemu_drivedel($vmid, $deviceid);
2398         qemu_devicedel($vmid, $deviceid);
2399         return undef if !qemu_devicedelverify($vmid, $deviceid);
2400     }
2401
2402     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2403         return undef if !qemu_devicedel($vmid, $deviceid);
2404     }
2405
2406     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2407         return undef if !qemu_devicedel($vmid, $deviceid);
2408         return undef if !qemu_drivedel($vmid, $deviceid);
2409     }
2410
2411     if ($deviceid =~ m/^(net)(\d+)$/) {
2412         return undef if !qemu_netdevdel($vmid, $deviceid);
2413         qemu_devicedel($vmid, $deviceid);
2414         return undef if !qemu_devicedelverify($vmid, $deviceid);
2415     }
2416
2417     return 1;
2418 }
2419
2420 sub qemu_deviceadd {
2421     my ($vmid, $devicefull) = @_;
2422
2423     my $ret = vm_human_monitor_command($vmid, "device_add $devicefull");
2424     $ret =~ s/^\s+//;
2425     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2426     return 1 if $ret eq "";
2427     syslog("err", "error on hotplug device : $ret");
2428     return undef;
2429
2430 }
2431
2432 sub qemu_devicedel {
2433     my($vmid, $deviceid) = @_;
2434
2435     my $ret = vm_human_monitor_command($vmid, "device_del $deviceid");
2436     $ret =~ s/^\s+//;
2437     return 1 if $ret eq "";
2438     syslog("err", "detaching device $deviceid failed : $ret");
2439     return undef;
2440 }
2441
2442 sub qemu_driveadd {
2443     my($storecfg, $vmid, $device) = @_;
2444
2445     my $drive = print_drive_full($storecfg, $vmid, $device);
2446     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2447     # If the command succeeds qemu prints: "OK"
2448     if ($ret !~ m/OK/s) {
2449         syslog("err", "adding drive failed: $ret");
2450         return undef;
2451     }
2452     return 1;
2453 }
2454
2455 sub qemu_drivedel {
2456     my($vmid, $deviceid) = @_;
2457
2458     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2459     $ret =~ s/^\s+//;
2460     if ($ret =~ m/Device \'.*?\' not found/s) {
2461         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2462     }
2463     elsif ($ret ne "") {
2464       syslog("err", "deleting drive $deviceid failed : $ret");
2465       return undef;
2466     }
2467     return 1;
2468 }
2469
2470 sub qemu_deviceaddverify {
2471     my ($vmid,$deviceid) = @_;
2472
2473     for (my $i = 0; $i <= 5; $i++) {
2474          my $devices_list = vm_devices_list($vmid);
2475          return 1 if defined($devices_list->{$deviceid});
2476          sleep 1;
2477     }
2478     syslog("err", "error on hotplug device $deviceid");
2479     return undef;
2480 }
2481
2482
2483 sub qemu_devicedelverify {
2484     my ($vmid,$deviceid) = @_;
2485
2486     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2487     for (my $i = 0; $i <= 5; $i++) {
2488          my $devices_list = vm_devices_list($vmid);
2489          return 1 if !defined($devices_list->{$deviceid});
2490          sleep 1;
2491     }
2492     syslog("err", "error on hot-unplugging device $deviceid");
2493     return undef;
2494 }
2495
2496 sub qemu_findorcreatescsihw {
2497     my ($storecfg, $conf, $vmid, $device) = @_;
2498
2499     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2500     my $controller = int($device->{index} / $maxdev);
2501     my $scsihwid="scsihw$controller";
2502     my $devices_list = vm_devices_list($vmid);
2503
2504     if(!defined($devices_list->{$scsihwid})) {
2505        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2506     }
2507     return 1;
2508 }
2509
2510 sub qemu_netdevadd {
2511     my ($vmid, $conf, $device, $deviceid) = @_;
2512
2513     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2514     my $ret = vm_human_monitor_command($vmid, "netdev_add $netdev");
2515     $ret =~ s/^\s+//;
2516
2517     #if the command succeeds, no output is sent. So any non-empty string shows an error
2518     return 1 if $ret eq "";
2519     syslog("err", "adding netdev failed: $ret");
2520     return undef;
2521 }
2522
2523 sub qemu_netdevdel {
2524     my ($vmid, $deviceid) = @_;
2525
2526     my $ret = vm_human_monitor_command($vmid, "netdev_del $deviceid");
2527     $ret =~ s/^\s+//;
2528     #if the command succeeds, no output is sent. So any non-empty string shows an error
2529     return 1 if $ret eq "";
2530     syslog("err", "deleting netdev failed: $ret");
2531     return undef;
2532 }
2533
2534 sub qemu_block_set_io_throttle {
2535     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2536
2537     return if !check_running($vmid) ;
2538
2539     $bps = 0 if !$bps;
2540     $bps_rd = 0 if !$bps_rd;
2541     $bps_wr = 0 if !$bps_wr;
2542     $iops = 0 if !$iops;
2543     $iops_rd = 0 if !$iops_rd;
2544     $iops_wr = 0 if !$iops_wr;
2545
2546     vm_mon_cmd($vmid, "block_set_io_throttle", device => $deviceid, bps => int($bps), bps_rd => int($bps_rd), bps_wr => int($bps_wr), iops => int($iops), iops_rd => int($iops_rd), iops_wr => int($iops_wr));
2547
2548 }
2549
2550 # old code, only used to shutdown old VM after update
2551 sub __read_avail {
2552     my ($fh, $timeout) = @_;
2553
2554     my $sel = new IO::Select;
2555     $sel->add($fh);
2556
2557     my $res = '';
2558     my $buf;
2559
2560     my @ready;
2561     while (scalar (@ready = $sel->can_read($timeout))) {
2562         my $count;
2563         if ($count = $fh->sysread($buf, 8192)) {
2564             if ($buf =~ /^(.*)\(qemu\) $/s) {
2565                 $res .= $1;
2566                 last;
2567             } else {
2568                 $res .= $buf;
2569             }
2570         } else {
2571             if (!defined($count)) {
2572                 die "$!\n";
2573             }
2574             last;
2575         }
2576     }
2577
2578     die "monitor read timeout\n" if !scalar(@ready);
2579
2580     return $res;
2581 }
2582
2583 # old code, only used to shutdown old VM after update
2584 sub vm_monitor_command {
2585     my ($vmid, $cmdstr, $nocheck) = @_;
2586
2587     my $res;
2588
2589     eval {
2590         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2591
2592         my $sname = "${var_run_tmpdir}/$vmid.mon";
2593
2594         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2595             die "unable to connect to VM $vmid socket - $!\n";
2596
2597         my $timeout = 3;
2598
2599         # hack: migrate sometime blocks the monitor (when migrate_downtime
2600         # is set)
2601         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2602             $timeout = 60*60; # 1 hour
2603         }
2604
2605         # read banner;
2606         my $data = __read_avail($sock, $timeout);
2607
2608         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2609             die "got unexpected qemu monitor banner\n";
2610         }
2611
2612         my $sel = new IO::Select;
2613         $sel->add($sock);
2614
2615         if (!scalar(my @ready = $sel->can_write($timeout))) {
2616             die "monitor write error - timeout";
2617         }
2618
2619         my $fullcmd = "$cmdstr\r";
2620
2621         # syslog('info', "VM $vmid monitor command: $cmdstr");
2622
2623         my $b;
2624         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2625             die "monitor write error - $!";
2626         }
2627
2628         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2629
2630         $timeout = 20;
2631
2632         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2633             $timeout = 60*60; # 1 hour
2634         } elsif ($cmdstr =~ m/^(eject|change)/) {
2635             $timeout = 60; # note: cdrom mount command is slow
2636         }
2637         if ($res = __read_avail($sock, $timeout)) {
2638
2639             my @lines = split("\r?\n", $res);
2640
2641             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2642
2643             $res = join("\n", @lines);
2644             $res .= "\n";
2645         }
2646     };
2647
2648     my $err = $@;
2649
2650     if ($err) {
2651         syslog("err", "VM $vmid monitor command failed - $err");
2652         die $err;
2653     }
2654
2655     return $res;
2656 }
2657
2658 sub qemu_block_resize {
2659     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2660
2661     my $running = PVE::QemuServer::check_running($vmid);
2662
2663     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
2664
2665     return if !$running;
2666
2667     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
2668
2669 }
2670
2671 sub vm_start {
2672     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2673
2674     lock_config($vmid, sub {
2675         my $conf = load_config($vmid);
2676
2677         check_lock($conf) if !$skiplock;
2678
2679         die "VM $vmid already running\n" if check_running($vmid);
2680
2681         my $migrate_uri;
2682         my $migrate_port = 0;
2683
2684         if ($statefile) {
2685             if ($statefile eq 'tcp') {
2686                 $migrate_port = next_migrate_port();
2687                 $migrate_uri = "tcp:localhost:${migrate_port}";
2688             } else {
2689                 if (-f $statefile) {
2690                     $migrate_uri = "exec:cat $statefile";
2691                 } else {
2692                     warn "state file '$statefile' does not exist - doing normal startup\n";
2693                 }
2694             }
2695         }
2696
2697         my $defaults = load_defaults();
2698
2699         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2700         # host pci devices
2701         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2702           my $d = parse_hostpci($conf->{"hostpci$i"});
2703           next if !$d;
2704           my $info = pci_device_info("0000:$d->{pciid}");
2705           die "IOMMU not present\n" if !check_iommu_support();
2706           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2707           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2708           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2709         }
2710
2711         PVE::Storage::activate_volumes($storecfg, $vollist);
2712
2713         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2714         my $err = $@;
2715         die "start failed: $err" if $err;
2716
2717         if ($statefile) {
2718
2719             if ($statefile eq 'tcp') {
2720                 print "migration listens on port $migrate_port\n";
2721             } else {
2722                 unlink $statefile;
2723                 # fixme: send resume - is that necessary ?
2724                 eval { vm_mon_cmd($vmid, "cont"); };
2725             }
2726         }
2727
2728         # always set migrate speed (overwrite kvm default of 32m)
2729         # we set a very hight default of 8192m which is basically unlimited
2730         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2731         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2732         $migrate_speed = $migrate_speed * 1048576;
2733         eval {
2734             vm_mon_cmd($vmid, "migrate_set_speed", value => $migrate_speed);
2735         };
2736
2737         my $migrate_downtime = $defaults->{migrate_downtime};
2738         $migrate_downtime = $conf->{migrate_downtime} if defined($conf->{migrate_downtime});
2739         if (defined($migrate_downtime)) {
2740             eval { vm_mon_cmd($vmid, "migrate_set_downtime", value => $migrate_downtime); };
2741         }
2742
2743         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2744
2745     });
2746 }
2747
2748 sub vm_mon_cmd {
2749     my ($vmid, $execute, %params) = @_;
2750
2751     my $cmd = { execute => $execute, arguments => \%params };
2752     vm_qmp_command($vmid, $cmd);
2753 }
2754
2755 sub vm_mon_cmd_nocheck {
2756     my ($vmid, $execute, %params) = @_;
2757
2758     my $cmd = { execute => $execute, arguments => \%params };
2759     vm_qmp_command($vmid, $cmd, 1);
2760 }
2761
2762 sub vm_qmp_command {
2763     my ($vmid, $cmd, $nocheck) = @_;
2764
2765     my $res;
2766
2767     eval {
2768         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2769         my $sname = PVE::QemuServer::qmp_socket($vmid);
2770         if (-e $sname) {
2771             my $qmpclient = PVE::QMPClient->new();
2772
2773             $res = $qmpclient->cmd($vmid, $cmd);
2774         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
2775             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2776                 if scalar(%{$cmd->{arguments}});
2777             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
2778         } else {
2779             die "unable to open monitor socket\n";
2780         }
2781     };
2782     if (my $err = $@) {
2783         syslog("err", "VM $vmid qmp command failed - $err");
2784         die $err;
2785     }
2786
2787     return $res;
2788 }
2789
2790 sub vm_human_monitor_command {
2791     my ($vmid, $cmdline) = @_;
2792
2793     my $res;
2794
2795     my $cmd = {
2796         execute => 'human-monitor-command',
2797         arguments => { 'command-line' => $cmdline},
2798     };
2799
2800     return vm_qmp_command($vmid, $cmd);
2801 }
2802
2803 sub vm_commandline {
2804     my ($storecfg, $vmid) = @_;
2805
2806     my $conf = load_config($vmid);
2807
2808     my $defaults = load_defaults();
2809
2810     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2811
2812     return join(' ', @$cmd);
2813 }
2814
2815 sub vm_reset {
2816     my ($vmid, $skiplock) = @_;
2817
2818     lock_config($vmid, sub {
2819
2820         my $conf = load_config($vmid);
2821
2822         check_lock($conf) if !$skiplock;
2823
2824         vm_mon_cmd($vmid, "system_reset");
2825     });
2826 }
2827
2828 sub get_vm_volumes {
2829     my ($conf) = @_;
2830
2831     my $vollist = [];
2832     foreach_drive($conf, sub {
2833         my ($ds, $drive) = @_;
2834
2835         my ($sid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
2836         return if !$sid;
2837
2838         my $volid = $drive->{file};
2839         return if !$volid || $volid =~ m|^/|;
2840
2841         push @$vollist, $volid;
2842     });
2843
2844     return $vollist;
2845 }
2846
2847 sub vm_stop_cleanup {
2848     my ($storecfg, $vmid, $conf, $keepActive) = @_;
2849
2850     eval {
2851         fairsched_rmnod($vmid); # try to destroy group
2852
2853         if (!$keepActive) {
2854             my $vollist = get_vm_volumes($conf);
2855             PVE::Storage::deactivate_volumes($storecfg, $vollist);
2856         }
2857
2858         foreach my $ext (qw(mon pid vnc)) {
2859             unlink "/var/run/qemu-server/${vmid}.$ext";
2860         }
2861     };
2862     warn $@ if $@; # avoid errors - just warn
2863 }
2864
2865 # Note: use $nockeck to skip tests if VM configuration file exists.
2866 # We need that when migration VMs to other nodes (files already moved)
2867 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
2868 sub vm_stop {
2869     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
2870
2871     $timeout = 60 if !defined($timeout);
2872
2873     $force = 1 if !defined($force) && !$shutdown;
2874
2875     lock_config($vmid, sub {
2876
2877         my $pid = check_running($vmid, $nocheck);
2878         return if !$pid;
2879
2880         my $conf;
2881         if (!$nocheck) {
2882             $conf = load_config($vmid);
2883             check_lock($conf) if !$skiplock;
2884         }
2885
2886         eval {
2887             if ($shutdown) {
2888                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
2889
2890             } else {
2891                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
2892             }
2893         };
2894         my $err = $@;
2895
2896         if (!$err) {
2897             my $count = 0;
2898             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2899                 $count++;
2900                 sleep 1;
2901             }
2902
2903             if ($count >= $timeout) {
2904                 if ($force) {
2905                     warn "VM still running - terminating now with SIGTERM\n";
2906                     kill 15, $pid;
2907                 } else {
2908                     die "VM quit/powerdown failed - got timeout\n";
2909                 }
2910             } else {
2911                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2912                 return;
2913             }
2914         } else {
2915             if ($force) {
2916                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
2917                 kill 15, $pid;
2918             } else {
2919                 die "VM quit/powerdown failed\n";
2920             }
2921         }
2922
2923         # wait again
2924         $timeout = 10;
2925
2926         my $count = 0;
2927         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2928             $count++;
2929             sleep 1;
2930         }
2931
2932         if ($count >= $timeout) {
2933             warn "VM still running - terminating now with SIGKILL\n";
2934             kill 9, $pid;
2935             sleep 1;
2936         }
2937
2938         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2939    });
2940 }
2941
2942 sub vm_suspend {
2943     my ($vmid, $skiplock) = @_;
2944
2945     lock_config($vmid, sub {
2946
2947         my $conf = load_config($vmid);
2948
2949         check_lock($conf) if !$skiplock;
2950
2951         vm_mon_cmd($vmid, "stop");
2952     });
2953 }
2954
2955 sub vm_resume {
2956     my ($vmid, $skiplock) = @_;
2957
2958     lock_config($vmid, sub {
2959
2960         my $conf = load_config($vmid);
2961
2962         check_lock($conf) if !$skiplock;
2963
2964         vm_mon_cmd($vmid, "cont");
2965     });
2966 }
2967
2968 sub vm_sendkey {
2969     my ($vmid, $skiplock, $key) = @_;
2970
2971     lock_config($vmid, sub {
2972
2973         my $conf = load_config($vmid);
2974
2975         # there is no qmp command, so we use the human monitor command
2976         vm_human_monitor_command($vmid, "sendkey $key");
2977     });
2978 }
2979
2980 sub vm_destroy {
2981     my ($storecfg, $vmid, $skiplock) = @_;
2982
2983     lock_config($vmid, sub {
2984
2985         my $conf = load_config($vmid);
2986
2987         check_lock($conf) if !$skiplock;
2988
2989         if (!check_running($vmid)) {
2990             fairsched_rmnod($vmid); # try to destroy group
2991             destroy_vm($storecfg, $vmid);
2992         } else {
2993             die "VM $vmid is running - destroy failed\n";
2994         }
2995     });
2996 }
2997
2998 # pci helpers
2999
3000 sub file_write {
3001     my ($filename, $buf) = @_;
3002
3003     my $fh = IO::File->new($filename, "w");
3004     return undef if !$fh;
3005
3006     my $res = print $fh $buf;
3007
3008     $fh->close();
3009
3010     return $res;
3011 }
3012
3013 sub pci_device_info {
3014     my ($name) = @_;
3015
3016     my $res;
3017
3018     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3019     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3020
3021     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3022     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3023
3024     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3025     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3026
3027     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3028     return undef if !defined($product) || $product !~ s/^0x//;
3029
3030     $res = {
3031         name => $name,
3032         vendor => $vendor,
3033         product => $product,
3034         domain => $domain,
3035         bus => $bus,
3036         slot => $slot,
3037         func => $func,
3038         irq => $irq,
3039         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3040     };
3041
3042     return $res;
3043 }
3044
3045 sub pci_dev_reset {
3046     my ($dev) = @_;
3047
3048     my $name = $dev->{name};
3049
3050     my $fn = "$pcisysfs/devices/$name/reset";
3051
3052     return file_write($fn, "1");
3053 }
3054
3055 sub pci_dev_bind_to_stub {
3056     my ($dev) = @_;
3057
3058     my $name = $dev->{name};
3059
3060     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3061     return 1 if -d $testdir;
3062
3063     my $data = "$dev->{vendor} $dev->{product}";
3064     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3065
3066     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3067     if (!file_write($fn, $name)) {
3068         return undef if -f $fn;
3069     }
3070
3071     $fn = "$pcisysfs/drivers/pci-stub/bind";
3072     if (! -d $testdir) {
3073         return undef if !file_write($fn, $name);
3074     }
3075
3076     return -d $testdir;
3077 }
3078
3079 sub print_pci_addr {
3080     my ($id) = @_;
3081
3082     my $res = '';
3083     my $devices = {
3084         #addr1 : ide,parallel,serial (motherboard)
3085         #addr2 : first videocard
3086         balloon0 => { bus => 0, addr => 3 },
3087         watchdog => { bus => 0, addr => 4 },
3088         scsihw0 => { bus => 0, addr => 5 },
3089         scsihw1 => { bus => 0, addr => 6 },
3090         ahci0 => { bus => 0, addr => 7 },
3091         virtio0 => { bus => 0, addr => 10 },
3092         virtio1 => { bus => 0, addr => 11 },
3093         virtio2 => { bus => 0, addr => 12 },
3094         virtio3 => { bus => 0, addr => 13 },
3095         virtio4 => { bus => 0, addr => 14 },
3096         virtio5 => { bus => 0, addr => 15 },
3097         hostpci0 => { bus => 0, addr => 16 },
3098         hostpci1 => { bus => 0, addr => 17 },
3099         net0 => { bus => 0, addr => 18 },
3100         net1 => { bus => 0, addr => 19 },
3101         net2 => { bus => 0, addr => 20 },
3102         net3 => { bus => 0, addr => 21 },
3103         net4 => { bus => 0, addr => 22 },
3104         net5 => { bus => 0, addr => 23 },
3105         #addr29 : usb-host (pve-usb.cfg)
3106     };
3107
3108     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3109            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3110            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
3111     }
3112     return $res;
3113
3114 }
3115
3116 sub vm_balloonset {
3117     my ($vmid, $value) = @_;
3118
3119     vm_mon_cmd($vmid, "balloon", value => $value);
3120 }
3121
3122 # vzdump restore implementaion
3123
3124 sub archive_read_firstfile {
3125     my $archive = shift;
3126
3127     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3128
3129     # try to detect archive type first
3130     my $pid = open (TMP, "tar tf '$archive'|") ||
3131         die "unable to open file '$archive'\n";
3132     my $firstfile = <TMP>;
3133     kill 15, $pid;
3134     close TMP;
3135
3136     die "ERROR: archive contaions no data\n" if !$firstfile;
3137     chomp $firstfile;
3138
3139     return $firstfile;
3140 }
3141
3142 sub restore_cleanup {
3143     my $statfile = shift;
3144
3145     print STDERR "starting cleanup\n";
3146
3147     if (my $fd = IO::File->new($statfile, "r")) {
3148         while (defined(my $line = <$fd>)) {
3149             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3150                 my $volid = $2;
3151                 eval {
3152                     if ($volid =~ m|^/|) {
3153                         unlink $volid || die 'unlink failed\n';
3154                     } else {
3155                         my $cfg = cfs_read_file('storage.cfg');
3156                         PVE::Storage::vdisk_free($cfg, $volid);
3157                     }
3158                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3159                 };
3160                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3161             } else {
3162                 print STDERR "unable to parse line in statfile - $line";
3163             }
3164         }
3165         $fd->close();
3166     }
3167 }
3168
3169 sub restore_archive {
3170     my ($archive, $vmid, $user, $opts) = @_;
3171
3172     if ($archive ne '-') {
3173         my $firstfile = archive_read_firstfile($archive);
3174         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3175             if $firstfile ne 'qemu-server.conf';
3176     }
3177
3178     my $tocmd = "/usr/lib/qemu-server/qmextract";
3179
3180     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3181     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3182     $tocmd .= ' --prealloc' if $opts->{prealloc};
3183     $tocmd .= ' --info' if $opts->{info};
3184
3185     # tar option "xf" does not autodetect compression when read from STDIN,
3186     # so we pipe to zcat
3187     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3188         PVE::Tools::shellquote("--to-command=$tocmd");
3189
3190     my $tmpdir = "/var/tmp/vzdumptmp$$";
3191     mkpath $tmpdir;
3192
3193     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3194     local $ENV{VZDUMP_VMID} = $vmid;
3195     local $ENV{VZDUMP_USER} = $user;
3196
3197     my $conffile = PVE::QemuServer::config_file($vmid);
3198     my $tmpfn = "$conffile.$$.tmp";
3199
3200     # disable interrupts (always do cleanups)
3201     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3202         print STDERR "got interrupt - ignored\n";
3203     };
3204
3205     eval {
3206         # enable interrupts
3207         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3208             die "interrupted by signal\n";
3209         };
3210
3211         if ($archive eq '-') {
3212             print "extracting archive from STDIN\n";
3213             run_command($cmd, input => "<&STDIN");
3214         } else {
3215             print "extracting archive '$archive'\n";
3216             run_command($cmd);
3217         }
3218
3219         return if $opts->{info};
3220
3221         # read new mapping
3222         my $map = {};
3223         my $statfile = "$tmpdir/qmrestore.stat";
3224         if (my $fd = IO::File->new($statfile, "r")) {
3225             while (defined (my $line = <$fd>)) {
3226                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3227                     $map->{$1} = $2 if $1;
3228                 } else {
3229                     print STDERR "unable to parse line in statfile - $line\n";
3230                 }
3231             }
3232             $fd->close();
3233         }
3234
3235         my $confsrc = "$tmpdir/qemu-server.conf";
3236
3237         my $srcfd = new IO::File($confsrc, "r") ||
3238             die "unable to open file '$confsrc'\n";
3239
3240         my $outfd = new IO::File ($tmpfn, "w") ||
3241             die "unable to write config for VM $vmid\n";
3242
3243         my $netcount = 0;
3244
3245         while (defined (my $line = <$srcfd>)) {
3246             next if $line =~ m/^\#vzdump\#/;
3247             next if $line =~ m/^lock:/;
3248             next if $line =~ m/^unused\d+:/;
3249
3250             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3251                 # try to convert old 1.X settings
3252                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3253                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3254                     my ($model, $macaddr) = split(/\=/, $devconfig);
3255                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3256                     my $net = {
3257                         model => $model,
3258                         bridge => "vmbr$ind",
3259                         macaddr => $macaddr,
3260                     };
3261                     my $netstr = print_net($net);
3262                     print $outfd "net${netcount}: $netstr\n";
3263                     $netcount++;
3264                 }
3265             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3266                 my ($id, $netstr) = ($1, $2);
3267                 my $net = parse_net($netstr);
3268                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3269                 $netstr = print_net($net);
3270                 print $outfd "$id: $netstr\n";
3271             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3272                 my $virtdev = $1;
3273                 my $value = $2;
3274                 if ($line =~ m/backup=no/) {
3275                     print $outfd "#$line";
3276                 } elsif ($virtdev && $map->{$virtdev}) {
3277                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3278                     $di->{file} = $map->{$virtdev};
3279                     $value = PVE::QemuServer::print_drive($vmid, $di);
3280                     print $outfd "$virtdev: $value\n";
3281                 } else {
3282                     print $outfd $line;
3283                 }
3284             } else {
3285                 print $outfd $line;
3286             }
3287         }
3288
3289         $srcfd->close();
3290         $outfd->close();
3291     };
3292     my $err = $@;
3293
3294     if ($err) {
3295
3296         unlink $tmpfn;
3297
3298         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3299
3300         die $err;
3301     }
3302
3303     rmtree $tmpdir;
3304
3305     rename $tmpfn, $conffile ||
3306         die "unable to commit configuration file '$conffile'\n";
3307 };
3308
3309 1;