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