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=device-$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=device-$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, $res, $volid) = @_;
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     $res->{$key} = $volid;
1037 }
1038
1039 # fixme: remove all thos $noerr parameters?
1040
1041 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1042 sub verify_bootdisk {
1043     my ($value, $noerr) = @_;
1044
1045     return $value if valid_drivename($value);
1046
1047     return undef if $noerr;
1048
1049     die "invalid boot disk '$value'\n";
1050 }
1051
1052 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1053 sub verify_net {
1054     my ($value, $noerr) = @_;
1055
1056     return $value if parse_net($value);
1057
1058     return undef if $noerr;
1059
1060     die "unable to parse network options\n";
1061 }
1062
1063 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1064 sub verify_drive {
1065     my ($value, $noerr) = @_;
1066
1067     return $value if parse_drive(undef, $value);
1068
1069     return undef if $noerr;
1070
1071     die "unable to parse drive options\n";
1072 }
1073
1074 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1075 sub verify_hostpci {
1076     my ($value, $noerr) = @_;
1077
1078     return $value if parse_hostpci($value);
1079
1080     return undef if $noerr;
1081
1082     die "unable to parse pci id\n";
1083 }
1084
1085 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1086 sub verify_watchdog {
1087     my ($value, $noerr) = @_;
1088
1089     return $value if parse_watchdog($value);
1090
1091     return undef if $noerr;
1092
1093     die "unable to parse watchdog options\n";
1094 }
1095
1096 sub parse_watchdog {
1097     my ($value) = @_;
1098
1099     return undef if !$value;
1100
1101     my $res = {};
1102
1103     foreach my $p (split(/,/, $value)) {
1104         next if $p =~ m/^\s*$/;
1105
1106         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1107             $res->{model} = $2;
1108         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1109             $res->{action} = $2;
1110         } else {
1111             return undef;
1112         }
1113     }
1114
1115     return $res;
1116 }
1117
1118 sub parse_usb_device {
1119     my ($value) = @_;
1120
1121     return undef if !$value;
1122
1123     my @dl = split(/,/, $value);
1124     my $found;
1125
1126     my $res = {};
1127     foreach my $v (@dl) {
1128         if ($v =~ m/^host=([0-9A-Fa-f]{4}):([0-9A-Fa-f]{4})$/) {
1129             $found = 1;
1130             $res->{vendorid} = $1;
1131             $res->{productid} = $2;
1132         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1133             $found = 1;
1134             $res->{hostbus} = $1;
1135             $res->{hostport} = $2;
1136         } else {
1137             return undef;
1138         }
1139     }
1140     return undef if !$found;
1141
1142     return $res;
1143 }
1144
1145 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1146 sub verify_usb_device {
1147     my ($value, $noerr) = @_;
1148
1149     return $value if parse_usb_device($value);
1150
1151     return undef if $noerr;
1152
1153     die "unable to parse usb device\n";
1154 }
1155
1156 # add JSON properties for create and set function
1157 sub json_config_properties {
1158     my $prop = shift;
1159
1160     foreach my $opt (keys %$confdesc) {
1161         $prop->{$opt} = $confdesc->{$opt};
1162     }
1163
1164     return $prop;
1165 }
1166
1167 sub check_type {
1168     my ($key, $value) = @_;
1169
1170     die "unknown setting '$key'\n" if !$confdesc->{$key};
1171
1172     my $type = $confdesc->{$key}->{type};
1173
1174     if (!defined($value)) {
1175         die "got undefined value\n";
1176     }
1177
1178     if ($value =~ m/[\n\r]/) {
1179         die "property contains a line feed\n";
1180     }
1181
1182     if ($type eq 'boolean') {
1183         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1184         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1185         die "type check ('boolean') failed - got '$value'\n";
1186     } elsif ($type eq 'integer') {
1187         return int($1) if $value =~ m/^(\d+)$/;
1188         die "type check ('integer') failed - got '$value'\n";
1189     } elsif ($type eq 'string') {
1190         if (my $fmt = $confdesc->{$key}->{format}) {
1191             if ($fmt eq 'pve-qm-drive') {
1192                 # special case - we need to pass $key to parse_drive()
1193                 my $drive = parse_drive($key, $value);
1194                 return $value if $drive;
1195                 die "unable to parse drive options\n";
1196             }
1197             PVE::JSONSchema::check_format($fmt, $value);
1198             return $value;
1199         }
1200         $value =~ s/^\"(.*)\"$/$1/;
1201         return $value;
1202     } else {
1203         die "internal error"
1204     }
1205 }
1206
1207 sub lock_config {
1208     my ($vmid, $code, @param) = @_;
1209
1210     my $filename = config_file_lock($vmid);
1211
1212     my $res = lock_file($filename, 10, $code, @param);
1213
1214     die $@ if $@;
1215
1216     return $res;
1217 }
1218
1219 sub cfs_config_path {
1220     my ($vmid, $node) = @_;
1221
1222     $node = $nodename if !$node;
1223     return "nodes/$node/qemu-server/$vmid.conf";
1224 }
1225
1226 sub check_iommu_support{
1227     #fixme : need to check IOMMU support
1228     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1229
1230     my $iommu=1;
1231     return $iommu;
1232
1233 }
1234
1235 sub config_file {
1236     my ($vmid, $node) = @_;
1237
1238     my $cfspath = cfs_config_path($vmid, $node);
1239     return "/etc/pve/$cfspath";
1240 }
1241
1242 sub config_file_lock {
1243     my ($vmid) = @_;
1244
1245     return "$lock_dir/lock-$vmid.conf";
1246 }
1247
1248 sub touch_config {
1249     my ($vmid) = @_;
1250
1251     my $conf = config_file($vmid);
1252     utime undef, undef, $conf;
1253 }
1254
1255 sub create_disks {
1256     my ($storecfg, $vmid, $settings, $conf, $default_storage) = @_;
1257
1258     my $vollist = [];
1259
1260     eval {
1261         foreach_drive($settings, sub {
1262             my ($ds, $disk) = @_;
1263
1264             return if drive_is_cdrom($disk);
1265
1266             my $file = $disk->{file};
1267
1268             if ($file =~ m/^(([^:\s]+):)?(\d+(\.\d+)?)$/) {
1269                 my $storeid = $2 || $default_storage;
1270                 my $size = $3;
1271                 my $defformat = PVE::Storage::storage_default_format($storecfg, $storeid);
1272                 my $fmt = $disk->{format} || $defformat;
1273                 syslog('info', "VM $vmid creating new disk - size is $size GB");
1274
1275                 my $volid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $vmid,
1276                                                        $fmt, undef, $size*1024*1024);
1277
1278                 $disk->{file} = $volid;
1279                 delete $disk->{format}; # no longer needed
1280                 push @$vollist, $volid;
1281                 $settings->{$ds} = PVE::QemuServer::print_drive($vmid, $disk);
1282             } else {
1283                 my $path;
1284                 if ($disk->{file} =~ m|^/dev/.+|) {
1285                     $path = $disk->{file};
1286                 } else {
1287                     $path = PVE::Storage::path($storecfg, $disk->{file});
1288                 }
1289                 if (!(-f $path || -b $path)) {
1290                     die "image '$path' does not exists\n";
1291                 }
1292             }
1293             PVE::QemuServer::vm_deviceadd($storecfg, $conf, $vmid, $ds, $disk) if defined($conf);
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_deviceadd {
2286     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2287     return if !check_running($vmid) || !$conf->{hotplug} || $conf->{$deviceid};
2288
2289     if($deviceid =~ m/^(virtio)(\d+)$/) {
2290
2291         my $drive = print_drive_full($storecfg, $vmid, $device);
2292         my $ret = vm_monitor_command($vmid, "drive_add auto $drive");
2293         # If the command succeeds qemu prints: "OK"
2294         if ($ret !~ m/OK/s) {
2295            die "adding drive failed: $ret";
2296         }
2297
2298         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2299         $ret = vm_monitor_command($vmid, "device_add $devicefull");
2300         $ret =~ s/^\s+//;
2301         # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2302         die 'error on hotplug device : $ret' if $ret ne "";
2303     }
2304
2305     for (my $i = 0; $i <= 5; $i++) {
2306         my $devices_list = vm_devices_list($vmid);
2307         return if defined($devices_list->{$deviceid});
2308         sleep 1;
2309     }
2310
2311     die "error on hotplug device $deviceid";
2312 }
2313
2314 sub vm_devicedel {
2315     my ($vmid, $conf, $deviceid) = @_;
2316
2317     return if !check_running ($vmid) || !$conf->{hotplug};
2318
2319     die "can't unplug bootdisk" if $conf->{bootdisk} eq $deviceid;
2320
2321     if($deviceid =~ m/^(virtio)(\d+)$/){
2322
2323         my $ret = vm_monitor_command($vmid, "drive_del drive-$deviceid");
2324         $ret =~ s/^\s+//;
2325         if ($ret =~ m/Device \'.*?\' not found/s) {
2326             # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2327         }
2328         elsif ($ret ne "") {
2329             die "deleting drive $deviceid failed : $ret";
2330         }
2331
2332         $ret = vm_monitor_command($vmid, "device_del $deviceid");
2333         $ret =~ s/^\s+//;
2334         die 'detaching device $deviceid failed : $ret' if $ret ne "";
2335
2336     }
2337
2338     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2339     for (my $i = 0; $i <= 5; $i++) {
2340         my $devices_list = vm_devices_list($vmid);
2341         return if !defined($devices_list->{$deviceid});
2342         sleep 1;
2343     }
2344     die "error on hot-plugging device $deviceid";
2345
2346
2347 }
2348
2349 sub vm_start {
2350     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2351
2352     lock_config($vmid, sub {
2353         my $conf = load_config($vmid);
2354
2355         check_lock($conf) if !$skiplock;
2356
2357         die "VM $vmid already running\n" if check_running($vmid);
2358
2359         my $migrate_uri;
2360         my $migrate_port = 0;
2361
2362         if ($statefile) {
2363             if ($statefile eq 'tcp') {
2364                 $migrate_port = next_migrate_port();
2365                 $migrate_uri = "tcp:localhost:${migrate_port}";
2366             } else {
2367                 if (-f $statefile) {
2368                     $migrate_uri = "exec:cat $statefile";
2369                 } else {
2370                     warn "state file '$statefile' does not exist - doing normal startup\n";
2371                 }
2372             }
2373         }
2374
2375         my $defaults = load_defaults();
2376
2377         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2378         # host pci devices
2379         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2380           my $d = parse_hostpci($conf->{"hostpci$i"});
2381           next if !$d;
2382           my $info = pci_device_info("0000:$d->{pciid}");
2383           die "IOMMU not present\n" if !check_iommu_support();
2384           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2385           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2386           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2387         }
2388
2389         PVE::Storage::activate_volumes($storecfg, $vollist);
2390
2391         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2392         my $err = $@;
2393         die "start failed: $err" if $err;
2394
2395         if ($statefile) {
2396
2397             if ($statefile eq 'tcp') {
2398                 print "migration listens on port $migrate_port\n";
2399             } else {
2400                 unlink $statefile;
2401                 # fixme: send resume - is that necessary ?
2402                 eval { vm_monitor_command($vmid, "cont"); };
2403             }
2404         }
2405
2406         # always set migrate speed (overwrite kvm default of 32m)
2407         # we set a very hight default of 8192m which is basically unlimited
2408         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2409         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2410         eval {
2411             my $cmd = "migrate_set_speed ${migrate_speed}m";
2412             vm_monitor_command($vmid, $cmd);
2413         };
2414
2415         if (my $migrate_downtime =
2416             $conf->{migrate_downtime} || $defaults->{migrate_downtime}) {
2417             my $cmd = "migrate_set_downtime ${migrate_downtime}";
2418             eval { vm_monitor_command($vmid, $cmd); };
2419         }
2420
2421         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2422     });
2423 }
2424
2425 sub __read_avail {
2426     my ($fh, $timeout) = @_;
2427
2428     my $sel = new IO::Select;
2429     $sel->add($fh);
2430
2431     my $res = '';
2432     my $buf;
2433
2434     my @ready;
2435     while (scalar (@ready = $sel->can_read($timeout))) {
2436         my $count;
2437         if ($count = $fh->sysread($buf, 8192)) {
2438             if ($buf =~ /^(.*)\(qemu\) $/s) {
2439                 $res .= $1;
2440                 last;
2441             } else {
2442                 $res .= $buf;
2443             }
2444         } else {
2445             if (!defined($count)) {
2446                 die "$!\n";
2447             }
2448             last;
2449         }
2450     }
2451
2452     die "monitor read timeout\n" if !scalar(@ready);
2453
2454     return $res;
2455 }
2456
2457 sub vm_monitor_command {
2458     my ($vmid, $cmdstr, $nocheck) = @_;
2459
2460     my $res;
2461
2462     eval {
2463         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2464
2465         my $sname = monitor_socket($vmid);
2466
2467         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2468             die "unable to connect to VM $vmid socket - $!\n";
2469
2470         my $timeout = 3;
2471
2472         # hack: migrate sometime blocks the monitor (when migrate_downtime
2473         # is set)
2474         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2475             $timeout = 60*60; # 1 hour
2476         }
2477
2478         # read banner;
2479         my $data = __read_avail($sock, $timeout);
2480
2481         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2482             die "got unexpected qemu monitor banner\n";
2483         }
2484
2485         my $sel = new IO::Select;
2486         $sel->add($sock);
2487
2488         if (!scalar(my @ready = $sel->can_write($timeout))) {
2489             die "monitor write error - timeout";
2490         }
2491
2492         my $fullcmd = "$cmdstr\r";
2493
2494         my $b;
2495         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2496             die "monitor write error - $!";
2497         }
2498
2499         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2500
2501         $timeout = 20;
2502
2503         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2504             $timeout = 60*60; # 1 hour
2505         } elsif ($cmdstr =~ m/^(eject|change)/) {
2506             $timeout = 60; # note: cdrom mount command is slow
2507         }
2508         if ($res = __read_avail($sock, $timeout)) {
2509
2510             my @lines = split("\r?\n", $res);
2511
2512             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2513
2514             $res = join("\n", @lines);
2515             $res .= "\n";
2516         }
2517     };
2518
2519     my $err = $@;
2520
2521     if ($err) {
2522         syslog("err", "VM $vmid monitor command failed - $err");
2523         die $err;
2524     }
2525
2526     return $res;
2527 }
2528
2529 sub vm_commandline {
2530     my ($storecfg, $vmid) = @_;
2531
2532     my $conf = load_config($vmid);
2533
2534     my $defaults = load_defaults();
2535
2536     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2537
2538     return join(' ', @$cmd);
2539 }
2540
2541 sub vm_reset {
2542     my ($vmid, $skiplock) = @_;
2543
2544     lock_config($vmid, sub {
2545
2546         my $conf = load_config($vmid);
2547
2548         check_lock($conf) if !$skiplock;
2549
2550         vm_monitor_command($vmid, "system_reset");
2551     });
2552 }
2553
2554 sub get_vm_volumes {
2555     my ($conf) = @_;
2556
2557     my $vollist = [];
2558     foreach_drive($conf, sub {
2559         my ($ds, $drive) = @_;
2560
2561         my ($sid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
2562         return if !$sid;
2563
2564         my $volid = $drive->{file};
2565         return if !$volid || $volid =~ m|^/|;
2566
2567         push @$vollist, $volid;
2568     });
2569
2570     return $vollist;
2571 }
2572
2573 sub vm_stop_cleanup {
2574     my ($storecfg, $vmid, $conf, $keepActive) = @_;
2575
2576     eval {
2577         fairsched_rmnod($vmid); # try to destroy group
2578
2579         if (!$keepActive) {
2580             my $vollist = get_vm_volumes($conf);
2581             PVE::Storage::deactivate_volumes($storecfg, $vollist);
2582         }
2583     };
2584     warn $@ if $@; # avoid errors - just warn
2585 }
2586
2587 # Note: use $nockeck to skip tests if VM configuration file exists.
2588 # We need that when migration VMs to other nodes (files already moved)
2589 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
2590 sub vm_stop {
2591     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
2592
2593     $timeout = 60 if !defined($timeout);
2594
2595     $force = 1 if !defined($force) && !$shutdown;
2596
2597     lock_config($vmid, sub {
2598
2599         my $pid = check_running($vmid, $nocheck);
2600         return if !$pid;
2601
2602         my $conf;
2603         if (!$nocheck) {
2604             $conf = load_config($vmid);
2605             check_lock($conf) if !$skiplock;
2606         }
2607
2608         eval {
2609             if ($shutdown) {
2610                 vm_monitor_command($vmid, "system_powerdown", $nocheck);
2611             } else {
2612                 vm_monitor_command($vmid, "quit", $nocheck);
2613             }
2614         };
2615         my $err = $@;
2616
2617         if (!$err) {
2618             my $count = 0;
2619             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2620                 $count++;
2621                 sleep 1;
2622             }
2623
2624             if ($count >= $timeout) {
2625                 if ($force) {
2626                     warn "VM still running - terminating now with SIGTERM\n";
2627                     kill 15, $pid;
2628                 } else {
2629                     die "VM quit/powerdown failed - got timeout\n";
2630                 }
2631             } else {
2632                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2633                 return;
2634             }
2635         } else {
2636             if ($force) {
2637                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
2638                 kill 15, $pid;
2639             } else {
2640                 die "VM quit/powerdown failed\n";
2641             }
2642         }
2643
2644         # wait again
2645         $timeout = 10;
2646
2647         my $count = 0;
2648         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2649             $count++;
2650             sleep 1;
2651         }
2652
2653         if ($count >= $timeout) {
2654             warn "VM still running - terminating now with SIGKILL\n";
2655             kill 9, $pid;
2656             sleep 1;
2657         }
2658
2659         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2660    });
2661 }
2662
2663 sub vm_suspend {
2664     my ($vmid, $skiplock) = @_;
2665
2666     lock_config($vmid, sub {
2667
2668         my $conf = load_config($vmid);
2669
2670         check_lock($conf) if !$skiplock;
2671
2672         vm_monitor_command($vmid, "stop");
2673     });
2674 }
2675
2676 sub vm_resume {
2677     my ($vmid, $skiplock) = @_;
2678
2679     lock_config($vmid, sub {
2680
2681         my $conf = load_config($vmid);
2682
2683         check_lock($conf) if !$skiplock;
2684
2685         vm_monitor_command($vmid, "cont");
2686     });
2687 }
2688
2689 sub vm_sendkey {
2690     my ($vmid, $skiplock, $key) = @_;
2691
2692     lock_config($vmid, sub {
2693
2694         my $conf = load_config($vmid);
2695
2696         vm_monitor_command($vmid, "sendkey $key");
2697     });
2698 }
2699
2700 sub vm_destroy {
2701     my ($storecfg, $vmid, $skiplock) = @_;
2702
2703     lock_config($vmid, sub {
2704
2705         my $conf = load_config($vmid);
2706
2707         check_lock($conf) if !$skiplock;
2708
2709         if (!check_running($vmid)) {
2710             fairsched_rmnod($vmid); # try to destroy group
2711             destroy_vm($storecfg, $vmid);
2712         } else {
2713             die "VM $vmid is running - destroy failed\n";
2714         }
2715     });
2716 }
2717
2718 sub vm_stopall {
2719     my ($storecfg, $timeout) = @_;
2720
2721     $timeout = 3*60 if !$timeout;
2722
2723     my $cleanuphash = {};
2724
2725     my $vzlist = vzlist();
2726     my $count = 0;
2727     foreach my $vmid (keys %$vzlist) {
2728         next if !$vzlist->{$vmid}->{pid};
2729         $count++;
2730         $cleanuphash->{$vmid} = 1;
2731     }
2732
2733     return if !$count;
2734
2735     my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs\n";
2736     syslog('info', $msg);
2737     warn $msg;
2738
2739     foreach my $vmid (keys %$vzlist) {
2740         next if !$vzlist->{$vmid}->{pid};
2741         eval { vm_monitor_command($vmid, "system_powerdown"); };
2742         warn $@ if $@;
2743     }
2744
2745     my $wt = 5;
2746     my $maxtries = int(($timeout + $wt -1)/$wt);
2747     my $try = 0;
2748     while (($try < $maxtries) && $count) {
2749         $try++;
2750         sleep $wt;
2751
2752         $vzlist = vzlist();
2753         $count = 0;
2754         foreach my $vmid (keys %$vzlist) {
2755             next if !$vzlist->{$vmid}->{pid};
2756             $count++;
2757         }
2758         last if !$count;
2759     }
2760
2761     if ($count) {
2762
2763         foreach my $vmid (keys %$vzlist) {
2764             next if !$vzlist->{$vmid}->{pid};
2765
2766             warn "VM $vmid still running - sending stop now\n";
2767             eval { vm_monitor_command($vmid, "quit"); };
2768             warn $@ if $@;
2769         }
2770
2771         $timeout = 30;
2772         $maxtries = int(($timeout + $wt -1)/$wt);
2773         $try = 0;
2774         while (($try < $maxtries) && $count) {
2775             $try++;
2776             sleep $wt;
2777
2778             $vzlist = vzlist();
2779             $count = 0;
2780             foreach my $vmid (keys %$vzlist) {
2781                 next if !$vzlist->{$vmid}->{pid};
2782                 $count++;
2783             }
2784             last if !$count;
2785         }
2786
2787         if ($count) {
2788
2789             foreach my $vmid (keys %$vzlist) {
2790                 next if !$vzlist->{$vmid}->{pid};
2791
2792                 warn "VM $vmid still running - terminating now with SIGTERM\n";
2793                 kill 15, $vzlist->{$vmid}->{pid};
2794             }
2795             sleep 1;
2796         }
2797
2798         # this is called by system shotdown scripts, so remaining
2799         # processes gets killed anyways (no need to send kill -9 here)
2800     }
2801
2802     $vzlist = vzlist();
2803     foreach my $vmid (keys %$cleanuphash) {
2804         next if $vzlist->{$vmid}->{pid};
2805         eval {
2806             my $conf = load_config($vmid);
2807             vm_stop_cleanup($storecfg, $vmid, $conf);
2808         };
2809         warn $@ if $@;
2810     }
2811
2812     $msg = "Qemu Server stopped\n";
2813     syslog('info', $msg);
2814     print $msg;
2815 }
2816
2817 # pci helpers
2818
2819 sub file_write {
2820     my ($filename, $buf) = @_;
2821
2822     my $fh = IO::File->new($filename, "w");
2823     return undef if !$fh;
2824
2825     my $res = print $fh $buf;
2826
2827     $fh->close();
2828
2829     return $res;
2830 }
2831
2832 sub pci_device_info {
2833     my ($name) = @_;
2834
2835     my $res;
2836
2837     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
2838     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
2839
2840     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
2841     return undef if !defined($irq) || $irq !~ m/^\d+$/;
2842
2843     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
2844     return undef if !defined($vendor) || $vendor !~ s/^0x//;
2845
2846     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
2847     return undef if !defined($product) || $product !~ s/^0x//;
2848
2849     $res = {
2850         name => $name,
2851         vendor => $vendor,
2852         product => $product,
2853         domain => $domain,
2854         bus => $bus,
2855         slot => $slot,
2856         func => $func,
2857         irq => $irq,
2858         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
2859     };
2860
2861     return $res;
2862 }
2863
2864 sub pci_dev_reset {
2865     my ($dev) = @_;
2866
2867     my $name = $dev->{name};
2868
2869     my $fn = "$pcisysfs/devices/$name/reset";
2870
2871     return file_write($fn, "1");
2872 }
2873
2874 sub pci_dev_bind_to_stub {
2875     my ($dev) = @_;
2876
2877     my $name = $dev->{name};
2878
2879     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
2880     return 1 if -d $testdir;
2881
2882     my $data = "$dev->{vendor} $dev->{product}";
2883     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
2884
2885     my $fn = "$pcisysfs/devices/$name/driver/unbind";
2886     if (!file_write($fn, $name)) {
2887         return undef if -f $fn;
2888     }
2889
2890     $fn = "$pcisysfs/drivers/pci-stub/bind";
2891     if (! -d $testdir) {
2892         return undef if !file_write($fn, $name);
2893     }
2894
2895     return -d $testdir;
2896 }
2897
2898 sub print_pci_addr {
2899     my ($id) = @_;
2900
2901     my $res = '';
2902     my $devices = {
2903         #addr1 : ide,parallel,serial (motherboard)
2904         #addr2 : first videocard
2905         balloon0 => { bus => 0, addr => 3 },
2906         watchdog => { bus => 0, addr => 4 },
2907         lsi0 => { bus => 0, addr => 5 },
2908         lsi1 => { bus => 0, addr => 6 },
2909         virtio0 => { bus => 0, addr => 10 },
2910         virtio1 => { bus => 0, addr => 11 },
2911         virtio2 => { bus => 0, addr => 12 },
2912         virtio3 => { bus => 0, addr => 13 },
2913         virtio4 => { bus => 0, addr => 14 },
2914         virtio5 => { bus => 0, addr => 15 },
2915         hostpci0 => { bus => 0, addr => 16 },
2916         hostpci1 => { bus => 0, addr => 17 },
2917         net0 => { bus => 0, addr => 18 },
2918         net1 => { bus => 0, addr => 19 },
2919         net2 => { bus => 0, addr => 20 },
2920         net3 => { bus => 0, addr => 21 },
2921         net4 => { bus => 0, addr => 22 },
2922         net5 => { bus => 0, addr => 23 },
2923         #addr29 : usb-host (pve-usb.cfg)
2924     };
2925
2926     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
2927            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
2928            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
2929     }
2930     return $res;
2931
2932 }
2933
2934 sub vm_balloonset {
2935     my ($vmid, $value) = @_;
2936
2937     vm_monitor_command($vmid, "balloon $value");
2938 }
2939
2940 # vzdump restore implementaion
2941
2942 sub archive_read_firstfile {
2943     my $archive = shift;
2944
2945     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
2946
2947     # try to detect archive type first
2948     my $pid = open (TMP, "tar tf '$archive'|") ||
2949         die "unable to open file '$archive'\n";
2950     my $firstfile = <TMP>;
2951     kill 15, $pid;
2952     close TMP;
2953
2954     die "ERROR: archive contaions no data\n" if !$firstfile;
2955     chomp $firstfile;
2956
2957     return $firstfile;
2958 }
2959
2960 sub restore_cleanup {
2961     my $statfile = shift;
2962
2963     print STDERR "starting cleanup\n";
2964
2965     if (my $fd = IO::File->new($statfile, "r")) {
2966         while (defined(my $line = <$fd>)) {
2967             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
2968                 my $volid = $2;
2969                 eval {
2970                     if ($volid =~ m|^/|) {
2971                         unlink $volid || die 'unlink failed\n';
2972                     } else {
2973                         my $cfg = cfs_read_file('storage.cfg');
2974                         PVE::Storage::vdisk_free($cfg, $volid);
2975                     }
2976                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
2977                 };
2978                 print STDERR "unable to cleanup '$volid' - $@" if $@;
2979             } else {
2980                 print STDERR "unable to parse line in statfile - $line";
2981             }
2982         }
2983         $fd->close();
2984     }
2985 }
2986
2987 sub restore_archive {
2988     my ($archive, $vmid, $opts) = @_;
2989
2990     if ($archive ne '-') {
2991         my $firstfile = archive_read_firstfile($archive);
2992         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
2993             if $firstfile ne 'qemu-server.conf';
2994     }
2995
2996     my $tocmd = "/usr/lib/qemu-server/qmextract";
2997
2998     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
2999     $tocmd .= ' --prealloc' if $opts->{prealloc};
3000     $tocmd .= ' --info' if $opts->{info};
3001
3002     # tar option "xf" does not autodetect compression when read fron STDIN,
3003     # so we pipe to zcat
3004     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3005         PVE::Tools::shellquote("--to-command=$tocmd");
3006
3007     my $tmpdir = "/var/tmp/vzdumptmp$$";
3008     mkpath $tmpdir;
3009
3010     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3011     local $ENV{VZDUMP_VMID} = $vmid;
3012
3013     my $conffile = PVE::QemuServer::config_file($vmid);
3014     my $tmpfn = "$conffile.$$.tmp";
3015
3016     # disable interrupts (always do cleanups)
3017     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3018         print STDERR "got interrupt - ignored\n";
3019     };
3020
3021     eval {
3022         # enable interrupts
3023         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3024             die "interrupted by signal\n";
3025         };
3026
3027         if ($archive eq '-') {
3028             print "extracting archive from STDIN\n";
3029             run_command($cmd, input => "<&STDIN");
3030         } else {
3031             print "extracting archive '$archive'\n";
3032             run_command($cmd);
3033         }
3034
3035         return if $opts->{info};
3036
3037         # read new mapping
3038         my $map = {};
3039         my $statfile = "$tmpdir/qmrestore.stat";
3040         if (my $fd = IO::File->new($statfile, "r")) {
3041             while (defined (my $line = <$fd>)) {
3042                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3043                     $map->{$1} = $2 if $1;
3044                 } else {
3045                     print STDERR "unable to parse line in statfile - $line\n";
3046                 }
3047             }
3048             $fd->close();
3049         }
3050
3051         my $confsrc = "$tmpdir/qemu-server.conf";
3052
3053         my $srcfd = new IO::File($confsrc, "r") ||
3054             die "unable to open file '$confsrc'\n";
3055
3056         my $outfd = new IO::File ($tmpfn, "w") ||
3057             die "unable to write config for VM $vmid\n";
3058
3059         my $netcount = 0;
3060
3061         while (defined (my $line = <$srcfd>)) {
3062             next if $line =~ m/^\#vzdump\#/;
3063             next if $line =~ m/^lock:/;
3064             next if $line =~ m/^unused\d+:/;
3065
3066             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3067                 # try to convert old 1.X settings
3068                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3069                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3070                     my ($model, $macaddr) = split(/\=/, $devconfig);
3071                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3072                     my $net = {
3073                         model => $model,
3074                         bridge => "vmbr$ind",
3075                         macaddr => $macaddr,
3076                     };
3077                     my $netstr = print_net($net);
3078                     print $outfd "net${netcount}: $netstr\n";
3079                     $netcount++;
3080                 }
3081             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3082                 my ($id, $netstr) = ($1, $2);
3083                 my $net = parse_net($netstr);
3084                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3085                 $netstr = print_net($net);
3086                 print $outfd "$id: $netstr\n";
3087             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3088                 my $virtdev = $1;
3089                 my $value = $2;
3090                 if ($line =~ m/backup=no/) {
3091                     print $outfd "#$line";
3092                 } elsif ($virtdev && $map->{$virtdev}) {
3093                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3094                     $di->{file} = $map->{$virtdev};
3095                     $value = PVE::QemuServer::print_drive($vmid, $di);
3096                     print $outfd "$virtdev: $value\n";
3097                 } else {
3098                     print $outfd $line;
3099                 }
3100             } else {
3101                 print $outfd $line;
3102             }
3103         }
3104
3105         $srcfd->close();
3106         $outfd->close();
3107     };
3108     my $err = $@;
3109
3110     if ($err) {
3111
3112         unlink $tmpfn;
3113
3114         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3115
3116         die $err;
3117     }
3118
3119     rmtree $tmpdir;
3120
3121     rename $tmpfn, $conffile ||
3122         die "unable to commit configuration file '$conffile'\n";
3123 };
3124
3125 1;