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] [,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] [,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] [,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)$/;
 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     }
 879
 880     elsif ($drive->{interface} eq 'scsi') {
 881
 882       $maxdev = 7;
 883       my $controller = int($drive->{index} / $maxdev);
 884       my $unit = $drive->{index} % $maxdev;
 885
 886       $device = "scsi-disk,bus=scsi$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=device-$drive->{interface}$drive->{index}";
 887     }
 888
 889     elsif ($drive->{interface} eq 'ide'){
 890
 891       $maxdev = 2;
 892       my $controller = int($drive->{index} / $maxdev);
 893       my $unit = $drive->{index} % $maxdev;
 894
 895       $device = "ide-drive,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=device-$drive->{interface}$drive->{index}";
 896     }
 897
 898     if ($drive->{interface} eq 'usb'){
 899       #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
 900     }
 901
 902     return $device;
 903 }
 904
 905 sub print_drive_full {
 906     my ($storecfg, $vmid, $drive) = @_;
 907
 908     my $opts = '';
 909     foreach my $o (@qemu_drive_options) {
 910         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 911     }
 912
 913     # use linux-aio by default (qemu default is threads)
 914     $opts .= ",aio=native" if !$drive->{aio};
 915
 916     my $path;
 917     my $volid = $drive->{file};
 918     if (drive_is_cdrom($drive)) {
 919         $path = get_iso_path($storecfg, $vmid, $volid);
 920     } else {
 921         if ($volid =~ m|^/|) {
 922             $path = $volid;
 923         } else {
 924             $path = PVE::Storage::path($storecfg, $volid);
 925         }
 926     }
 927
 928     my $pathinfo = $path ? "file=$path," : '';
 929
 930     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
 931 }
 932
 933
 934 sub drive_is_cdrom {
 935     my ($drive) = @_;
 936
 937     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
 938
 939 }
 940
 941 sub parse_hostpci {
 942     my ($value) = @_;
 943
 944     return undef if !$value;
 945
 946     my $res = {};
 947
 948     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
 949        $res->{pciid} = $value;
 950     } else {
 951        return undef;
 952     }
 953
 954     return $res;
 955 }
 956
 957 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
 958 sub parse_net {
 959     my ($data) = @_;
 960
 961     my $res = {};
 962
 963     foreach my $kvp (split(/,/, $data)) {
 964
 965         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
 966             my $model = lc($1);
 967             my $mac = uc($3) || PVE::Tools::random_ether_addr();
 968             $res->{model} = $model;
 969             $res->{macaddr} = $mac;
 970         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
 971             $res->{bridge} = $1;
 972         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
 973             $res->{rate} = $1;
 974         } else {
 975             return undef;
 976         }
 977
 978     }
 979
 980     return undef if !$res->{model};
 981
 982     return $res;
 983 }
 984
 985 sub print_net {
 986     my $net = shift;
 987
 988     my $res = "$net->{model}";
 989     $res .= "=$net->{macaddr}" if $net->{macaddr};
 990     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
 991     $res .= ",rate=$net->{rate}" if $net->{rate};
 992
 993     return $res;
 994 }
 995
 996 sub add_random_macs {
 997     my ($settings) = @_;
 998
 999     foreach my $opt (keys %$settings) {
1000         next if $opt !~ m/^net(\d+)$/;
1001         my $net = parse_net($settings->{$opt});
1002         next if !$net;
1003         $settings->{$opt} = print_net($net);
1004     }
1005 }
1006
1007 sub add_unused_volume {
1008     my ($config, $res, $volid) = @_;
1009
1010     my $key;
1011     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1012         my $test = "unused$ind";
1013         if (my $vid = $config->{$test}) {
1014             return if $vid eq $volid; # do not add duplicates
1015         } else {
1016             $key = $test;
1017         }
1018     }
1019
1020     die "To many unused volume - please delete them first.\n" if !$key;
1021
1022     $res->{$key} = $volid;
1023 }
1024
1025 # fixme: remove all thos $noerr parameters?
1026
1027 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1028 sub verify_bootdisk {
1029     my ($value, $noerr) = @_;
1030
1031     return $value if valid_drivename($value);
1032
1033     return undef if $noerr;
1034
1035     die "invalid boot disk '$value'\n";
1036 }
1037
1038 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1039 sub verify_net {
1040     my ($value, $noerr) = @_;
1041
1042     return $value if parse_net($value);
1043
1044     return undef if $noerr;
1045
1046     die "unable to parse network options\n";
1047 }
1048
1049 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1050 sub verify_drive {
1051     my ($value, $noerr) = @_;
1052
1053     return $value if parse_drive(undef, $value);
1054
1055     return undef if $noerr;
1056
1057     die "unable to parse drive options\n";
1058 }
1059
1060 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1061 sub verify_hostpci {
1062     my ($value, $noerr) = @_;
1063
1064     return $value if parse_hostpci($value);
1065
1066     return undef if $noerr;
1067
1068     die "unable to parse pci id\n";
1069 }
1070
1071 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1072 sub verify_watchdog {
1073     my ($value, $noerr) = @_;
1074
1075     return $value if parse_watchdog($value);
1076
1077     return undef if $noerr;
1078
1079     die "unable to parse watchdog options\n";
1080 }
1081
1082 sub parse_watchdog {
1083     my ($value) = @_;
1084
1085     return undef if !$value;
1086
1087     my $res = {};
1088
1089     foreach my $p (split(/,/, $value)) {
1090         next if $p =~ m/^\s*$/;
1091
1092         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1093             $res->{model} = $2;
1094         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1095             $res->{action} = $2;
1096         } else {
1097             return undef;
1098         }
1099     }
1100
1101     return $res;
1102 }
1103
1104 sub parse_usb_device {
1105     my ($value) = @_;
1106
1107     return undef if !$value;
1108
1109     my @dl = split(/,/, $value);
1110     my $found;
1111
1112     my $res = {};
1113     foreach my $v (@dl) {
1114         if ($v =~ m/^host=([0-9A-Fa-f]{4}):([0-9A-Fa-f]{4})$/) {
1115             $found = 1;
1116             $res->{vendorid} = $1;
1117             $res->{productid} = $2;
1118         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1119             $found = 1;
1120             $res->{hostbus} = $1;
1121             $res->{hostport} = $2;
1122         } else {
1123             return undef;
1124         }
1125     }
1126     return undef if !$found;
1127
1128     return $res;
1129 }
1130
1131 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1132 sub verify_usb_device {
1133     my ($value, $noerr) = @_;
1134
1135     return $value if parse_usb_device($value);
1136
1137     return undef if $noerr;
1138
1139     die "unable to parse usb device\n";
1140 }
1141
1142 # add JSON properties for create and set function
1143 sub json_config_properties {
1144     my $prop = shift;
1145
1146     foreach my $opt (keys %$confdesc) {
1147         $prop->{$opt} = $confdesc->{$opt};
1148     }
1149
1150     return $prop;
1151 }
1152
1153 sub check_type {
1154     my ($key, $value) = @_;
1155
1156     die "unknown setting '$key'\n" if !$confdesc->{$key};
1157
1158     my $type = $confdesc->{$key}->{type};
1159
1160     if (!defined($value)) {
1161         die "got undefined value\n";
1162     }
1163
1164     if ($value =~ m/[\n\r]/) {
1165         die "property contains a line feed\n";
1166     }
1167
1168     if ($type eq 'boolean') {
1169         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1170         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1171         die "type check ('boolean') failed - got '$value'\n";
1172     } elsif ($type eq 'integer') {
1173         return int($1) if $value =~ m/^(\d+)$/;
1174         die "type check ('integer') failed - got '$value'\n";
1175     } elsif ($type eq 'string') {
1176         if (my $fmt = $confdesc->{$key}->{format}) {
1177             if ($fmt eq 'pve-qm-drive') {
1178                 # special case - we need to pass $key to parse_drive()
1179                 my $drive = parse_drive($key, $value);
1180                 return $value if $drive;
1181                 die "unable to parse drive options\n";
1182             }
1183             PVE::JSONSchema::check_format($fmt, $value);
1184             return $value;
1185         }
1186         $value =~ s/^\"(.*)\"$/$1/;
1187         return $value;
1188     } else {
1189         die "internal error"
1190     }
1191 }
1192
1193 sub lock_config {
1194     my ($vmid, $code, @param) = @_;
1195
1196     my $filename = config_file_lock($vmid);
1197
1198     my $res = lock_file($filename, 10, $code, @param);
1199
1200     die $@ if $@;
1201
1202     return $res;
1203 }
1204
1205 sub cfs_config_path {
1206     my ($vmid, $node) = @_;
1207
1208     $node = $nodename if !$node;
1209     return "nodes/$node/qemu-server/$vmid.conf";
1210 }
1211
1212 sub check_iommu_support{
1213     #fixme : need to check IOMMU support
1214     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1215
1216     my $iommu=1;
1217     return $iommu;
1218
1219 }
1220
1221 sub config_file {
1222     my ($vmid, $node) = @_;
1223
1224     my $cfspath = cfs_config_path($vmid, $node);
1225     return "/etc/pve/$cfspath";
1226 }
1227
1228 sub config_file_lock {
1229     my ($vmid) = @_;
1230
1231     return "$lock_dir/lock-$vmid.conf";
1232 }
1233
1234 sub touch_config {
1235     my ($vmid) = @_;
1236
1237     my $conf = config_file($vmid);
1238     utime undef, undef, $conf;
1239 }
1240
1241 sub create_disks {
1242     my ($storecfg, $vmid, $settings, $conf, $default_storage) = @_;
1243
1244     my $vollist = [];
1245
1246     eval {
1247         foreach_drive($settings, sub {
1248             my ($ds, $disk) = @_;
1249
1250             return if drive_is_cdrom($disk);
1251
1252             my $file = $disk->{file};
1253
1254             if ($file =~ m/^(([^:\s]+):)?(\d+(\.\d+)?)$/) {
1255                 my $storeid = $2 || $default_storage;
1256                 my $size = $3;
1257                 my $defformat = PVE::Storage::storage_default_format($storecfg, $storeid);
1258                 my $fmt = $disk->{format} || $defformat;
1259                 syslog('info', "VM $vmid creating new disk - size is $size GB");
1260
1261                 my $volid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $vmid,
1262                                                        $fmt, undef, $size*1024*1024);
1263
1264                 $disk->{file} = $volid;
1265                 delete $disk->{format}; # no longer needed
1266                 push @$vollist, $volid;
1267                 $settings->{$ds} = PVE::QemuServer::print_drive($vmid, $disk);
1268             } else {
1269                 my $path;
1270                 if ($disk->{file} =~ m|^/dev/.+|) {
1271                     $path = $disk->{file};
1272                 } else {
1273                     $path = PVE::Storage::path($storecfg, $disk->{file});
1274                 }
1275                 if (!(-f $path || -b $path)) {
1276                     die "image '$path' does not exists\n";
1277                 }
1278             }
1279             PVE::QemuServer::vm_deviceadd($storecfg, $conf, $vmid, $ds, $disk) if defined($conf);
1280         });
1281     };
1282
1283     my $err = $@;
1284
1285     if ($err) {
1286         syslog('err', "VM $vmid creating disks failed");
1287         foreach my $volid (@$vollist) {
1288             eval { PVE::Storage::vdisk_free($storecfg, $volid); };
1289             warn $@ if $@;
1290         }
1291         die $err;
1292     }
1293
1294     return $vollist;
1295 }
1296
1297 sub unlink_image {
1298     my ($storecfg, $vmid, $volid) = @_;
1299
1300     die "reject to unlink absolute path '$volid'"
1301         if $volid =~ m|^/|;
1302
1303     my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1304
1305     die "reject to unlink '$volid' - not owned by this VM"
1306         if !$owner || ($owner != $vmid);
1307
1308     syslog('info', "VM $vmid deleting volume '$volid'");
1309
1310     PVE::Storage::vdisk_free($storecfg, $volid);
1311
1312     touch_config($vmid);
1313 }
1314
1315 sub destroy_vm {
1316     my ($storecfg, $vmid, $keep_empty_config) = @_;
1317
1318     my $conffile = config_file($vmid);
1319
1320     my $conf = load_config($vmid);
1321
1322     check_lock($conf);
1323
1324     # only remove disks owned by this VM
1325     foreach_drive($conf, sub {
1326         my ($ds, $drive) = @_;
1327
1328         return if drive_is_cdrom($drive);
1329
1330         my $volid = $drive->{file};
1331         next if !$volid || $volid =~ m|^/|;
1332
1333         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1334         next if !$path || !$owner || ($owner != $vmid);
1335
1336         PVE::Storage::vdisk_free($storecfg, $volid);
1337     });
1338
1339     if ($keep_empty_config) {
1340         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1341     } else {
1342         unlink $conffile;
1343     }
1344
1345     # also remove unused disk
1346     eval {
1347         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1348
1349         eval {
1350             PVE::Storage::foreach_volid($dl, sub {
1351                 my ($volid, $sid, $volname, $d) = @_;
1352                 PVE::Storage::vdisk_free($storecfg, $volid);
1353             });
1354         };
1355         warn $@ if $@;
1356
1357     };
1358     warn $@ if $@;
1359 }
1360
1361 # fixme: remove?
1362 sub load_diskinfo_old {
1363     my ($storecfg, $vmid, $conf) = @_;
1364
1365     my $info = {};
1366     my $res = {};
1367     my $vollist;
1368
1369     foreach_drive($conf, sub {
1370         my ($ds, $di) = @_;
1371
1372         $res->{$ds} = $di;
1373
1374         return if drive_is_cdrom($di);
1375
1376         if ($di->{file} =~ m|^/dev/.+|) {
1377             $info->{$di->{file}}->{size} = PVE::Storage::file_size_info($di->{file});
1378         } else {
1379             push @$vollist, $di->{file};
1380         }
1381     });
1382
1383     eval {
1384         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid, $vollist);
1385
1386         PVE::Storage::foreach_volid($dl, sub {
1387             my ($volid, $sid, $volname, $d) = @_;
1388             $info->{$volid} = $d;
1389         });
1390     };
1391     warn $@ if $@;
1392
1393     foreach my $ds (keys %$res) {
1394         my $di = $res->{$ds};
1395
1396         $res->{$ds}->{disksize} = $info->{$di->{file}} ?
1397             $info->{$di->{file}}->{size} / (1024*1024) : 0;
1398     }
1399
1400     return $res;
1401 }
1402
1403 sub load_config {
1404     my ($vmid) = @_;
1405
1406     my $cfspath = cfs_config_path($vmid);
1407
1408     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1409
1410     die "no such VM ('$vmid')\n" if !defined($conf);
1411
1412     return $conf;
1413 }
1414
1415 sub parse_vm_config {
1416     my ($filename, $raw) = @_;
1417
1418     return undef if !defined($raw);
1419
1420     my $res = {
1421         digest => Digest::SHA1::sha1_hex($raw),
1422     };
1423
1424     $filename =~ m|/qemu-server/(\d+)\.conf$|
1425         || die "got strange filename '$filename'";
1426
1427     my $vmid = $1;
1428
1429     while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
1430         my $line = $1;
1431
1432         next if $line =~ m/^\#/;
1433
1434         next if $line =~ m/^\s*$/;
1435
1436         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1437             my $key = $1;
1438             my $value = PVE::Tools::decode_text($2);
1439             $res->{$key} = $value;
1440         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1441             my $key = $1;
1442             my $value = $2;
1443             $res->{$key} = $value;
1444         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1445             my $key = $1;
1446             my $value = $2;
1447             eval { $value = check_type($key, $value); };
1448             if ($@) {
1449                 warn "vm $vmid - unable to parse value of '$key' - $@";
1450             } else {
1451                 my $fmt = $confdesc->{$key}->{format};
1452                 if ($fmt && $fmt eq 'pve-qm-drive') {
1453                     my $v = parse_drive($key, $value);
1454                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1455                         $v->{file} = $volid;
1456                         $value = print_drive($vmid, $v);
1457                     } else {
1458                         warn "vm $vmid - unable to parse value of '$key'\n";
1459                         next;
1460                     }
1461                 }
1462
1463                 if ($key eq 'cdrom') {
1464                     $res->{ide2} = $value;
1465                 } else {
1466                     $res->{$key} = $value;
1467                 }
1468             }
1469         }
1470     }
1471
1472     # convert old smp to sockets
1473     if ($res->{smp} && !$res->{sockets}) {
1474         $res->{sockets} = $res->{smp};
1475     }
1476     delete $res->{smp};
1477
1478     return $res;
1479 }
1480
1481 sub change_config {
1482     my ($vmid, $settings, $unset, $skiplock) = @_;
1483
1484     lock_config($vmid, &change_config_nolock, $settings, $unset, $skiplock);
1485 }
1486
1487 sub change_config_nolock {
1488     my ($vmid, $settings, $unset, $skiplock) = @_;
1489
1490     my $res = {};
1491
1492     $unset->{ide2} = $unset->{cdrom} if $unset->{cdrom};
1493
1494     check_lock($settings) if !$skiplock;
1495
1496     # we do not use 'smp' any longer
1497     if ($settings->{sockets}) {
1498         $unset->{smp} = 1;
1499     } elsif ($settings->{smp}) {
1500         $settings->{sockets} = $settings->{smp};
1501         $unset->{smp} = 1;
1502     }
1503
1504     my $new_volids = {};
1505
1506     foreach my $key (keys %$settings) {
1507         next if $key eq 'digest';
1508         my $value = $settings->{$key};
1509         if ($key eq 'description') {
1510             $value = PVE::Tools::encode_text($value);
1511         }
1512         eval { $value = check_type($key, $value); };
1513         die "unable to parse value of '$key' - $@" if $@;
1514         if ($key eq 'cdrom') {
1515             $res->{ide2} = $value;
1516         } else {
1517             $res->{$key} = $value;
1518         }
1519         if (valid_drivename($key)) {
1520             my $drive = PVE::QemuServer::parse_drive($key, $value);
1521             $new_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1522         }
1523     }
1524
1525     my $filename = config_file($vmid);
1526     my $tmpfn = "$filename.$$.tmp";
1527
1528     my $fh = new IO::File($filename, "r") ||
1529         die "unable to read config for VM $vmid\n";
1530
1531     my $werror = "unable to write config for VM $vmid\n";
1532
1533     my $out = new IO::File($tmpfn, "w") || die $werror;
1534
1535     eval {
1536
1537         my $done;
1538
1539         while (my $line = <$fh>) {
1540
1541             if (($line =~ m/^\#/) || ($line =~ m/^\s*$/)) {
1542                 die $werror unless print $out $line;
1543                 next;
1544             }
1545
1546             if ($line =~ m/^([a-z][a-z_]*\d*):\s*(.*\S)\s*$/) {
1547                 my $key = $1;
1548                 my $value = $2;
1549
1550                 # remove 'unusedX' settings if we re-add a volume
1551                 next if $key =~ m/^unused/ && $new_volids->{$value};
1552
1553                 # convert 'smp' to 'sockets'
1554                 $key = 'sockets' if $key eq 'smp';
1555
1556                 next if $done->{$key};
1557                 $done->{$key} = 1;
1558
1559                 if (defined($res->{$key})) {
1560                     $value = $res->{$key};
1561                     delete $res->{$key};
1562                 }
1563                 if (!defined($unset->{$key})) {
1564                     die $werror unless print $out "$key: $value\n";
1565                 }
1566
1567                 next;
1568             }
1569
1570             die "unable to parse config file: $line\n";
1571         }
1572
1573         foreach my $key (keys %$res) {
1574
1575             if (!defined($unset->{$key})) {
1576                 die $werror unless print $out "$key: $res->{$key}\n";
1577             }
1578         }
1579     };
1580
1581     my $err = $@;
1582
1583     $fh->close();
1584
1585     if ($err) {
1586         $out->close();
1587         unlink $tmpfn;
1588         die $err;
1589     }
1590
1591     if (!$out->close()) {
1592         $err = "close failed - $!\n";
1593         unlink $tmpfn;
1594         die $err;
1595     }
1596
1597     if (!rename($tmpfn, $filename)) {
1598         $err = "rename failed - $!\n";
1599         unlink $tmpfn;
1600         die $err;
1601     }
1602 }
1603
1604 sub load_defaults {
1605
1606     my $res = {};
1607
1608     # we use static defaults from our JSON schema configuration
1609     foreach my $key (keys %$confdesc) {
1610         if (defined(my $default = $confdesc->{$key}->{default})) {
1611             $res->{$key} = $default;
1612         }
1613     }
1614
1615     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1616     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1617
1618     return $res;
1619 }
1620
1621 sub config_list {
1622     my $vmlist = PVE::Cluster::get_vmlist();
1623     my $res = {};
1624     return $res if !$vmlist || !$vmlist->{ids};
1625     my $ids = $vmlist->{ids};
1626
1627     foreach my $vmid (keys %$ids) {
1628         my $d = $ids->{$vmid};
1629         next if !$d->{node} || $d->{node} ne $nodename;
1630         next if !$d->{type} || $d->{type} ne 'qemu';
1631         $res->{$vmid}->{exists} = 1;
1632     }
1633     return $res;
1634 }
1635
1636 # test if VM uses local resources (to prevent migration)
1637 sub check_local_resources {
1638     my ($conf, $noerr) = @_;
1639
1640     my $loc_res = 0;
1641
1642     $loc_res = 1 if $conf->{hostusb}; # old syntax
1643     $loc_res = 1 if $conf->{hostpci}; # old syntax
1644
1645     foreach my $k (keys %$conf) {
1646         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1647     }
1648
1649     die "VM uses local resources\n" if $loc_res && !$noerr;
1650
1651     return $loc_res;
1652 }
1653
1654 sub check_lock {
1655     my ($conf) = @_;
1656
1657     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1658 }
1659
1660 sub check_cmdline {
1661     my ($pidfile, $pid) = @_;
1662
1663     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1664     if (defined($fh)) {
1665         my $line = <$fh>;
1666         $fh->close;
1667         return undef if !$line;
1668         my @param = split(/\0/, $line);
1669
1670         my $cmd = $param[0];
1671         return if !$cmd || ($cmd !~ m|kvm$|);
1672
1673         for (my $i = 0; $i < scalar (@param); $i++) {
1674             my $p = $param[$i];
1675             next if !$p;
1676             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1677                 my $p = $param[$i+1];
1678                 return 1 if $p && ($p eq $pidfile);
1679                 return undef;
1680             }
1681         }
1682     }
1683     return undef;
1684 }
1685
1686 sub check_running {
1687     my ($vmid, $nocheck) = @_;
1688
1689     my $filename = config_file($vmid);
1690
1691     die "unable to find configuration file for VM $vmid - no such machine\n"
1692         if !$nocheck && ! -f $filename;
1693
1694     my $pidfile = pidfile_name($vmid);
1695
1696     if (my $fd = IO::File->new("<$pidfile")) {
1697         my $st = stat($fd);
1698         my $line = <$fd>;
1699         close($fd);
1700
1701         my $mtime = $st->mtime;
1702         if ($mtime > time()) {
1703             warn "file '$filename' modified in future\n";
1704         }
1705
1706         if ($line =~ m/^(\d+)$/) {
1707             my $pid = $1;
1708             if (check_cmdline($pidfile, $pid)) {
1709                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1710                     return $pid;
1711                 }
1712             }
1713         }
1714     }
1715
1716     return undef;
1717 }
1718
1719 sub vzlist {
1720
1721     my $vzlist = config_list();
1722
1723     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1724
1725     while (defined(my $de = $fd->read)) {
1726         next if $de !~ m/^(\d+)\.pid$/;
1727         my $vmid = $1;
1728         next if !defined($vzlist->{$vmid});
1729         if (my $pid = check_running($vmid)) {
1730             $vzlist->{$vmid}->{pid} = $pid;
1731         }
1732     }
1733
1734     return $vzlist;
1735 }
1736
1737 my $storage_timeout_hash = {};
1738
1739 sub disksize {
1740     my ($storecfg, $conf) = @_;
1741
1742     my $bootdisk = $conf->{bootdisk};
1743     return undef if !$bootdisk;
1744     return undef if !valid_drivename($bootdisk);
1745
1746     return undef if !$conf->{$bootdisk};
1747
1748     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1749     return undef if !defined($drive);
1750
1751     return undef if drive_is_cdrom($drive);
1752
1753     my $volid = $drive->{file};
1754     return undef if !$volid;
1755
1756     my $path;
1757     my $storeid;
1758     my $timeoutid;
1759
1760     if ($volid =~ m|^/|) {
1761         $path = $timeoutid = $volid;
1762     } else {
1763         $storeid = $timeoutid = PVE::Storage::parse_volume_id($volid);
1764         $path = PVE::Storage::path($storecfg, $volid);
1765     }
1766
1767     my $last_timeout = $storage_timeout_hash->{$timeoutid};
1768     if ($last_timeout) {
1769         if ((time() - $last_timeout) < 30) {
1770             # skip storage with errors
1771             return undef ;
1772         }
1773         delete $storage_timeout_hash->{$timeoutid};
1774     }
1775
1776     my ($size, $format, $used);
1777
1778     ($size, $format, $used) = PVE::Storage::file_size_info($path, 1);
1779
1780     if (!defined($format)) {
1781         # got timeout
1782         $storage_timeout_hash->{$timeoutid} = time();
1783         return undef;
1784     }
1785
1786     return wantarray ? ($size, $used) : $size;
1787 }
1788
1789 my $last_proc_pid_stat;
1790
1791 sub vmstatus {
1792     my ($opt_vmid) = @_;
1793
1794     my $res = {};
1795
1796     my $storecfg = PVE::Storage::config();
1797
1798     my $list = vzlist();
1799     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(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->{name} = $conf->{name} || "VM $vmid";
1824         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1825
1826         $d->{uptime} = 0;
1827         $d->{cpu} = 0;
1828         $d->{relcpu} = 0;
1829         $d->{mem} = 0;
1830
1831         $d->{netout} = 0;
1832         $d->{netin} = 0;
1833
1834         $d->{diskread} = 0;
1835         $d->{diskwrite} = 0;
1836
1837         $res->{$vmid} = $d;
1838     }
1839
1840     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1841     foreach my $dev (keys %$netdev) {
1842         next if $dev !~ m/^tap([1-9]\d*)i/;
1843         my $vmid = $1;
1844         my $d = $res->{$vmid};
1845         next if !$d;
1846
1847         $d->{netout} += $netdev->{$dev}->{receive};
1848         $d->{netin} += $netdev->{$dev}->{transmit};
1849     }
1850
1851     my $cpucount = $cpuinfo->{cpus} || 1;
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         my $vcpus = $d->{cpus} > $cpucount ? $cpucount : $d->{cpus};
1878
1879         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
1880
1881         if ($pstat->{vsize}) {
1882             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
1883         }
1884
1885         my $old = $last_proc_pid_stat->{$pid};
1886         if (!$old) {
1887             $last_proc_pid_stat->{$pid} = {
1888                 time => $ctime,
1889                 used => $used,
1890                 cpu => 0,
1891                 relcpu => 0,
1892             };
1893             next;
1894         }
1895
1896         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
1897
1898         if ($dtime > 1000) {
1899             my $dutime = $used -  $old->{used};
1900
1901             $d->{cpu} = $dutime/$dtime;
1902             $d->{relcpu} = ($d->{cpu} * $cpucount) / $vcpus;
1903             $last_proc_pid_stat->{$pid} = {
1904                 time => $ctime,
1905                 used => $used,
1906                 cpu => $d->{cpu},
1907                 relcpu => $d->{relcpu},
1908             };
1909         } else {
1910             $d->{cpu} = $old->{cpu};
1911             $d->{relcpu} = $old->{relcpu};
1912         }
1913     }
1914
1915     return $res;
1916 }
1917
1918 sub foreach_drive {
1919     my ($conf, $func) = @_;
1920
1921     foreach my $ds (keys %$conf) {
1922         next if !valid_drivename($ds);
1923
1924         my $drive = parse_drive($ds, $conf->{$ds});
1925         next if !$drive;
1926
1927         &$func($ds, $drive);
1928     }
1929 }
1930
1931 sub config_to_command {
1932     my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
1933
1934     my $cmd = [];
1935     my $pciaddr = '';
1936     my $kvmver = kvm_user_version();
1937     my $vernum = 0; # unknown
1938     if ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
1939         $vernum = $1*1000000+$2*1000+$3;
1940     }
1941
1942     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 14000;
1943
1944     my $have_ovz = -f '/proc/vz/vestat';
1945
1946     push @$cmd, '/usr/bin/kvm';
1947
1948     push @$cmd, '-id', $vmid;
1949
1950     my $use_virtio = 0;
1951
1952     my $socket = monitor_socket($vmid);
1953     push @$cmd, '-chardev', "socket,id=monitor,path=$socket,server,nowait";
1954     push @$cmd, '-mon', "chardev=monitor,mode=readline";
1955
1956     $socket = vnc_socket($vmid);
1957     push @$cmd,  '-vnc', "unix:$socket,x509,password";
1958
1959     push @$cmd, '-pidfile' , pidfile_name($vmid);
1960
1961     push @$cmd, '-daemonize';
1962
1963     push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
1964
1965     # include usb device config
1966     push @$cmd, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg';
1967
1968     # enable absolute mouse coordinates (needed by vnc)
1969     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
1970     push @$cmd, '-device', 'usb-tablet,bus=ehci.0,port=6' if $tablet;
1971
1972     # host pci devices
1973     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
1974           my $d = parse_hostpci($conf->{"hostpci$i"});
1975           next if !$d;
1976           $pciaddr = print_pci_addr("hostpci$i");
1977           push @$cmd, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
1978     }
1979
1980     # usb devices
1981     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
1982         my $d = parse_usb_device($conf->{"usb$i"});
1983         next if !$d;
1984         if ($d->{vendorid} && $d->{productid}) {
1985             push @$cmd, '-device', "usb-host,vendorid=$d->{vendorid},productid=$d->{productid}";
1986         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
1987             push @$cmd, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
1988         }
1989     }
1990
1991     # serial devices
1992     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
1993         if (my $path = $conf->{"serial$i"}) {
1994             die "no such serial device\n" if ! -c $path;
1995             push @$cmd, '-chardev', "tty,id=serial$i,path=$path";
1996             push @$cmd, '-device', "isa-serial,chardev=serial$i";
1997         }
1998     }
1999
2000     # parallel devices
2001     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2002         if (my $path = $conf->{"parallel$i"}) {
2003             die "no such parallel device\n" if ! -c $path;
2004             push @$cmd, '-chardev', "parport,id=parallel$i,path=$path";
2005             push @$cmd, '-device', "isa-parallel,chardev=parallel$i";
2006         }
2007     }
2008
2009     my $vmname = $conf->{name} || "vm$vmid";
2010
2011     push @$cmd, '-name', $vmname;
2012
2013     my $sockets = 1;
2014     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2015     $sockets = $conf->{sockets} if  $conf->{sockets};
2016
2017     my $cores = $conf->{cores} || 1;
2018
2019     my $boot_opt;
2020
2021     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2022
2023     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2024
2025     push @$cmd, '-nodefaults';
2026
2027     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2028     push @$cmd, '-boot', "menu=on,order=$bootorder";
2029
2030     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2031
2032     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2033
2034     my $vga = $conf->{vga};
2035     if (!$vga) {
2036         if ($conf->{ostype} && ($conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2037             $vga = 'std';
2038         } else {
2039             $vga = 'cirrus';
2040         }
2041     }
2042
2043     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2044
2045     # time drift fix
2046     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2047     push @$cmd, '-tdf' if $tdf;
2048
2049     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2050
2051     if (my $ost = $conf->{ostype}) {
2052         # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2053
2054         if ($ost =~ m/^w/) { # windows
2055             push @$cmd, '-localtime' if !defined($conf->{localtime});
2056
2057             # use rtc-td-hack when acpi is enabled
2058             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2059                 push @$cmd, '-rtc-td-hack';
2060             }
2061         }
2062
2063         # -tdf ?
2064         # -no-acpi
2065         # -no-kvm
2066         # -win2k-hack ?
2067     }
2068
2069     if ($nokvm) {
2070         push @$cmd, '-no-kvm';
2071     } else {
2072         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2073     }
2074
2075     push @$cmd, '-localtime' if $conf->{localtime};
2076
2077     push @$cmd, '-startdate', $conf->{startdate} if $conf->{startdate};
2078
2079     push @$cmd, '-S' if $conf->{freeze};
2080
2081     # set keyboard layout
2082     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2083     push @$cmd, '-k', $kb if $kb;
2084
2085     # enable sound
2086     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2087     #push @$cmd, '-soundhw', 'es1370';
2088     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2089     $pciaddr = print_pci_addr("balloon0");
2090     push @$cmd, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2091
2092     if ($conf->{watchdog}) {
2093         my $wdopts = parse_watchdog($conf->{watchdog});
2094         $pciaddr = print_pci_addr("watchdog");
2095         my $watchdog = $wdopts->{model} || 'i6300esb';
2096         push @$cmd, '-device', "$watchdog$pciaddr";
2097         push @$cmd, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2098     }
2099
2100     my $vollist = [];
2101     my $scsicontroller = {};
2102
2103     foreach_drive($conf, sub {
2104         my ($ds, $drive) = @_;
2105
2106         eval {
2107             PVE::Storage::parse_volume_id($drive->{file});
2108             push @$vollist, $drive->{file};
2109         }; # ignore errors
2110
2111         $use_virtio = 1 if $ds =~ m/^virtio/;
2112         if ($drive->{interface} eq 'scsi') {
2113            my $maxdev = 7;
2114            my $controller = int($drive->{index} / $maxdev);
2115            $pciaddr = print_pci_addr("scsi$controller");
2116            push @$cmd, '-device', "lsi,id=scsi$controller$pciaddr" if !$scsicontroller->{$controller};
2117            $scsicontroller->{$controller}=1;
2118         }
2119         my $tmp = print_drive_full($storecfg, $vmid, $drive);
2120         $tmp .= ",boot=on" if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2121         push @$cmd, '-drive', $tmp;
2122         push @$cmd, '-device',print_drivedevice_full($storecfg,$vmid, $drive);
2123     });
2124
2125     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2126
2127     my $foundnet = 0;
2128
2129     foreach my $k (sort keys %$conf) {
2130         next if $k !~ m/^net(\d+)$/;
2131         my $i = int($1);
2132
2133         die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
2134
2135         if ($conf->{"net$i"} && (my $net = parse_net($conf->{"net$i"}))) {
2136
2137             $foundnet = 1;
2138
2139             my $ifname = "tap${vmid}i$i";
2140
2141             # kvm uses TUNSETIFF ioctl, and that limits ifname length
2142             die "interface name '$ifname' is too long (max 15 character)\n"
2143                 if length($ifname) >= 16;
2144
2145             my $device = $net->{model};
2146             my $vhostparam = '';
2147             if ($net->{model} eq 'virtio') {
2148                 $use_virtio = 1;
2149                 $device = 'virtio-net-pci';
2150                 $vhostparam = ',vhost=on' if $kernel_has_vhost_net;
2151             };
2152
2153             if ($net->{bridge}) {
2154                 push @$cmd, '-netdev', "type=tap,id=${k},ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
2155             } else {
2156                 push @$cmd, '-netdev', "type=user,id=${k},hostname=$vmname";
2157             }
2158
2159             # qemu > 0.15 always try to boot from network - we disable that by
2160             # not loading the pxe rom file
2161             my $extra = (!$conf->{boot} || ($conf->{boot} !~ m/n/)) ?
2162                 "romfile=," : '';
2163             $pciaddr = print_pci_addr("${k}");
2164             push @$cmd, '-device', "$device,${extra}mac=$net->{macaddr},netdev=${k}$pciaddr";
2165         }
2166     }
2167
2168     push @$cmd, '-net', 'none' if !$foundnet;
2169
2170     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2171     # when the VM uses virtio devices.
2172     if (!$use_virtio && $have_ovz) {
2173
2174         my $cpuunits = defined($conf->{cpuunits}) ?
2175             $conf->{cpuunits} : $defaults->{cpuunits};
2176
2177         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2178
2179         # fixme: cpulimit is currently ignored
2180         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2181     }
2182
2183     # add custom args
2184     if ($conf->{args}) {
2185         my $aa = PVE::Tools::split_args($conf->{args});
2186         push @$cmd, @$aa;
2187     }
2188
2189     return wantarray ? ($cmd, $vollist) : $cmd;
2190 }
2191
2192 sub vnc_socket {
2193     my ($vmid) = @_;
2194     return "${var_run_tmpdir}/$vmid.vnc";
2195 }
2196
2197 sub monitor_socket {
2198     my ($vmid) = @_;
2199     return "${var_run_tmpdir}/$vmid.mon";
2200 }
2201
2202 sub pidfile_name {
2203     my ($vmid) = @_;
2204     return "${var_run_tmpdir}/$vmid.pid";
2205 }
2206
2207 sub next_migrate_port {
2208
2209     for (my $p = 60000; $p < 60010; $p++) {
2210
2211         my $sock = IO::Socket::INET->new(Listen => 5,
2212                                          LocalAddr => 'localhost',
2213                                          LocalPort => $p,
2214                                          ReuseAddr => 1,
2215                                          Proto     => 0);
2216
2217         if ($sock) {
2218             close($sock);
2219             return $p;
2220         }
2221     }
2222
2223     die "unable to find free migration port";
2224 }
2225
2226 sub vm_devices_list {
2227     my ($vmid) = @_;
2228
2229     my $res = vm_monitor_command ($vmid, "info pci", 1);
2230
2231     my @lines = split ("\n", $res);
2232     my $devices;
2233     my $bus;
2234     my $addr;
2235     my $id;
2236
2237     foreach my $line (@lines) {
2238         $line =~ s/^\s+//;
2239         if ($line =~ m/^Bus  (\d+), device   (\d+), function (\d+):$/) {
2240             $bus=$1;
2241             $addr=$2;
2242         }
2243         if ($line =~ m/^id "([a-z][a-z_\-]*\d*)"$/) {
2244             $id=$1;
2245             $devices->{$id}->{bus}=$bus;
2246             $devices->{$id}->{addr}=$addr;
2247         }
2248     }
2249
2250     return $devices;
2251 }
2252
2253 sub vm_deviceadd {
2254     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2255     return if !check_running($vmid) || !$conf->{hotplug} || $conf->{$deviceid};
2256
2257     if($deviceid =~ m/^(virtio)(\d+)$/) {
2258
2259         my $drive = print_drive_full($storecfg, $vmid, $device);
2260         my $ret = vm_monitor_command($vmid, "drive_add auto $drive", 1);
2261         # If the command succeeds qemu prints: "OK"
2262         if ($ret !~ m/OK/s) {
2263            die "adding drive failed: $ret";
2264         }
2265
2266         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2267         $ret = vm_monitor_command($vmid, "device_add $devicefull", 1);
2268         $ret =~ s/^\s+//;
2269         # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2270         die 'error on hotplug device : $ret' if $ret ne "";
2271     }
2272
2273     for (my $i = 0; $i <= 5; $i++) {
2274         my $devices_list = vm_devices_list($vmid);
2275         return if defined($devices_list->{$deviceid});
2276         sleep 1;
2277     }
2278
2279     die "error on hotplug device $deviceid";
2280 }
2281
2282 sub vm_devicedel {
2283     my ($vmid, $conf, $deviceid) = @_;
2284
2285     return if !check_running ($vmid) || !$conf->{hotplug};
2286
2287     die "can't unplug bootdisk" if $conf->{bootdisk} eq $deviceid;
2288
2289     if($deviceid =~ m/^(virtio)(\d+)$/){
2290
2291         my $ret = vm_monitor_command($vmid, "drive_del drive-$deviceid", 1);
2292         $ret =~ s/^\s+//;
2293         if ($ret =~ m/Device \'.*?\' not found/s) {
2294             # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2295         }
2296         elsif ($ret ne "") {
2297             die "deleting drive $deviceid failed : $ret";
2298         }
2299
2300         $ret = vm_monitor_command($vmid, "device_del $deviceid", 1);
2301         $ret =~ s/^\s+//;
2302         die 'detaching device $deviceid failed : $ret' if $ret ne "";
2303
2304     }
2305
2306     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2307     for (my $i = 0; $i <= 5; $i++) {
2308         my $devices_list = vm_devices_list($vmid);
2309         return if !defined($devices_list->{$deviceid});
2310         sleep 1;
2311     }
2312     die "error on hot-plugging device $deviceid";
2313
2314
2315 }
2316
2317 sub vm_start {
2318     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2319
2320     lock_config($vmid, sub {
2321         my $conf = load_config($vmid);
2322
2323         check_lock($conf) if !$skiplock;
2324
2325         if (check_running($vmid)) {
2326             my $msg = "VM $vmid already running - start failed\n" ;
2327             syslog('err', $msg);
2328             die $msg;
2329         } else {
2330             syslog('info', "VM $vmid start");
2331         }
2332
2333         my $migrate_uri;
2334         my $migrate_port = 0;
2335
2336         if ($statefile) {
2337             if ($statefile eq 'tcp') {
2338                 $migrate_port = next_migrate_port();
2339                 $migrate_uri = "tcp:localhost:${migrate_port}";
2340             } else {
2341                 if (-f $statefile) {
2342                     $migrate_uri = "exec:cat $statefile";
2343                 } else {
2344                     warn "state file '$statefile' does not exist - doing normal startup\n";
2345                 }
2346             }
2347         }
2348
2349         my $defaults = load_defaults();
2350
2351         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2352         # host pci devices
2353         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2354           my $d = parse_hostpci($conf->{"hostpci$i"});
2355           next if !$d;
2356           my $info = pci_device_info("0000:$d->{pciid}");
2357           die "IOMMU not present\n" if !check_iommu_support();
2358           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2359           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2360           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2361         }
2362
2363         PVE::Storage::activate_volumes($storecfg, $vollist);
2364
2365         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2366
2367         my $err = $@;
2368
2369         if ($err) {
2370             my $msg = "start failed: $err";
2371             syslog('err', "VM $vmid $msg");
2372             die $msg;
2373         }
2374
2375         if ($statefile) {
2376
2377             if ($statefile eq 'tcp') {
2378                 print "migration listens on port $migrate_port\n";
2379             } else {
2380                 unlink $statefile;
2381                 # fixme: send resume - is that necessary ?
2382                 eval  { vm_monitor_command($vmid, "cont", 1) };
2383             }
2384         }
2385
2386         if (my $migrate_speed =
2387             $conf->{migrate_speed} || $defaults->{migrate_speed}) {
2388             my $cmd = "migrate_set_speed ${migrate_speed}m";
2389             eval { vm_monitor_command($vmid, $cmd, 1); };
2390         }
2391
2392         if (my $migrate_downtime =
2393             $conf->{migrate_downtime} || $defaults->{migrate_downtime}) {
2394             my $cmd = "migrate_set_downtime ${migrate_downtime}";
2395             eval { vm_monitor_command($vmid, $cmd, 1); };
2396         }
2397
2398         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2399     });
2400 }
2401
2402 sub __read_avail {
2403     my ($fh, $timeout) = @_;
2404
2405     my $sel = new IO::Select;
2406     $sel->add($fh);
2407
2408     my $res = '';
2409     my $buf;
2410
2411     my @ready;
2412     while (scalar (@ready = $sel->can_read($timeout))) {
2413         my $count;
2414         if ($count = $fh->sysread($buf, 8192)) {
2415             if ($buf =~ /^(.*)\(qemu\) $/s) {
2416                 $res .= $1;
2417                 last;
2418             } else {
2419                 $res .= $buf;
2420             }
2421         } else {
2422             if (!defined($count)) {
2423                 die "$!\n";
2424             }
2425             last;
2426         }
2427     }
2428
2429     die "monitor read timeout\n" if !scalar(@ready);
2430
2431     return $res;
2432 }
2433
2434 sub vm_monitor_command {
2435     my ($vmid, $cmdstr, $nolog, $nocheck) = @_;
2436
2437     my $res;
2438
2439     syslog("info", "VM $vmid monitor command '$cmdstr'") if !$nolog;
2440
2441     eval {
2442         die "VM not running\n" if !check_running($vmid, $nocheck);
2443
2444         my $sname = monitor_socket($vmid);
2445
2446         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2447             die "unable to connect to VM $vmid socket - $!\n";
2448
2449         my $timeout = 3;
2450
2451         # hack: migrate sometime blocks the monitor (when migrate_downtime
2452         # is set)
2453         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2454             $timeout = 60*60; # 1 hour
2455         }
2456
2457         # read banner;
2458         my $data = __read_avail($sock, $timeout);
2459
2460         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2461             die "got unexpected qemu monitor banner\n";
2462         }
2463
2464         my $sel = new IO::Select;
2465         $sel->add($sock);
2466
2467         if (!scalar(my @ready = $sel->can_write($timeout))) {
2468             die "monitor write error - timeout";
2469         }
2470
2471         my $fullcmd = "$cmdstr\r";
2472
2473         my $b;
2474         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2475             die "monitor write error - $!";
2476         }
2477
2478         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2479
2480         $timeout = 20;
2481
2482         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2483             $timeout = 60*60; # 1 hour
2484         } elsif ($cmdstr =~ m/^(eject|change)/) {
2485             $timeout = 60; # note: cdrom mount command is slow
2486         }
2487         if ($res = __read_avail($sock, $timeout)) {
2488
2489             my @lines = split("\r?\n", $res);
2490
2491             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2492
2493             $res = join("\n", @lines);
2494             $res .= "\n";
2495         }
2496     };
2497
2498     my $err = $@;
2499
2500     if ($err) {
2501         syslog("err", "VM $vmid monitor command failed - $err");
2502         die $err;
2503     }
2504
2505     return $res;
2506 }
2507
2508 sub vm_commandline {
2509     my ($storecfg, $vmid) = @_;
2510
2511     my $conf = load_config($vmid);
2512
2513     my $defaults = load_defaults();
2514
2515     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2516
2517     return join(' ', @$cmd);
2518 }
2519
2520 sub vm_reset {
2521     my ($vmid, $skiplock) = @_;
2522
2523     lock_config($vmid, sub {
2524
2525         my $conf = load_config($vmid);
2526
2527         check_lock($conf) if !$skiplock;
2528
2529         syslog("info", "VM $vmid sending 'reset'");
2530
2531         vm_monitor_command($vmid, "system_reset", 1);
2532     });
2533 }
2534
2535 sub vm_shutdown {
2536     my ($vmid, $skiplock) = @_;
2537
2538     lock_config($vmid, sub {
2539
2540         my $conf = load_config($vmid);
2541
2542         check_lock($conf) if !$skiplock;
2543
2544         syslog("info", "VM $vmid sending 'shutdown'");
2545
2546         vm_monitor_command($vmid, "system_powerdown", 1);
2547     });
2548 }
2549
2550 # Note: use $nockeck to skip tests if VM configuration file exists.
2551 # We need that when migration VMs to other nodes (files already moved)
2552 sub vm_stop {
2553     my ($vmid, $skiplock, $nocheck) = @_;
2554
2555     lock_config($vmid, sub {
2556
2557         my $pid = check_running($vmid, $nocheck);
2558
2559         if (!$pid) {
2560             syslog('info', "VM $vmid already stopped");
2561             return;
2562         }
2563
2564         if (!$nocheck) {
2565             my $conf = load_config($vmid);
2566             check_lock($conf) if !$skiplock;
2567         }
2568
2569         syslog("info", "VM $vmid stopping");
2570
2571         eval { vm_monitor_command($vmid, "quit", 1, $nocheck); };
2572
2573         my $err = $@;
2574
2575         if (!$err) {
2576             # wait some time
2577             my $timeout = 50; # fixme: how long?
2578
2579             my $count = 0;
2580             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2581                 $count++;
2582                 sleep 1;
2583             }
2584
2585             if ($count >= $timeout) {
2586                 syslog('info', "VM $vmid still running - terminating now with SIGTERM");
2587                 kill 15, $pid;
2588             }
2589         } else {
2590             syslog('info', "VM $vmid quit failed - terminating now with SIGTERM");
2591             kill 15, $pid;
2592         }
2593
2594         # wait again
2595         my $timeout = 10;
2596
2597         my $count = 0;
2598         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2599             $count++;
2600             sleep 1;
2601         }
2602
2603         if ($count >= $timeout) {
2604             syslog('info', "VM $vmid still running - terminating now with SIGKILL\n");
2605             kill 9, $pid;
2606         }
2607
2608         fairsched_rmnod($vmid); # try to destroy group
2609     });
2610 }
2611
2612 sub vm_suspend {
2613     my ($vmid, $skiplock) = @_;
2614
2615     lock_config($vmid, sub {
2616
2617         my $conf = load_config($vmid);
2618
2619         check_lock($conf) if !$skiplock;
2620
2621         syslog("info", "VM $vmid suspend");
2622
2623         vm_monitor_command($vmid, "stop", 1);
2624     });
2625 }
2626
2627 sub vm_resume {
2628     my ($vmid, $skiplock) = @_;
2629
2630     lock_config($vmid, sub {
2631
2632         my $conf = load_config($vmid);
2633
2634         check_lock($conf) if !$skiplock;
2635
2636         syslog("info", "VM $vmid resume");
2637
2638         vm_monitor_command($vmid, "cont", 1);
2639     });
2640 }
2641
2642 sub vm_sendkey {
2643     my ($vmid, $skiplock, $key) = @_;
2644
2645     lock_config($vmid, sub {
2646
2647         my $conf = load_config($vmid);
2648
2649         check_lock($conf) if !$skiplock;
2650
2651         syslog("info", "VM $vmid sending key $key");
2652
2653         vm_monitor_command($vmid, "sendkey $key", 1);
2654     });
2655 }
2656
2657 sub vm_destroy {
2658     my ($storecfg, $vmid, $skiplock) = @_;
2659
2660     lock_config($vmid, sub {
2661
2662         my $conf = load_config($vmid);
2663
2664         check_lock($conf) if !$skiplock;
2665
2666         syslog("info", "VM $vmid destroy called (removing all data)");
2667
2668         eval {
2669             if (!check_running($vmid)) {
2670                 fairsched_rmnod($vmid); # try to destroy group
2671                 destroy_vm($storecfg, $vmid);
2672             } else {
2673                 die "VM is running\n";
2674             }
2675         };
2676
2677         my $err = $@;
2678
2679         if ($err) {
2680             syslog("err", "VM $vmid destroy failed - $err");
2681             die $err;
2682         }
2683     });
2684 }
2685
2686 sub vm_stopall {
2687     my ($timeout) = @_;
2688
2689     $timeout = 3*60 if !$timeout;
2690
2691     my $vzlist = vzlist();
2692     my $count = 0;
2693     foreach my $vmid (keys %$vzlist) {
2694         next if !$vzlist->{$vmid}->{pid};
2695         $count++;
2696     }
2697
2698     if ($count) {
2699
2700         my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs\n";
2701         syslog('info', $msg);
2702         print STDERR $msg;
2703
2704         foreach my $vmid (keys %$vzlist) {
2705             next if !$vzlist->{$vmid}->{pid};
2706             eval { vm_shutdown($vmid, 1); };
2707             print STDERR $@ if $@;
2708         }
2709
2710         my $wt = 5;
2711         my $maxtries = int(($timeout + $wt -1)/$wt);
2712         my $try = 0;
2713         while (($try < $maxtries) && $count) {
2714             $try++;
2715             sleep $wt;
2716
2717             $vzlist = vzlist();
2718             $count = 0;
2719             foreach my $vmid (keys %$vzlist) {
2720                 next if !$vzlist->{$vmid}->{pid};
2721                 $count++;
2722             }
2723             last if !$count;
2724         }
2725
2726         return if !$count;
2727
2728         foreach my $vmid (keys %$vzlist) {
2729             next if !$vzlist->{$vmid}->{pid};
2730
2731             $msg = "VM $vmid still running - sending stop now\n";
2732             syslog('info', $msg);
2733             print $msg;
2734
2735             eval { vm_monitor_command($vmid, "quit", 1); };
2736             print STDERR $@ if $@;
2737
2738         }
2739
2740         $timeout = 30;
2741         $maxtries = int(($timeout + $wt -1)/$wt);
2742         $try = 0;
2743         while (($try < $maxtries) && $count) {
2744             $try++;
2745             sleep $wt;
2746
2747             $vzlist = vzlist();
2748             $count = 0;
2749             foreach my $vmid (keys %$vzlist) {
2750                 next if !$vzlist->{$vmid}->{pid};
2751                 $count++;
2752             }
2753             last if !$count;
2754         }
2755
2756         return if !$count;
2757
2758         foreach my $vmid (keys %$vzlist) {
2759             next if !$vzlist->{$vmid}->{pid};
2760
2761             $msg = "VM $vmid still running - terminating now with SIGTERM\n";
2762             syslog('info', $msg);
2763             print $msg;
2764             kill 15, $vzlist->{$vmid}->{pid};
2765         }
2766
2767         # this is called by system shotdown scripts, so remaining
2768         # processes gets killed anyways (no need to send kill -9 here)
2769
2770         $msg = "Qemu Server stopped\n";
2771         syslog('info', $msg);
2772         print STDERR $msg;
2773     }
2774 }
2775
2776 # pci helpers
2777
2778 sub file_write {
2779     my ($filename, $buf) = @_;
2780
2781     my $fh = IO::File->new($filename, "w");
2782     return undef if !$fh;
2783
2784     my $res = print $fh $buf;
2785
2786     $fh->close();
2787
2788     return $res;
2789 }
2790
2791 sub pci_device_info {
2792     my ($name) = @_;
2793
2794     my $res;
2795
2796     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
2797     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
2798
2799     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
2800     return undef if !defined($irq) || $irq !~ m/^\d+$/;
2801
2802     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
2803     return undef if !defined($vendor) || $vendor !~ s/^0x//;
2804
2805     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
2806     return undef if !defined($product) || $product !~ s/^0x//;
2807
2808     $res = {
2809         name => $name,
2810         vendor => $vendor,
2811         product => $product,
2812         domain => $domain,
2813         bus => $bus,
2814         slot => $slot,
2815         func => $func,
2816         irq => $irq,
2817         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
2818     };
2819
2820     return $res;
2821 }
2822
2823 sub pci_dev_reset {
2824     my ($dev) = @_;
2825
2826     my $name = $dev->{name};
2827
2828     my $fn = "$pcisysfs/devices/$name/reset";
2829
2830     return file_write($fn, "1");
2831 }
2832
2833 sub pci_dev_bind_to_stub {
2834     my ($dev) = @_;
2835
2836     my $name = $dev->{name};
2837
2838     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
2839     return 1 if -d $testdir;
2840
2841     my $data = "$dev->{vendor} $dev->{product}";
2842     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
2843
2844     my $fn = "$pcisysfs/devices/$name/driver/unbind";
2845     if (!file_write($fn, $name)) {
2846         return undef if -f $fn;
2847     }
2848
2849     $fn = "$pcisysfs/drivers/pci-stub/bind";
2850     if (! -d $testdir) {
2851         return undef if !file_write($fn, $name);
2852     }
2853
2854     return -d $testdir;
2855 }
2856
2857 sub print_pci_addr {
2858     my ($id) = @_;
2859
2860     my $res = '';
2861     my $devices = {
2862         #addr1 : ide,parallel,serial (motherboard)
2863         #addr2 : first videocard
2864         balloon0 => { bus => 0, addr => 3 },
2865         watchdog => { bus => 0, addr => 4 },
2866         scsi0 => { bus => 0, addr => 5 },
2867         scsi1 => { bus => 0, addr => 6 },
2868         virtio0 => { bus => 0, addr => 10 },
2869         virtio1 => { bus => 0, addr => 11 },
2870         virtio2 => { bus => 0, addr => 12 },
2871         virtio3 => { bus => 0, addr => 13 },
2872         virtio4 => { bus => 0, addr => 14 },
2873         virtio5 => { bus => 0, addr => 15 },
2874         hostpci0 => { bus => 0, addr => 16 },
2875         hostpci1 => { bus => 0, addr => 17 },
2876         net0 => { bus => 0, addr => 18 },
2877         net1 => { bus => 0, addr => 19 },
2878         net2 => { bus => 0, addr => 20 },
2879         net3 => { bus => 0, addr => 21 },
2880         net4 => { bus => 0, addr => 22 },
2881         net5 => { bus => 0, addr => 23 },
2882         #addr29 : usb-host (pve-usb.cfg)
2883     };
2884
2885     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
2886            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
2887            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
2888     }
2889     return $res;
2890
2891 }
2892
2893 sub vm_balloonset {
2894     my ($vmid, $value) = @_;
2895
2896     vm_monitor_command($vmid, "balloon $value", 1);
2897 }
2898
2899 # vzdump restore implementaion
2900
2901 sub archive_read_firstfile {
2902     my $archive = shift;
2903
2904     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
2905
2906     # try to detect archive type first
2907     my $pid = open (TMP, "tar tf '$archive'|") ||
2908         die "unable to open file '$archive'\n";
2909     my $firstfile = <TMP>;
2910     kill 15, $pid;
2911     close TMP;
2912
2913     die "ERROR: archive contaions no data\n" if !$firstfile;
2914     chomp $firstfile;
2915
2916     return $firstfile;
2917 }
2918
2919 sub restore_cleanup {
2920     my $statfile = shift;
2921
2922     print STDERR "starting cleanup\n";
2923
2924     if (my $fd = IO::File->new($statfile, "r")) {
2925         while (defined(my $line = <$fd>)) {
2926             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
2927                 my $volid = $2;
2928                 eval {
2929                     if ($volid =~ m|^/|) {
2930                         unlink $volid || die 'unlink failed\n';
2931                     } else {
2932                         my $cfg = cfs_read_file('storage.cfg');
2933                         PVE::Storage::vdisk_free($cfg, $volid);
2934                     }
2935                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
2936                 };
2937                 print STDERR "unable to cleanup '$volid' - $@" if $@;
2938             } else {
2939                 print STDERR "unable to parse line in statfile - $line";
2940             }
2941         }
2942         $fd->close();
2943     }
2944 }
2945
2946 sub restore_archive {
2947     my ($archive, $vmid, $opts) = @_;
2948
2949     if ($archive ne '-') {
2950         my $firstfile = archive_read_firstfile($archive);
2951         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
2952             if $firstfile ne 'qemu-server.conf';
2953     }
2954
2955     my $tocmd = "/usr/lib/qemu-server/qmextract";
2956
2957     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
2958     $tocmd .= ' --prealloc' if $opts->{prealloc};
2959     $tocmd .= ' --info' if $opts->{info};
2960
2961     # tar option "xf" does not autodetect compression when read fron STDIN,
2962     # so we pipe to zcat
2963     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
2964         PVE::Tools::shellquote("--to-command=$tocmd");
2965
2966     my $tmpdir = "/var/tmp/vzdumptmp$$";
2967     mkpath $tmpdir;
2968
2969     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
2970     local $ENV{VZDUMP_VMID} = $vmid;
2971
2972     my $conffile = PVE::QemuServer::config_file($vmid);
2973     my $tmpfn = "$conffile.$$.tmp";
2974
2975     # disable interrupts (always do cleanups)
2976     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
2977         print STDERR "got interrupt - ignored\n";
2978     };
2979
2980     eval {
2981         # enable interrupts
2982         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
2983             die "interrupted by signal\n";
2984         };
2985
2986         if ($archive eq '-') {
2987             print "extracting archive from STDIN\n";
2988             run_command($cmd, input => "<&STDIN");
2989         } else {
2990             print "extracting archive '$archive'\n";
2991             run_command($cmd);
2992         }
2993
2994         return if $opts->{info};
2995
2996         # read new mapping
2997         my $map = {};
2998         my $statfile = "$tmpdir/qmrestore.stat";
2999         if (my $fd = IO::File->new($statfile, "r")) {
3000             while (defined (my $line = <$fd>)) {
3001                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3002                     $map->{$1} = $2 if $1;
3003                 } else {
3004                     print STDERR "unable to parse line in statfile - $line\n";
3005                 }
3006             }
3007             $fd->close();
3008         }
3009
3010         my $confsrc = "$tmpdir/qemu-server.conf";
3011
3012         my $srcfd = new IO::File($confsrc, "r") ||
3013             die "unable to open file '$confsrc'\n";
3014
3015         my $outfd = new IO::File ($tmpfn, "w") ||
3016             die "unable to write config for VM $vmid\n";
3017
3018         my $netcount = 0;
3019
3020         while (defined (my $line = <$srcfd>)) {
3021             next if $line =~ m/^\#vzdump\#/;
3022             next if $line =~ m/^lock:/;
3023             next if $line =~ m/^unused\d+:/;
3024
3025             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3026                 # try to convert old 1.X settings
3027                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3028                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3029                     my ($model, $macaddr) = split(/\=/, $devconfig);
3030                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3031                     my $net = {
3032                         model => $model,
3033                         bridge => "vmbr$ind",
3034                         macaddr => $macaddr,
3035                     };
3036                     my $netstr = print_net($net);
3037                     print $outfd "net${netcount}: $netstr\n";
3038                     $netcount++;
3039                 }
3040             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3041                 my ($id, $netstr) = ($1, $2);
3042                 my $net = parse_net($netstr);
3043                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3044                 $netstr = print_net($net);
3045                 print $outfd "$id: $netstr\n";
3046             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3047                 my $virtdev = $1;
3048                 my $value = $2;
3049                 if ($line =~ m/backup=no/) {
3050                     print $outfd "#$line";
3051                 } elsif ($virtdev && $map->{$virtdev}) {
3052                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3053                     $di->{file} = $map->{$virtdev};
3054                     $value = PVE::QemuServer::print_drive($vmid, $di);
3055                     print $outfd "$virtdev: $value\n";
3056                 } else {
3057                     print $outfd $line;
3058                 }
3059             } else {
3060                 print $outfd $line;
3061             }
3062         }
3063
3064         $srcfd->close();
3065         $outfd->close();
3066     };
3067     my $err = $@;
3068
3069     if ($err) {
3070
3071         unlink $tmpfn;
3072
3073         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3074
3075         die $err;
3076     }
3077
3078     rmtree $tmpdir;
3079
3080     rename $tmpfn, $conffile ||
3081         die "unable to commit configuration file '$conffile'\n";
3082 };
3083
3084 1;