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