PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use POSIX;
   5 use IO::Handle;
   6 use IO::Select;
   7 use IO::File;
   8 use IO::Dir;
   9 use IO::Socket::UNIX;
  10 use File::Basename;
  11 use File::Path;
  12 use File::stat;
  13 use Getopt::Long;
  14 use Digest::SHA1;
  15 use Fcntl ':flock';
  16 use Cwd 'abs_path';
  17 use IPC::Open3;
  18 use Fcntl;
  19 use PVE::SafeSyslog;
  20 use Storable qw(dclone);
  21 use PVE::Exception qw(raise raise_param_exc);
  22 use PVE::Storage;
  23 use PVE::Tools qw(run_command lock_file file_read_firstline);
  24 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  25 use PVE::INotify;
  26 use PVE::ProcFSTools;
  27 use Time::HiRes qw(gettimeofday);
  28
  29 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  30
  31 # Note about locking: we use flock on the config file protect
  32 # against concurent actions.
  33 # Aditionaly, we have a 'lock' setting in the config file. This
  34 # can be set to 'migrate' or 'backup'. Most actions are not
  35 # allowed when such lock is set. But you can ignore this kind of
  36 # lock with the --skiplock flag.
  37
  38 cfs_register_file('/qemu-server/', \&parse_vm_config);
  39
  40 PVE::JSONSchema::register_standard_option('skiplock', {
  41     description => "Ignore locks - only root is allowed to use this option.",
  42     type => 'boolean',
  43     optional => 1,
  44 });
  45
  46 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  47     description => "Some command save/restore state from this location.",
  48     type => 'string',
  49     maxLength => 128,
  50     optional => 1,
  51 });
  52
  53 #no warnings 'redefine';
  54
  55 unless(defined(&_VZSYSCALLS_H_)) {
  56     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  57     require 'sys/syscall.ph';
  58     if(defined(&__x86_64__)) {
  59         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  60         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  61         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  62         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  63         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  64         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  65         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  66         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  67     }
  68     elsif(defined( &__i386__) ) {
  69         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  70         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  71         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  72         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  73         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  74         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  75         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  76         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  77     } else {
  78         die("no fairsched syscall for this arch");
  79     }
  80     require 'asm/ioctl.ph';
  81     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  82 }
  83
  84 sub fairsched_mknod {
  85     my ($parent, $weight, $desired) = @_;
  86
  87     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
  88 }
  89
  90 sub fairsched_rmnod {
  91     my ($id) = @_;
  92
  93     return syscall(&__NR_fairsched_rmnod, int($id));
  94 }
  95
  96 sub fairsched_mvpr {
  97     my ($pid, $newid) = @_;
  98
  99     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 100 }
 101
 102 sub fairsched_vcpus {
 103     my ($id, $vcpus) = @_;
 104
 105     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 106 }
 107
 108 sub fairsched_rate {
 109     my ($id, $op, $rate) = @_;
 110
 111     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 112 }
 113
 114 use constant FAIRSCHED_SET_RATE  => 0;
 115 use constant FAIRSCHED_DROP_RATE => 1;
 116 use constant FAIRSCHED_GET_RATE  => 2;
 117
 118 sub fairsched_cpulimit {
 119     my ($id, $limit) = @_;
 120
 121     my $cpulim1024 = int($limit * 1024 / 100);
 122     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 123
 124     return fairsched_rate($id, $op, $cpulim1024);
 125 }
 126
 127 my $nodename = PVE::INotify::nodename();
 128
 129 mkdir "/etc/pve/nodes/$nodename";
 130 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 131 mkdir $confdir;
 132
 133 my $var_run_tmpdir = "/var/run/qemu-server";
 134 mkdir $var_run_tmpdir;
 135
 136 my $lock_dir = "/var/lock/qemu-server";
 137 mkdir $lock_dir;
 138
 139 my $pcisysfs = "/sys/bus/pci";
 140
 141 my $confdesc = {
 142     onboot => {
 143         optional => 1,
 144         type => 'boolean',
 145         description => "Specifies whether a VM will be started during system bootup.",
 146         default => 0,
 147     },
 148     autostart => {
 149         optional => 1,
 150         type => 'boolean',
 151         description => "Automatic restart after crash (currently ignored).",
 152         default => 0,
 153     },
 154     hotplug => {
 155         optional => 1,
 156         type => 'boolean',
 157         description => "Activate hotplug for disk and network device",
 158         default => 0,
 159     },
 160     reboot => {
 161         optional => 1,
 162         type => 'boolean',
 163         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 164         default => 1,
 165     },
 166     lock => {
 167         optional => 1,
 168         type => 'string',
 169         description => "Lock/unlock the VM.",
 170         enum => [qw(migrate backup)],
 171     },
 172     cpulimit => {
 173         optional => 1,
 174         type => 'integer',
 175         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 176         minimum => 0,
 177         default => 0,
 178     },
 179     cpuunits => {
 180         optional => 1,
 181         type => 'integer',
 182         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 183         minimum => 0,
 184         maximum => 500000,
 185         default => 1000,
 186     },
 187     memory => {
 188         optional => 1,
 189         type => 'integer',
 190         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 191         minimum => 16,
 192         default => 512,
 193     },
 194     balloon => {
 195         optional => 1,
 196         type => 'integer',
 197         description => "Amount of target RAM for the VM in MB.",
 198         minimum => 16,
 199     },
 200     keyboard => {
 201         optional => 1,
 202         type => 'string',
 203         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 204         enum => PVE::Tools::kvmkeymaplist(),
 205         default => 'en-us',
 206     },
 207     name => {
 208         optional => 1,
 209         type => 'string',
 210         description => "Set a name for the VM. Only used on the configuration web interface.",
 211     },
 212     description => {
 213         optional => 1,
 214         type => 'string',
 215         description => "Description for the VM. Only used on the configuration web interface.",
 216     },
 217     ostype => {
 218         optional => 1,
 219         type => 'string',
 220         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26)],
 221         description => <<EODESC,
 222 Used to enable special optimization/features for specific
 223 operating systems:
 224
 225 other  => unspecified OS
 226 wxp    => Microsoft Windows XP
 227 w2k    => Microsoft Windows 2000
 228 w2k3   => Microsoft Windows 2003
 229 w2k8   => Microsoft Windows 2008
 230 wvista => Microsoft Windows Vista
 231 win7   => Microsoft Windows 7
 232 l24    => Linux 2.4 Kernel
 233 l26    => Linux 2.6/3.X Kernel
 234
 235 other|l24|l26                  ... no special behaviour
 236 wxp|w2k|w2k3|w2k8|wvista|win7  ... use --localtime switch
 237 EODESC
 238     },
 239     boot => {
 240         optional => 1,
 241         type => 'string',
 242         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 243         pattern => '[acdn]{1,4}',
 244         default => 'cdn',
 245     },
 246     bootdisk => {
 247         optional => 1,
 248         type => 'string', format => 'pve-qm-bootdisk',
 249         description => "Enable booting from specified disk.",
 250         pattern => '(ide|scsi|virtio)\d+',
 251     },
 252     smp => {
 253         optional => 1,
 254         type => 'integer',
 255         description => "The number of CPUs. Please use option -sockets instead.",
 256         minimum => 1,
 257         default => 1,
 258     },
 259     sockets => {
 260         optional => 1,
 261         type => 'integer',
 262         description => "The number of CPU sockets.",
 263         minimum => 1,
 264         default => 1,
 265     },
 266     cores => {
 267         optional => 1,
 268         type => 'integer',
 269         description => "The number of cores per socket.",
 270         minimum => 1,
 271         default => 1,
 272     },
 273     acpi => {
 274         optional => 1,
 275         type => 'boolean',
 276         description => "Enable/disable ACPI.",
 277         default => 1,
 278     },
 279     kvm => {
 280         optional => 1,
 281         type => 'boolean',
 282         description => "Enable/disable KVM hardware virtualization.",
 283         default => 1,
 284     },
 285     tdf => {
 286         optional => 1,
 287         type => 'boolean',
 288         description => "Enable/disable time drift fix.",
 289         default => 1,
 290     },
 291     localtime => {
 292         optional => 1,
 293         type => 'boolean',
 294         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 295     },
 296     freeze => {
 297         optional => 1,
 298         type => 'boolean',
 299         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 300     },
 301     vga => {
 302         optional => 1,
 303         type => 'string',
 304         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win7/w2k8, and 'cirrur' for other OS types",
 305         enum => [qw(std cirrus vmware)],
 306     },
 307     watchdog => {
 308         optional => 1,
 309         type => 'string', format => 'pve-qm-watchdog',
 310         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 311         description => "Create a virtual hardware watchdog device.  Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
 312     },
 313     startdate => {
 314         optional => 1,
 315         type => 'string',
 316         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 317         description => "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
 318         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 319         default => 'now',
 320     },
 321     args => {
 322         optional => 1,
 323         type => 'string',
 324         description => <<EODESCR,
 325 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 326
 327 args: -no-reboot -no-hpet
 328 EODESCR
 329     },
 330     tablet => {
 331         optional => 1,
 332         type => 'boolean',
 333         default => 1,
 334         description => "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
 335     },
 336     migrate_speed => {
 337         optional => 1,
 338         type => 'integer',
 339         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 340         minimum => 0,
 341         default => 0,
 342     },
 343     migrate_downtime => {
 344         optional => 1,
 345         type => 'integer',
 346         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 347         minimum => 0,
 348         default => 1,
 349     },
 350     cdrom => {
 351         optional => 1,
 352         type => 'string', format => 'pve-qm-drive',
 353         typetext => 'volume',
 354         description => "This is an alias for option -ide2",
 355     },
 356     cpu => {
 357         optional => 1,
 358         description => "Emulated CPU type.",
 359         type => 'string',
 360         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom host) ],
 361         default => 'qemu64',
 362     },
 363 };
 364
 365 # what about other qemu settings ?
 366 #cpu => 'string',
 367 #machine => 'string',
 368 #fda => 'file',
 369 #fdb => 'file',
 370 #mtdblock => 'file',
 371 #sd => 'file',
 372 #pflash => 'file',
 373 #snapshot => 'bool',
 374 #bootp => 'file',
 375 ##tftp => 'dir',
 376 ##smb => 'dir',
 377 #kernel => 'file',
 378 #append => 'string',
 379 #initrd => 'file',
 380 ##soundhw => 'string',
 381
 382 while (my ($k, $v) = each %$confdesc) {
 383     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 384 }
 385
 386 my $MAX_IDE_DISKS = 4;
 387 my $MAX_SCSI_DISKS = 14;
 388 my $MAX_VIRTIO_DISKS = 6;
 389 my $MAX_USB_DEVICES = 5;
 390 my $MAX_NETS = 6;
 391 my $MAX_UNUSED_DISKS = 8;
 392 my $MAX_HOSTPCI_DEVICES = 2;
 393 my $MAX_SERIAL_PORTS = 4;
 394 my $MAX_PARALLEL_PORTS = 3;
 395
 396 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 397                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
 398 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 399
 400 # fixme:
 401 my $netdesc = {
 402     optional => 1,
 403     type => 'string', format => 'pve-qm-net',
 404     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>]",
 405     description => <<EODESCR,
 406 Specify network devices.
 407
 408 MODEL is one of: $nic_model_list_txt
 409
 410 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 411 automatically generated if not specified.
 412
 413 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 414
 415 Option 'rate' is used to limit traffic bandwidth from and to this interface. It is specified as floating point number, unit is 'Megabytes per second'.
 416
 417 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 418
 419 10.0.2.2   Gateway
 420 10.0.2.3   DNS Server
 421 10.0.2.4   SMB Server
 422
 423 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 424
 425 EODESCR
 426 };
 427 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 428
 429 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 430     $confdesc->{"net$i"} = $netdesc;
 431 }
 432
 433 my $drivename_hash;
 434
 435 my $idedesc = {
 436     optional => 1,
 437     type => 'string', format => 'pve-qm-drive',
 438     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 439     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to 3).",
 440 };
 441 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 442
 443 my $scsidesc = {
 444     optional => 1,
 445     type => 'string', format => 'pve-qm-drive',
 446     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 447     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to 13).",
 448 };
 449 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 450
 451 my $virtiodesc = {
 452     optional => 1,
 453     type => 'string', format => 'pve-qm-drive',
 454     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 455     description => "Use volume as VIRTIO hard disk (n is 0 to 5).",
 456 };
 457 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 458
 459 my $usbdesc = {
 460     optional => 1,
 461     type => 'string', format => 'pve-qm-usb-device',
 462     typetext => 'host=HOSTUSBDEVICE',
 463     description => <<EODESCR,
 464 Configure an USB device (n is 0 to 4). This can be used to
 465 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 466
 467 'bus-port(.port)*' (decimal numbers) or
 468 'vendor_id:product_id' (hexadeciaml numbers)
 469
 470 You can use the 'lsusb -t' command to list existing usb devices.
 471
 472 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 473
 474 EODESCR
 475 };
 476 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 477
 478 my $hostpcidesc = {
 479         optional => 1,
 480         type => 'string', format => 'pve-qm-hostpci',
 481         typetext => "HOSTPCIDEVICE",
 482         description => <<EODESCR,
 483 Map host pci devices. HOSTPCIDEVICE syntax is:
 484
 485 'bus:dev.func' (hexadecimal numbers)
 486
 487 You can us the 'lspci' command to list existing pci devices.
 488
 489 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 490
 491 Experimental: user reported problems with this option.
 492 EODESCR
 493 };
 494 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 495
 496 my $serialdesc = {
 497         optional => 1,
 498         type => 'string',
 499         pattern => '/dev/ttyS\d+',
 500         description =>  <<EODESCR,
 501 Map host serial devices (n is 0 to 3).
 502
 503 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 504
 505 Experimental: user reported problems with this option.
 506 EODESCR
 507 };
 508
 509 my $paralleldesc= {
 510         optional => 1,
 511         type => 'string',
 512         pattern => '/dev/parport\d+',
 513         description =>  <<EODESCR,
 514 Map host parallel devices (n is 0 to 2).
 515
 516 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 517
 518 Experimental: user reported problems with this option.
 519 EODESCR
 520 };
 521
 522 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 523     $confdesc->{"parallel$i"} = $paralleldesc;
 524 }
 525
 526 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 527     $confdesc->{"serial$i"} = $serialdesc;
 528 }
 529
 530 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 531     $confdesc->{"hostpci$i"} = $hostpcidesc;
 532 }
 533
 534 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 535     $drivename_hash->{"ide$i"} = 1;
 536     $confdesc->{"ide$i"} = $idedesc;
 537 }
 538
 539 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 540     $drivename_hash->{"scsi$i"} = 1;
 541     $confdesc->{"scsi$i"} = $scsidesc ;
 542 }
 543
 544 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 545     $drivename_hash->{"virtio$i"} = 1;
 546     $confdesc->{"virtio$i"} = $virtiodesc;
 547 }
 548
 549 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 550     $confdesc->{"usb$i"} = $usbdesc;
 551 }
 552
 553 my $unuseddesc = {
 554     optional => 1,
 555     type => 'string', format => 'pve-volume-id',
 556     description => "Reference to unused volumes.",
 557 };
 558
 559 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 560     $confdesc->{"unused$i"} = $unuseddesc;
 561 }
 562
 563 my $kvm_api_version = 0;
 564
 565 sub kvm_version {
 566
 567     return $kvm_api_version if $kvm_api_version;
 568
 569     my $fh = IO::File->new("</dev/kvm") ||
 570         return 0;
 571
 572     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 573         $kvm_api_version = $v;
 574     }
 575
 576     $fh->close();
 577
 578     return  $kvm_api_version;
 579 }
 580
 581 my $kvm_user_version;
 582
 583 sub kvm_user_version {
 584
 585     return $kvm_user_version if $kvm_user_version;
 586
 587     $kvm_user_version = 'unknown';
 588
 589     my $tmp = `kvm -help 2>/dev/null`;
 590
 591     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?) /) {
 592         $kvm_user_version = $2;
 593     }
 594
 595     return $kvm_user_version;
 596
 597 }
 598
 599 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 600
 601 sub disknames {
 602     # order is important - used to autoselect boot disk
 603     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 604             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 605             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))));
 606 }
 607
 608 sub valid_drivename {
 609     my $dev = shift;
 610
 611     return defined($drivename_hash->{$dev});
 612 }
 613
 614 sub option_exists {
 615     my $key = shift;
 616     return defined($confdesc->{$key});
 617 }
 618
 619 sub nic_models {
 620     return $nic_model_list;
 621 }
 622
 623 sub os_list_description {
 624
 625     return {
 626         other => 'Other',
 627         wxp => 'Windows XP',
 628         w2k => 'Windows 2000',
 629         w2k3 =>, 'Windows 2003',
 630         w2k8 => 'Windows 2008',
 631         wvista => 'Windows Vista',
 632         win7 => 'Windows 7',
 633         l24 => 'Linux 2.4',
 634         l26 => 'Linux 2.6',
 635     };
 636 }
 637
 638 sub disk_devive_info {
 639     my $dev = shift;
 640
 641     die "unknown disk device format '$dev'" if $dev !~ m/^(ide|scsi|virtio)(\d+)$/;
 642
 643     my $bus = $1;
 644     my $index = $2;
 645     my $maxdev = 1024;
 646
 647     if ($bus eq 'ide') {
 648         $maxdev = 2;
 649     } elsif ($bus eq 'scsi') {
 650         $maxdev = 7;
 651     }
 652
 653     my $controller = int($index / $maxdev);
 654     my $unit = $index % $maxdev;
 655
 656
 657     return { bus => $bus, desc => uc($bus) . " $controller:$unit",
 658              controller => $controller, unit => $unit, index => $index };
 659
 660 }
 661
 662 sub qemu_drive_name {
 663     my ($dev, $media) = @_;
 664
 665     my $info = disk_devive_info($dev);
 666     my $mediastr = '';
 667
 668     if (($info->{bus} eq 'ide') || ($info->{bus} eq 'scsi')) {
 669         $mediastr = ($media eq 'cdrom') ? "-cd" : "-hd";
 670         return sprintf("%s%i%s%i", $info->{bus}, $info->{controller},
 671                        $mediastr, $info->{unit});
 672     } else {
 673         return sprintf("%s%i", $info->{bus}, $info->{index});
 674     }
 675 }
 676
 677 my $cdrom_path;
 678
 679 sub get_cdrom_path {
 680
 681     return  $cdrom_path if $cdrom_path;
 682
 683     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 684     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 685     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 686 }
 687
 688 sub get_iso_path {
 689     my ($storecfg, $vmid, $cdrom) = @_;
 690
 691     if ($cdrom eq 'cdrom') {
 692         return get_cdrom_path();
 693     } elsif ($cdrom eq 'none') {
 694         return '';
 695     } elsif ($cdrom =~ m|^/|) {
 696         return $cdrom;
 697     } else {
 698         return PVE::Storage::path($storecfg, $cdrom);
 699     }
 700 }
 701
 702 # try to convert old style file names to volume IDs
 703 sub filename_to_volume_id {
 704     my ($vmid, $file, $media) = @_;
 705
 706     if (!($file eq 'none' || $file eq 'cdrom' ||
 707           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 708
 709         return undef if $file =~ m|/|;
 710
 711         if ($media && $media eq 'cdrom') {
 712             $file = "local:iso/$file";
 713         } else {
 714             $file = "local:$vmid/$file";
 715         }
 716     }
 717
 718     return $file;
 719 }
 720
 721 sub verify_media_type {
 722     my ($opt, $vtype, $media) = @_;
 723
 724     return if !$media;
 725
 726     my $etype;
 727     if ($media eq 'disk') {
 728         $etype = 'image';
 729     } elsif ($media eq 'cdrom') {
 730         $etype = 'iso';
 731     } else {
 732         die "internal error";
 733     }
 734
 735     return if ($vtype eq $etype);
 736
 737     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 738 }
 739
 740 sub cleanup_drive_path {
 741     my ($opt, $storecfg, $drive) = @_;
 742
 743     # try to convert filesystem paths to volume IDs
 744
 745     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 746         ($drive->{file} !~ m|^/dev/.+|) &&
 747         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 748         ($drive->{file} !~ m/^\d+$/)) {
 749         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 750         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 751         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 752         verify_media_type($opt, $vtype, $drive->{media});
 753         $drive->{file} = $volid;
 754     }
 755
 756     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 757 }
 758
 759 sub create_conf_nolock {
 760     my ($vmid, $settings) = @_;
 761
 762     my $filename = config_file($vmid);
 763
 764     die "configuration file '$filename' already exists\n" if -f $filename;
 765
 766     my $defaults = load_defaults();
 767
 768     $settings->{name} = "vm$vmid" if !$settings->{name};
 769     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 770
 771     my $data = '';
 772     foreach my $opt (keys %$settings) {
 773         next if !$confdesc->{$opt};
 774
 775         my $value = $settings->{$opt};
 776         next if !$value;
 777
 778         $data .= "$opt: $value\n";
 779     }
 780
 781     PVE::Tools::file_set_contents($filename, $data);
 782 }
 783
 784 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 785 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 786 #        [,aio=native|threads]
 787
 788 sub parse_drive {
 789     my ($key, $data) = @_;
 790
 791     my $res = {};
 792
 793     # $key may be undefined - used to verify JSON parameters
 794     if (!defined($key)) {
 795         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 796         $res->{index} = 0;
 797     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 798         $res->{interface} = $1;
 799         $res->{index} = $2;
 800     } else {
 801         return undef;
 802     }
 803
 804     foreach my $p (split (/,/, $data)) {
 805         next if $p =~ m/^\s*$/;
 806
 807         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio)=(.+)$/) {
 808             my ($k, $v) = ($1, $2);
 809
 810             $k = 'file' if $k eq 'volume';
 811
 812             return undef if defined $res->{$k};
 813
 814             $res->{$k} = $v;
 815         } else {
 816             if (!$res->{file} && $p !~ m/=/) {
 817                 $res->{file} = $p;
 818             } else {
 819                 return undef;
 820             }
 821         }
 822     }
 823
 824     return undef if !$res->{file};
 825
 826     return undef if $res->{cache} &&
 827         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe)$/;
 828     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 829     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 830     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 831     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 832     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 833     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
 834     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
 835     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
 836     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
 837     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 838     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
 839
 840     if ($res->{media} && ($res->{media} eq 'cdrom')) {
 841         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
 842         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
 843         return undef if $res->{interface} eq 'virtio';
 844     }
 845
 846     # rerror does not work with scsi drives
 847     if ($res->{rerror}) {
 848         return undef if $res->{interface} eq 'scsi';
 849     }
 850
 851     return $res;
 852 }
 853
 854 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio);
 855
 856 sub print_drive {
 857     my ($vmid, $drive) = @_;
 858
 859     my $opts = '';
 860     foreach my $o (@qemu_drive_options, 'backup') {
 861         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 862     }
 863
 864     return "$drive->{file}$opts";
 865 }
 866
 867 sub print_drivedevice_full {
 868     my ($storecfg, $vmid, $drive) = @_;
 869
 870     my $device = '';
 871     my $maxdev = 0;
 872
 873     if ($drive->{interface} eq 'virtio') {
 874         my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}");
 875         $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
 876     } elsif ($drive->{interface} eq 'scsi') {
 877         $maxdev = 7;
 878         my $controller = int($drive->{index} / $maxdev);
 879         my $unit = $drive->{index} % $maxdev;
 880         my $devicetype = 'hd';
 881         my $path = '';
 882         if (drive_is_cdrom($drive)) {
 883               $devicetype = 'cd';
 884           } else {
 885               if ($drive->{file} =~ m|^/|) {
 886                   $path = $drive->{file};
 887               } else {
 888                   $path = PVE::Storage::path($storecfg, $drive->{file});
 889               }
 890               if ($path =~ m|^/dev/| ) {
 891                   $devicetype = 'block';
 892               }
 893          }
 894
 895         $device = "scsi-$devicetype,bus=lsi$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
 896     } elsif ($drive->{interface} eq 'ide'){
 897         $maxdev = 2;
 898         my $controller = int($drive->{index} / $maxdev);
 899         my $unit = $drive->{index} % $maxdev;
 900         my $devicetype = ($drive->{media} && $drive->{media} eq 'cdrom') ? "cd" : "hd";
 901
 902         $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
 903     } elsif ($drive->{interface} eq 'usb') {
 904         die "implement me";
 905         #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
 906     } else {
 907         die "unsupported interface type";
 908     }
 909
 910     $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex};
 911
 912     return $device;
 913 }
 914
 915 sub print_drive_full {
 916     my ($storecfg, $vmid, $drive) = @_;
 917
 918     my $opts = '';
 919     foreach my $o (@qemu_drive_options) {
 920         next if $o eq 'bootindex';
 921         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 922     }
 923
 924     # use linux-aio by default (qemu default is threads)
 925     $opts .= ",aio=native" if !$drive->{aio};
 926
 927     my $path;
 928     my $volid = $drive->{file};
 929     if (drive_is_cdrom($drive)) {
 930         $path = get_iso_path($storecfg, $vmid, $volid);
 931     } else {
 932         if ($volid =~ m|^/|) {
 933             $path = $volid;
 934         } else {
 935             $path = PVE::Storage::path($storecfg, $volid);
 936         }
 937         if (!$drive->{cache} && ($path =~ m|^/dev/| || $path =~ m|\.raw$|)) {
 938             $opts .= ",cache=none";
 939         }
 940     }
 941
 942     my $pathinfo = $path ? "file=$path," : '';
 943
 944     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
 945 }
 946
 947
 948 sub drive_is_cdrom {
 949     my ($drive) = @_;
 950
 951     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
 952
 953 }
 954
 955 sub parse_hostpci {
 956     my ($value) = @_;
 957
 958     return undef if !$value;
 959
 960     my $res = {};
 961
 962     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
 963        $res->{pciid} = $value;
 964     } else {
 965        return undef;
 966     }
 967
 968     return $res;
 969 }
 970
 971 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
 972 sub parse_net {
 973     my ($data) = @_;
 974
 975     my $res = {};
 976
 977     foreach my $kvp (split(/,/, $data)) {
 978
 979         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
 980             my $model = lc($1);
 981             my $mac = uc($3) || PVE::Tools::random_ether_addr();
 982             $res->{model} = $model;
 983             $res->{macaddr} = $mac;
 984         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
 985             $res->{bridge} = $1;
 986         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
 987             $res->{rate} = $1;
 988         } else {
 989             return undef;
 990         }
 991
 992     }
 993
 994     return undef if !$res->{model};
 995
 996     return $res;
 997 }
 998
 999 sub print_net {
1000     my $net = shift;
1001
1002     my $res = "$net->{model}";
1003     $res .= "=$net->{macaddr}" if $net->{macaddr};
1004     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1005     $res .= ",rate=$net->{rate}" if $net->{rate};
1006
1007     return $res;
1008 }
1009
1010 sub add_random_macs {
1011     my ($settings) = @_;
1012
1013     foreach my $opt (keys %$settings) {
1014         next if $opt !~ m/^net(\d+)$/;
1015         my $net = parse_net($settings->{$opt});
1016         next if !$net;
1017         $settings->{$opt} = print_net($net);
1018     }
1019 }
1020
1021 sub add_unused_volume {
1022     my ($config, $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_deviceplug($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_deviceplug {
2286     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2287     return 1 if !check_running($vmid) || !$conf->{hotplug} || $conf->{$deviceid};
2288
2289     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2290         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2291         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2292         qemu_deviceadd($vmid, $devicefull);
2293         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2294            qemu_drivedel($vmid, $deviceid);
2295            return undef;
2296         }
2297     }
2298
2299     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2300         my $pciaddr = print_pci_addr($deviceid);
2301         my $devicefull = "lsi,id=$deviceid$pciaddr";
2302         qemu_deviceadd($vmid, $devicefull);
2303         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2304     }
2305
2306     return 1;
2307 }
2308
2309 sub vm_deviceunplug {
2310     my ($vmid, $conf, $deviceid) = @_;
2311
2312     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2313
2314     die "can't unplug bootdisk" if $conf->{bootdisk} eq $deviceid;
2315
2316     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2317         return undef if !qemu_drivedel($vmid, $deviceid);
2318         qemu_devicedel($vmid, $deviceid);
2319         return undef if !qemu_devicedelverify($vmid, $deviceid);
2320     }
2321
2322     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2323         return undef if !qemu_devicedel($vmid, $deviceid);
2324     }
2325
2326     return 1;
2327 }
2328
2329 sub qemu_deviceadd {
2330     my ($vmid, $devicefull) = @_;
2331
2332     my $ret = vm_monitor_command($vmid, "device_add $devicefull");
2333     $ret =~ s/^\s+//;
2334     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2335     return 1 if $ret eq "";
2336     syslog("err", "error on hotplug device : $ret");
2337     return undef;
2338
2339 }
2340
2341 sub qemu_devicedel {
2342     my($vmid, $deviceid) = @_;
2343
2344     my $ret = vm_monitor_command($vmid, "device_del $deviceid");
2345     $ret =~ s/^\s+//;
2346     return 1 if $ret eq "";
2347     syslog("err", "detaching device $deviceid failed : $ret");
2348     return undef;
2349 }
2350
2351 sub qemu_driveadd {
2352     my($storecfg, $vmid, $device) = @_;
2353
2354     my $drive = print_drive_full($storecfg, $vmid, $device);
2355     my $ret = vm_monitor_command($vmid, "drive_add auto $drive");
2356     # If the command succeeds qemu prints: "OK"
2357     if ($ret !~ m/OK/s) {
2358         syslog("err", "adding drive failed: $ret");
2359         return undef;
2360     }
2361     return 1;
2362 }
2363
2364 sub qemu_drivedel {
2365     my($vmid, $deviceid) = @_;
2366
2367     my $ret = vm_monitor_command($vmid, "drive_del drive-$deviceid");
2368     $ret =~ s/^\s+//;
2369     if ($ret =~ m/Device \'.*?\' not found/s) {
2370         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2371     }
2372     elsif ($ret ne "") {
2373       syslog("err", "deleting drive $deviceid failed : $ret");
2374       return undef;
2375     }
2376     return 1;
2377 }
2378
2379 sub qemu_deviceaddverify {
2380     my ($vmid,$deviceid) = @_;
2381
2382     for (my $i = 0; $i <= 5; $i++) {
2383          my $devices_list = vm_devices_list($vmid);
2384          return 1 if defined($devices_list->{$deviceid});
2385          sleep 1;
2386     }
2387     syslog("err", "error on hotplug device $deviceid");
2388     return undef;
2389 }
2390
2391
2392 sub qemu_devicedelverify {
2393     my ($vmid,$deviceid) = @_;
2394
2395     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2396     for (my $i = 0; $i <= 5; $i++) {
2397          my $devices_list = vm_devices_list($vmid);
2398          return 1 if !defined($devices_list->{$deviceid});
2399          sleep 1;
2400     }
2401     syslog("err", "error on hot-unplugging device $deviceid");
2402     return undef;
2403 }
2404
2405 sub qemu_findorcreatelsi {
2406     my ($storecfg, $conf, $vmid, $device) = @_;
2407
2408     my $maxdev = 7;
2409     my $controller = int($device->{index} / $maxdev);
2410     my $lsiid="lsi$controller";
2411     my $devices_list = vm_devices_list($vmid);
2412
2413     if(!defined($devices_list->{$lsiid})) {
2414        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $lsiid);
2415     }
2416     return 1;
2417 }
2418
2419 sub vm_start {
2420     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2421
2422     lock_config($vmid, sub {
2423         my $conf = load_config($vmid);
2424
2425         check_lock($conf) if !$skiplock;
2426
2427         die "VM $vmid already running\n" if check_running($vmid);
2428
2429         my $migrate_uri;
2430         my $migrate_port = 0;
2431
2432         if ($statefile) {
2433             if ($statefile eq 'tcp') {
2434                 $migrate_port = next_migrate_port();
2435                 $migrate_uri = "tcp:localhost:${migrate_port}";
2436             } else {
2437                 if (-f $statefile) {
2438                     $migrate_uri = "exec:cat $statefile";
2439                 } else {
2440                     warn "state file '$statefile' does not exist - doing normal startup\n";
2441                 }
2442             }
2443         }
2444
2445         my $defaults = load_defaults();
2446
2447         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2448         # host pci devices
2449         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2450           my $d = parse_hostpci($conf->{"hostpci$i"});
2451           next if !$d;
2452           my $info = pci_device_info("0000:$d->{pciid}");
2453           die "IOMMU not present\n" if !check_iommu_support();
2454           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2455           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2456           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2457         }
2458
2459         PVE::Storage::activate_volumes($storecfg, $vollist);
2460
2461         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2462         my $err = $@;
2463         die "start failed: $err" if $err;
2464
2465         if ($statefile) {
2466
2467             if ($statefile eq 'tcp') {
2468                 print "migration listens on port $migrate_port\n";
2469             } else {
2470                 unlink $statefile;
2471                 # fixme: send resume - is that necessary ?
2472                 eval { vm_monitor_command($vmid, "cont"); };
2473             }
2474         }
2475
2476         # always set migrate speed (overwrite kvm default of 32m)
2477         # we set a very hight default of 8192m which is basically unlimited
2478         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2479         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2480         eval {
2481             my $cmd = "migrate_set_speed ${migrate_speed}m";
2482             vm_monitor_command($vmid, $cmd);
2483         };
2484
2485         if (my $migrate_downtime =
2486             $conf->{migrate_downtime} || $defaults->{migrate_downtime}) {
2487             my $cmd = "migrate_set_downtime ${migrate_downtime}";
2488             eval { vm_monitor_command($vmid, $cmd); };
2489         }
2490
2491         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2492     });
2493 }
2494
2495 sub __read_avail {
2496     my ($fh, $timeout) = @_;
2497
2498     my $sel = new IO::Select;
2499     $sel->add($fh);
2500
2501     my $res = '';
2502     my $buf;
2503
2504     my @ready;
2505     while (scalar (@ready = $sel->can_read($timeout))) {
2506         my $count;
2507         if ($count = $fh->sysread($buf, 8192)) {
2508             if ($buf =~ /^(.*)\(qemu\) $/s) {
2509                 $res .= $1;
2510                 last;
2511             } else {
2512                 $res .= $buf;
2513             }
2514         } else {
2515             if (!defined($count)) {
2516                 die "$!\n";
2517             }
2518             last;
2519         }
2520     }
2521
2522     die "monitor read timeout\n" if !scalar(@ready);
2523
2524     return $res;
2525 }
2526
2527 sub vm_monitor_command {
2528     my ($vmid, $cmdstr, $nocheck) = @_;
2529
2530     my $res;
2531
2532     eval {
2533         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2534
2535         my $sname = monitor_socket($vmid);
2536
2537         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2538             die "unable to connect to VM $vmid socket - $!\n";
2539
2540         my $timeout = 3;
2541
2542         # hack: migrate sometime blocks the monitor (when migrate_downtime
2543         # is set)
2544         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2545             $timeout = 60*60; # 1 hour
2546         }
2547
2548         # read banner;
2549         my $data = __read_avail($sock, $timeout);
2550
2551         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2552             die "got unexpected qemu monitor banner\n";
2553         }
2554
2555         my $sel = new IO::Select;
2556         $sel->add($sock);
2557
2558         if (!scalar(my @ready = $sel->can_write($timeout))) {
2559             die "monitor write error - timeout";
2560         }
2561
2562         my $fullcmd = "$cmdstr\r";
2563
2564         my $b;
2565         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2566             die "monitor write error - $!";
2567         }
2568
2569         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2570
2571         $timeout = 20;
2572
2573         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2574             $timeout = 60*60; # 1 hour
2575         } elsif ($cmdstr =~ m/^(eject|change)/) {
2576             $timeout = 60; # note: cdrom mount command is slow
2577         }
2578         if ($res = __read_avail($sock, $timeout)) {
2579
2580             my @lines = split("\r?\n", $res);
2581
2582             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2583
2584             $res = join("\n", @lines);
2585             $res .= "\n";
2586         }
2587     };
2588
2589     my $err = $@;
2590
2591     if ($err) {
2592         syslog("err", "VM $vmid monitor command failed - $err");
2593         die $err;
2594     }
2595
2596     return $res;
2597 }
2598
2599 sub vm_commandline {
2600     my ($storecfg, $vmid) = @_;
2601
2602     my $conf = load_config($vmid);
2603
2604     my $defaults = load_defaults();
2605
2606     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2607
2608     return join(' ', @$cmd);
2609 }
2610
2611 sub vm_reset {
2612     my ($vmid, $skiplock) = @_;
2613
2614     lock_config($vmid, sub {
2615
2616         my $conf = load_config($vmid);
2617
2618         check_lock($conf) if !$skiplock;
2619
2620         vm_monitor_command($vmid, "system_reset");
2621     });
2622 }
2623
2624 sub get_vm_volumes {
2625     my ($conf) = @_;
2626
2627     my $vollist = [];
2628     foreach_drive($conf, sub {
2629         my ($ds, $drive) = @_;
2630
2631         my ($sid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
2632         return if !$sid;
2633
2634         my $volid = $drive->{file};
2635         return if !$volid || $volid =~ m|^/|;
2636
2637         push @$vollist, $volid;
2638     });
2639
2640     return $vollist;
2641 }
2642
2643 sub vm_stop_cleanup {
2644     my ($storecfg, $vmid, $conf, $keepActive) = @_;
2645
2646     eval {
2647         fairsched_rmnod($vmid); # try to destroy group
2648
2649         if (!$keepActive) {
2650             my $vollist = get_vm_volumes($conf);
2651             PVE::Storage::deactivate_volumes($storecfg, $vollist);
2652         }
2653     };
2654     warn $@ if $@; # avoid errors - just warn
2655 }
2656
2657 # Note: use $nockeck to skip tests if VM configuration file exists.
2658 # We need that when migration VMs to other nodes (files already moved)
2659 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
2660 sub vm_stop {
2661     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
2662
2663     $timeout = 60 if !defined($timeout);
2664
2665     $force = 1 if !defined($force) && !$shutdown;
2666
2667     lock_config($vmid, sub {
2668
2669         my $pid = check_running($vmid, $nocheck);
2670         return if !$pid;
2671
2672         my $conf;
2673         if (!$nocheck) {
2674             $conf = load_config($vmid);
2675             check_lock($conf) if !$skiplock;
2676         }
2677
2678         eval {
2679             if ($shutdown) {
2680                 vm_monitor_command($vmid, "system_powerdown", $nocheck);
2681             } else {
2682                 vm_monitor_command($vmid, "quit", $nocheck);
2683             }
2684         };
2685         my $err = $@;
2686
2687         if (!$err) {
2688             my $count = 0;
2689             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2690                 $count++;
2691                 sleep 1;
2692             }
2693
2694             if ($count >= $timeout) {
2695                 if ($force) {
2696                     warn "VM still running - terminating now with SIGTERM\n";
2697                     kill 15, $pid;
2698                 } else {
2699                     die "VM quit/powerdown failed - got timeout\n";
2700                 }
2701             } else {
2702                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2703                 return;
2704             }
2705         } else {
2706             if ($force) {
2707                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
2708                 kill 15, $pid;
2709             } else {
2710                 die "VM quit/powerdown failed\n";
2711             }
2712         }
2713
2714         # wait again
2715         $timeout = 10;
2716
2717         my $count = 0;
2718         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2719             $count++;
2720             sleep 1;
2721         }
2722
2723         if ($count >= $timeout) {
2724             warn "VM still running - terminating now with SIGKILL\n";
2725             kill 9, $pid;
2726             sleep 1;
2727         }
2728
2729         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2730    });
2731 }
2732
2733 sub vm_suspend {
2734     my ($vmid, $skiplock) = @_;
2735
2736     lock_config($vmid, sub {
2737
2738         my $conf = load_config($vmid);
2739
2740         check_lock($conf) if !$skiplock;
2741
2742         vm_monitor_command($vmid, "stop");
2743     });
2744 }
2745
2746 sub vm_resume {
2747     my ($vmid, $skiplock) = @_;
2748
2749     lock_config($vmid, sub {
2750
2751         my $conf = load_config($vmid);
2752
2753         check_lock($conf) if !$skiplock;
2754
2755         vm_monitor_command($vmid, "cont");
2756     });
2757 }
2758
2759 sub vm_sendkey {
2760     my ($vmid, $skiplock, $key) = @_;
2761
2762     lock_config($vmid, sub {
2763
2764         my $conf = load_config($vmid);
2765
2766         vm_monitor_command($vmid, "sendkey $key");
2767     });
2768 }
2769
2770 sub vm_destroy {
2771     my ($storecfg, $vmid, $skiplock) = @_;
2772
2773     lock_config($vmid, sub {
2774
2775         my $conf = load_config($vmid);
2776
2777         check_lock($conf) if !$skiplock;
2778
2779         if (!check_running($vmid)) {
2780             fairsched_rmnod($vmid); # try to destroy group
2781             destroy_vm($storecfg, $vmid);
2782         } else {
2783             die "VM $vmid is running - destroy failed\n";
2784         }
2785     });
2786 }
2787
2788 sub vm_stopall {
2789     my ($storecfg, $timeout) = @_;
2790
2791     $timeout = 3*60 if !$timeout;
2792
2793     my $cleanuphash = {};
2794
2795     my $vzlist = vzlist();
2796     my $count = 0;
2797     foreach my $vmid (keys %$vzlist) {
2798         next if !$vzlist->{$vmid}->{pid};
2799         $count++;
2800         $cleanuphash->{$vmid} = 1;
2801     }
2802
2803     return if !$count;
2804
2805     my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs\n";
2806     syslog('info', $msg);
2807     warn $msg;
2808
2809     foreach my $vmid (keys %$vzlist) {
2810         next if !$vzlist->{$vmid}->{pid};
2811         eval { vm_monitor_command($vmid, "system_powerdown"); };
2812         warn $@ if $@;
2813     }
2814
2815     my $wt = 5;
2816     my $maxtries = int(($timeout + $wt -1)/$wt);
2817     my $try = 0;
2818     while (($try < $maxtries) && $count) {
2819         $try++;
2820         sleep $wt;
2821
2822         $vzlist = vzlist();
2823         $count = 0;
2824         foreach my $vmid (keys %$vzlist) {
2825             next if !$vzlist->{$vmid}->{pid};
2826             $count++;
2827         }
2828         last if !$count;
2829     }
2830
2831     if ($count) {
2832
2833         foreach my $vmid (keys %$vzlist) {
2834             next if !$vzlist->{$vmid}->{pid};
2835
2836             warn "VM $vmid still running - sending stop now\n";
2837             eval { vm_monitor_command($vmid, "quit"); };
2838             warn $@ if $@;
2839         }
2840
2841         $timeout = 30;
2842         $maxtries = int(($timeout + $wt -1)/$wt);
2843         $try = 0;
2844         while (($try < $maxtries) && $count) {
2845             $try++;
2846             sleep $wt;
2847
2848             $vzlist = vzlist();
2849             $count = 0;
2850             foreach my $vmid (keys %$vzlist) {
2851                 next if !$vzlist->{$vmid}->{pid};
2852                 $count++;
2853             }
2854             last if !$count;
2855         }
2856
2857         if ($count) {
2858
2859             foreach my $vmid (keys %$vzlist) {
2860                 next if !$vzlist->{$vmid}->{pid};
2861
2862                 warn "VM $vmid still running - terminating now with SIGTERM\n";
2863                 kill 15, $vzlist->{$vmid}->{pid};
2864             }
2865             sleep 1;
2866         }
2867
2868         # this is called by system shotdown scripts, so remaining
2869         # processes gets killed anyways (no need to send kill -9 here)
2870     }
2871
2872     $vzlist = vzlist();
2873     foreach my $vmid (keys %$cleanuphash) {
2874         next if $vzlist->{$vmid}->{pid};
2875         eval {
2876             my $conf = load_config($vmid);
2877             vm_stop_cleanup($storecfg, $vmid, $conf);
2878         };
2879         warn $@ if $@;
2880     }
2881
2882     $msg = "Qemu Server stopped\n";
2883     syslog('info', $msg);
2884     print $msg;
2885 }
2886
2887 # pci helpers
2888
2889 sub file_write {
2890     my ($filename, $buf) = @_;
2891
2892     my $fh = IO::File->new($filename, "w");
2893     return undef if !$fh;
2894
2895     my $res = print $fh $buf;
2896
2897     $fh->close();
2898
2899     return $res;
2900 }
2901
2902 sub pci_device_info {
2903     my ($name) = @_;
2904
2905     my $res;
2906
2907     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
2908     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
2909
2910     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
2911     return undef if !defined($irq) || $irq !~ m/^\d+$/;
2912
2913     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
2914     return undef if !defined($vendor) || $vendor !~ s/^0x//;
2915
2916     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
2917     return undef if !defined($product) || $product !~ s/^0x//;
2918
2919     $res = {
2920         name => $name,
2921         vendor => $vendor,
2922         product => $product,
2923         domain => $domain,
2924         bus => $bus,
2925         slot => $slot,
2926         func => $func,
2927         irq => $irq,
2928         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
2929     };
2930
2931     return $res;
2932 }
2933
2934 sub pci_dev_reset {
2935     my ($dev) = @_;
2936
2937     my $name = $dev->{name};
2938
2939     my $fn = "$pcisysfs/devices/$name/reset";
2940
2941     return file_write($fn, "1");
2942 }
2943
2944 sub pci_dev_bind_to_stub {
2945     my ($dev) = @_;
2946
2947     my $name = $dev->{name};
2948
2949     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
2950     return 1 if -d $testdir;
2951
2952     my $data = "$dev->{vendor} $dev->{product}";
2953     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
2954
2955     my $fn = "$pcisysfs/devices/$name/driver/unbind";
2956     if (!file_write($fn, $name)) {
2957         return undef if -f $fn;
2958     }
2959
2960     $fn = "$pcisysfs/drivers/pci-stub/bind";
2961     if (! -d $testdir) {
2962         return undef if !file_write($fn, $name);
2963     }
2964
2965     return -d $testdir;
2966 }
2967
2968 sub print_pci_addr {
2969     my ($id) = @_;
2970
2971     my $res = '';
2972     my $devices = {
2973         #addr1 : ide,parallel,serial (motherboard)
2974         #addr2 : first videocard
2975         balloon0 => { bus => 0, addr => 3 },
2976         watchdog => { bus => 0, addr => 4 },
2977         lsi0 => { bus => 0, addr => 5 },
2978         lsi1 => { bus => 0, addr => 6 },
2979         virtio0 => { bus => 0, addr => 10 },
2980         virtio1 => { bus => 0, addr => 11 },
2981         virtio2 => { bus => 0, addr => 12 },
2982         virtio3 => { bus => 0, addr => 13 },
2983         virtio4 => { bus => 0, addr => 14 },
2984         virtio5 => { bus => 0, addr => 15 },
2985         hostpci0 => { bus => 0, addr => 16 },
2986         hostpci1 => { bus => 0, addr => 17 },
2987         net0 => { bus => 0, addr => 18 },
2988         net1 => { bus => 0, addr => 19 },
2989         net2 => { bus => 0, addr => 20 },
2990         net3 => { bus => 0, addr => 21 },
2991         net4 => { bus => 0, addr => 22 },
2992         net5 => { bus => 0, addr => 23 },
2993         #addr29 : usb-host (pve-usb.cfg)
2994     };
2995
2996     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
2997            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
2998            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
2999     }
3000     return $res;
3001
3002 }
3003
3004 sub vm_balloonset {
3005     my ($vmid, $value) = @_;
3006
3007     vm_monitor_command($vmid, "balloon $value");
3008 }
3009
3010 # vzdump restore implementaion
3011
3012 sub archive_read_firstfile {
3013     my $archive = shift;
3014
3015     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3016
3017     # try to detect archive type first
3018     my $pid = open (TMP, "tar tf '$archive'|") ||
3019         die "unable to open file '$archive'\n";
3020     my $firstfile = <TMP>;
3021     kill 15, $pid;
3022     close TMP;
3023
3024     die "ERROR: archive contaions no data\n" if !$firstfile;
3025     chomp $firstfile;
3026
3027     return $firstfile;
3028 }
3029
3030 sub restore_cleanup {
3031     my $statfile = shift;
3032
3033     print STDERR "starting cleanup\n";
3034
3035     if (my $fd = IO::File->new($statfile, "r")) {
3036         while (defined(my $line = <$fd>)) {
3037             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3038                 my $volid = $2;
3039                 eval {
3040                     if ($volid =~ m|^/|) {
3041                         unlink $volid || die 'unlink failed\n';
3042                     } else {
3043                         my $cfg = cfs_read_file('storage.cfg');
3044                         PVE::Storage::vdisk_free($cfg, $volid);
3045                     }
3046                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3047                 };
3048                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3049             } else {
3050                 print STDERR "unable to parse line in statfile - $line";
3051             }
3052         }
3053         $fd->close();
3054     }
3055 }
3056
3057 sub restore_archive {
3058     my ($archive, $vmid, $opts) = @_;
3059
3060     if ($archive ne '-') {
3061         my $firstfile = archive_read_firstfile($archive);
3062         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3063             if $firstfile ne 'qemu-server.conf';
3064     }
3065
3066     my $tocmd = "/usr/lib/qemu-server/qmextract";
3067
3068     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3069     $tocmd .= ' --prealloc' if $opts->{prealloc};
3070     $tocmd .= ' --info' if $opts->{info};
3071
3072     # tar option "xf" does not autodetect compression when read fron STDIN,
3073     # so we pipe to zcat
3074     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3075         PVE::Tools::shellquote("--to-command=$tocmd");
3076
3077     my $tmpdir = "/var/tmp/vzdumptmp$$";
3078     mkpath $tmpdir;
3079
3080     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3081     local $ENV{VZDUMP_VMID} = $vmid;
3082
3083     my $conffile = PVE::QemuServer::config_file($vmid);
3084     my $tmpfn = "$conffile.$$.tmp";
3085
3086     # disable interrupts (always do cleanups)
3087     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3088         print STDERR "got interrupt - ignored\n";
3089     };
3090
3091     eval {
3092         # enable interrupts
3093         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3094             die "interrupted by signal\n";
3095         };
3096
3097         if ($archive eq '-') {
3098             print "extracting archive from STDIN\n";
3099             run_command($cmd, input => "<&STDIN");
3100         } else {
3101             print "extracting archive '$archive'\n";
3102             run_command($cmd);
3103         }
3104
3105         return if $opts->{info};
3106
3107         # read new mapping
3108         my $map = {};
3109         my $statfile = "$tmpdir/qmrestore.stat";
3110         if (my $fd = IO::File->new($statfile, "r")) {
3111             while (defined (my $line = <$fd>)) {
3112                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3113                     $map->{$1} = $2 if $1;
3114                 } else {
3115                     print STDERR "unable to parse line in statfile - $line\n";
3116                 }
3117             }
3118             $fd->close();
3119         }
3120
3121         my $confsrc = "$tmpdir/qemu-server.conf";
3122
3123         my $srcfd = new IO::File($confsrc, "r") ||
3124             die "unable to open file '$confsrc'\n";
3125
3126         my $outfd = new IO::File ($tmpfn, "w") ||
3127             die "unable to write config for VM $vmid\n";
3128
3129         my $netcount = 0;
3130
3131         while (defined (my $line = <$srcfd>)) {
3132             next if $line =~ m/^\#vzdump\#/;
3133             next if $line =~ m/^lock:/;
3134             next if $line =~ m/^unused\d+:/;
3135
3136             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3137                 # try to convert old 1.X settings
3138                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3139                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3140                     my ($model, $macaddr) = split(/\=/, $devconfig);
3141                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3142                     my $net = {
3143                         model => $model,
3144                         bridge => "vmbr$ind",
3145                         macaddr => $macaddr,
3146                     };
3147                     my $netstr = print_net($net);
3148                     print $outfd "net${netcount}: $netstr\n";
3149                     $netcount++;
3150                 }
3151             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3152                 my ($id, $netstr) = ($1, $2);
3153                 my $net = parse_net($netstr);
3154                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3155                 $netstr = print_net($net);
3156                 print $outfd "$id: $netstr\n";
3157             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3158                 my $virtdev = $1;
3159                 my $value = $2;
3160                 if ($line =~ m/backup=no/) {
3161                     print $outfd "#$line";
3162                 } elsif ($virtdev && $map->{$virtdev}) {
3163                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3164                     $di->{file} = $map->{$virtdev};
3165                     $value = PVE::QemuServer::print_drive($vmid, $di);
3166                     print $outfd "$virtdev: $value\n";
3167                 } else {
3168                     print $outfd $line;
3169                 }
3170             } else {
3171                 print $outfd $line;
3172             }
3173         }
3174
3175         $srcfd->close();
3176         $outfd->close();
3177     };
3178     my $err = $@;
3179
3180     if ($err) {
3181
3182         unlink $tmpfn;
3183
3184         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3185
3186         die $err;
3187     }
3188
3189     rmtree $tmpdir;
3190
3191     rename $tmpfn, $conffile ||
3192         die "unable to commit configuration file '$conffile'\n";
3193 };
3194
3195 1;