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