PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use POSIX;
   5 use IO::Handle;
   6 use IO::Select;
   7 use IO::File;
   8 use IO::Dir;
   9 use IO::Socket::UNIX;
  10 use File::Basename;
  11 use File::Path;
  12 use File::stat;
  13 use Getopt::Long;
  14 use Digest::SHA1;
  15 use Fcntl ':flock';
  16 use Cwd 'abs_path';
  17 use IPC::Open3;
  18 use Fcntl;
  19 use PVE::SafeSyslog;
  20 use Storable qw(dclone);
  21 use PVE::Exception qw(raise raise_param_exc);
  22 use PVE::Storage;
  23 use PVE::Tools qw(run_command lock_file file_read_firstline);
  24 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  25 use PVE::INotify;
  26 use PVE::ProcFSTools;
  27 use Time::HiRes qw(gettimeofday);
  28
  29 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  30
  31 # Note about locking: we use flock on the config file protect
  32 # against concurent actions.
  33 # Aditionaly, we have a 'lock' setting in the config file. This
  34 # can be set to 'migrate' or 'backup'. Most actions are not
  35 # allowed when such lock is set. But you can ignore this kind of
  36 # lock with the --skiplock flag.
  37
  38 cfs_register_file('/qemu-server/', \&parse_vm_config);
  39
  40 PVE::JSONSchema::register_standard_option('skiplock', {
  41     description => "Ignore locks - only root is allowed to use this option.",
  42     type => 'boolean',
  43     optional => 1,
  44 });
  45
  46 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  47     description => "Some command save/restore state from this location.",
  48     type => 'string',
  49     maxLength => 128,
  50     optional => 1,
  51 });
  52
  53 #no warnings 'redefine';
  54
  55 unless(defined(&_VZSYSCALLS_H_)) {
  56     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  57     require 'sys/syscall.ph';
  58     if(defined(&__x86_64__)) {
  59         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  60         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  61         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  62         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  63         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  64         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  65         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  66         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  67     }
  68     elsif(defined( &__i386__) ) {
  69         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  70         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  71         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  72         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  73         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  74         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  75         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  76         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  77     } else {
  78         die("no fairsched syscall for this arch");
  79     }
  80     require 'asm/ioctl.ph';
  81     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  82 }
  83
  84 sub fairsched_mknod {
  85     my ($parent, $weight, $desired) = @_;
  86
  87     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
  88 }
  89
  90 sub fairsched_rmnod {
  91     my ($id) = @_;
  92
  93     return syscall(&__NR_fairsched_rmnod, int($id));
  94 }
  95
  96 sub fairsched_mvpr {
  97     my ($pid, $newid) = @_;
  98
  99     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 100 }
 101
 102 sub fairsched_vcpus {
 103     my ($id, $vcpus) = @_;
 104
 105     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 106 }
 107
 108 sub fairsched_rate {
 109     my ($id, $op, $rate) = @_;
 110
 111     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 112 }
 113
 114 use constant FAIRSCHED_SET_RATE  => 0;
 115 use constant FAIRSCHED_DROP_RATE => 1;
 116 use constant FAIRSCHED_GET_RATE  => 2;
 117
 118 sub fairsched_cpulimit {
 119     my ($id, $limit) = @_;
 120
 121     my $cpulim1024 = int($limit * 1024 / 100);
 122     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 123
 124     return fairsched_rate($id, $op, $cpulim1024);
 125 }
 126
 127 my $nodename = PVE::INotify::nodename();
 128
 129 mkdir "/etc/pve/nodes/$nodename";
 130 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 131 mkdir $confdir;
 132
 133 my $var_run_tmpdir = "/var/run/qemu-server";
 134 mkdir $var_run_tmpdir;
 135
 136 my $lock_dir = "/var/lock/qemu-server";
 137 mkdir $lock_dir;
 138
 139 my $pcisysfs = "/sys/bus/pci";
 140
 141 my $keymaphash = PVE::Tools::kvmkeymaps();
 142
 143 my $confdesc = {
 144     onboot => {
 145         optional => 1,
 146         type => 'boolean',
 147         description => "Specifies whether a VM will be started during system bootup.",
 148         default => 0,
 149     },
 150     autostart => {
 151         optional => 1,
 152         type => 'boolean',
 153         description => "Automatic restart after crash (currently ignored).",
 154         default => 0,
 155     },
 156     hotplug => {
 157         optional => 1,
 158         type => 'boolean',
 159         description => "Activate hotplug for disk and network device",
 160         default => 0,
 161     },
 162     reboot => {
 163         optional => 1,
 164         type => 'boolean',
 165         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 166         default => 1,
 167     },
 168     lock => {
 169         optional => 1,
 170         type => 'string',
 171         description => "Lock/unlock the VM.",
 172         enum => [qw(migrate backup)],
 173     },
 174     cpulimit => {
 175         optional => 1,
 176         type => 'integer',
 177         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 178         minimum => 0,
 179         default => 0,
 180     },
 181     cpuunits => {
 182         optional => 1,
 183         type => 'integer',
 184         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 185         minimum => 0,
 186         maximum => 500000,
 187         default => 1000,
 188     },
 189     memory => {
 190         optional => 1,
 191         type => 'integer',
 192         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 193         minimum => 16,
 194         default => 512,
 195     },
 196     balloon => {
 197         optional => 1,
 198         type => 'integer',
 199         description => "Amount of target RAM for the VM in MB.",
 200         minimum => 16,
 201     },
 202     keyboard => {
 203         optional => 1,
 204         type => 'string',
 205         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 206         enum => [ keys %$keymaphash ],
 207         default => 'en-us',
 208     },
 209     name => {
 210         optional => 1,
 211         type => 'string',
 212         description => "Set a name for the VM. Only used on the configuration web interface.",
 213     },
 214     description => {
 215         optional => 1,
 216         type => 'string',
 217         description => "Description for the VM. Only used on the configuration web interface.",
 218     },
 219     ostype => {
 220         optional => 1,
 221         type => 'string',
 222         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26)],
 223         description => <<EODESC,
 224 Used to enable special optimization/features for specific
 225 operating systems:
 226
 227 other  => unspecified OS
 228 wxp    => Microsoft Windows XP
 229 w2k    => Microsoft Windows 2000
 230 w2k3   => Microsoft Windows 2003
 231 w2k8   => Microsoft Windows 2008
 232 wvista => Microsoft Windows Vista
 233 win7   => Microsoft Windows 7
 234 l24    => Linux 2.4 Kernel
 235 l26    => Linux 2.6/3.X Kernel
 236
 237 other|l24|l26                  ... no special behaviour
 238 wxp|w2k|w2k3|w2k8|wvista|win7  ... use --localtime switch
 239 EODESC
 240     },
 241     boot => {
 242         optional => 1,
 243         type => 'string',
 244         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 245         pattern => '[acdn]{1,4}',
 246         default => 'cdn',
 247     },
 248     bootdisk => {
 249         optional => 1,
 250         type => 'string', format => 'pve-qm-bootdisk',
 251         description => "Enable booting from specified disk.",
 252         pattern => '(ide|scsi|virtio)\d+',
 253     },
 254     smp => {
 255         optional => 1,
 256         type => 'integer',
 257         description => "The number of CPUs. Please use option -sockets instead.",
 258         minimum => 1,
 259         default => 1,
 260     },
 261     sockets => {
 262         optional => 1,
 263         type => 'integer',
 264         description => "The number of CPU sockets.",
 265         minimum => 1,
 266         default => 1,
 267     },
 268     cores => {
 269         optional => 1,
 270         type => 'integer',
 271         description => "The number of cores per socket.",
 272         minimum => 1,
 273         default => 1,
 274     },
 275     acpi => {
 276         optional => 1,
 277         type => 'boolean',
 278         description => "Enable/disable ACPI.",
 279         default => 1,
 280     },
 281     kvm => {
 282         optional => 1,
 283         type => 'boolean',
 284         description => "Enable/disable KVM hardware virtualization.",
 285         default => 1,
 286     },
 287     tdf => {
 288         optional => 1,
 289         type => 'boolean',
 290         description => "Enable/disable time drift fix.",
 291         default => 1,
 292     },
 293     localtime => {
 294         optional => 1,
 295         type => 'boolean',
 296         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 297     },
 298     freeze => {
 299         optional => 1,
 300         type => 'boolean',
 301         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 302     },
 303     vga => {
 304         optional => 1,
 305         type => 'string',
 306         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win7/w2k8, and 'cirrur' for other OS types",
 307         enum => [qw(std cirrus vmware)],
 308     },
 309     watchdog => {
 310         optional => 1,
 311         type => 'string', format => 'pve-qm-watchdog',
 312         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 313         description => "Create a virtual hardware watchdog device.  Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
 314     },
 315     startdate => {
 316         optional => 1,
 317         type => 'string',
 318         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 319         description => "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
 320         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 321         default => 'now',
 322     },
 323     args => {
 324         optional => 1,
 325         type => 'string',
 326         description => <<EODESCR,
 327 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 328
 329 args: -no-reboot -no-hpet
 330 EODESCR
 331     },
 332     tablet => {
 333         optional => 1,
 334         type => 'boolean',
 335         default => 1,
 336         description => "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
 337     },
 338     migrate_speed => {
 339         optional => 1,
 340         type => 'integer',
 341         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 342         minimum => 0,
 343         default => 0,
 344     },
 345     migrate_downtime => {
 346         optional => 1,
 347         type => 'integer',
 348         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 349         minimum => 0,
 350         default => 1,
 351     },
 352     cdrom => {
 353         optional => 1,
 354         type => 'string', format => 'pve-qm-drive',
 355         typetext => 'volume',
 356         description => "This is an alias for option -ide2",
 357     },
 358     cpu => {
 359         optional => 1,
 360         description => "Emulated CPU type.",
 361         type => 'string',
 362         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom host) ],
 363         default => 'qemu64',
 364     },
 365 };
 366
 367 # what about other qemu settings ?
 368 #cpu => 'string',
 369 #machine => 'string',
 370 #fda => 'file',
 371 #fdb => 'file',
 372 #mtdblock => 'file',
 373 #sd => 'file',
 374 #pflash => 'file',
 375 #snapshot => 'bool',
 376 #bootp => 'file',
 377 ##tftp => 'dir',
 378 ##smb => 'dir',
 379 #kernel => 'file',
 380 #append => 'string',
 381 #initrd => 'file',
 382 ##soundhw => 'string',
 383
 384 while (my ($k, $v) = each %$confdesc) {
 385     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 386 }
 387
 388 my $MAX_IDE_DISKS = 4;
 389 my $MAX_SCSI_DISKS = 14;
 390 my $MAX_VIRTIO_DISKS = 6;
 391 my $MAX_USB_DEVICES = 5;
 392 my $MAX_NETS = 6;
 393 my $MAX_UNUSED_DISKS = 8;
 394 my $MAX_HOSTPCI_DEVICES = 2;
 395 my $MAX_SERIAL_PORTS = 4;
 396 my $MAX_PARALLEL_PORTS = 3;
 397
 398 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 399                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
 400 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 401
 402 # fixme:
 403 my $netdesc = {
 404     optional => 1,
 405     type => 'string', format => 'pve-qm-net',
 406     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>]",
 407     description => <<EODESCR,
 408 Specify network devices.
 409
 410 MODEL is one of: $nic_model_list_txt
 411
 412 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 413 automatically generated if not specified.
 414
 415 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 416
 417 Option 'rate' is used to limit traffic bandwidth from and to this interface. It is specified as floating point number, unit is 'Megabytes per second'.
 418
 419 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 420
 421 10.0.2.2   Gateway
 422 10.0.2.3   DNS Server
 423 10.0.2.4   SMB Server
 424
 425 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 426
 427 EODESCR
 428 };
 429 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 430
 431 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 432     $confdesc->{"net$i"} = $netdesc;
 433 }
 434
 435 my $drivename_hash;
 436
 437 my $idedesc = {
 438     optional => 1,
 439     type => 'string', format => 'pve-qm-drive',
 440     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 441     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to 3).",
 442 };
 443 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 444
 445 my $scsidesc = {
 446     optional => 1,
 447     type => 'string', format => 'pve-qm-drive',
 448     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 449     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to 13).",
 450 };
 451 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 452
 453 my $virtiodesc = {
 454     optional => 1,
 455     type => 'string', format => 'pve-qm-drive',
 456     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]',
 457     description => "Use volume as VIRTIO hard disk (n is 0 to 5).",
 458 };
 459 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 460
 461 my $usbdesc = {
 462     optional => 1,
 463     type => 'string', format => 'pve-qm-usb-device',
 464     typetext => 'host=HOSTUSBDEVICE',
 465     description => <<EODESCR,
 466 Configure an USB device (n is 0 to 4). This can be used to
 467 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 468
 469 'bus-port(.port)*' (decimal numbers) or
 470 'vendor_id:product_id' (hexadeciaml numbers)
 471
 472 You can use the 'lsusb -t' command to list existing usb devices.
 473
 474 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 475
 476 EODESCR
 477 };
 478 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 479
 480 my $hostpcidesc = {
 481         optional => 1,
 482         type => 'string', format => 'pve-qm-hostpci',
 483         typetext => "HOSTPCIDEVICE",
 484         description => <<EODESCR,
 485 Map host pci devices. HOSTPCIDEVICE syntax is:
 486
 487 'bus:dev.func' (hexadecimal numbers)
 488
 489 You can us the 'lspci' command to list existing pci devices.
 490
 491 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 492
 493 Experimental: user reported problems with this option.
 494 EODESCR
 495 };
 496 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 497
 498 my $serialdesc = {
 499         optional => 1,
 500         type => 'string',
 501         pattern => '/dev/ttyS\d+',
 502         description =>  <<EODESCR,
 503 Map host serial devices (n is 0 to 3).
 504
 505 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 506
 507 Experimental: user reported problems with this option.
 508 EODESCR
 509 };
 510
 511 my $paralleldesc= {
 512         optional => 1,
 513         type => 'string',
 514         pattern => '/dev/parport\d+',
 515         description =>  <<EODESCR,
 516 Map host parallel devices (n is 0 to 2).
 517
 518 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 519
 520 Experimental: user reported problems with this option.
 521 EODESCR
 522 };
 523
 524 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 525     $confdesc->{"parallel$i"} = $paralleldesc;
 526 }
 527
 528 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 529     $confdesc->{"serial$i"} = $serialdesc;
 530 }
 531
 532 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 533     $confdesc->{"hostpci$i"} = $hostpcidesc;
 534 }
 535
 536 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 537     $drivename_hash->{"ide$i"} = 1;
 538     $confdesc->{"ide$i"} = $idedesc;
 539 }
 540
 541 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 542     $drivename_hash->{"scsi$i"} = 1;
 543     $confdesc->{"scsi$i"} = $scsidesc ;
 544 }
 545
 546 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 547     $drivename_hash->{"virtio$i"} = 1;
 548     $confdesc->{"virtio$i"} = $virtiodesc;
 549 }
 550
 551 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 552     $confdesc->{"usb$i"} = $usbdesc;
 553 }
 554
 555 my $unuseddesc = {
 556     optional => 1,
 557     type => 'string', format => 'pve-volume-id',
 558     description => "Reference to unused volumes.",
 559 };
 560
 561 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 562     $confdesc->{"unused$i"} = $unuseddesc;
 563 }
 564
 565 my $kvm_api_version = 0;
 566
 567 sub kvm_version {
 568
 569     return $kvm_api_version if $kvm_api_version;
 570
 571     my $fh = IO::File->new("</dev/kvm") ||
 572         return 0;
 573
 574     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 575         $kvm_api_version = $v;
 576     }
 577
 578     $fh->close();
 579
 580     return  $kvm_api_version;
 581 }
 582
 583 my $kvm_user_version;
 584
 585 sub kvm_user_version {
 586
 587     return $kvm_user_version if $kvm_user_version;
 588
 589     $kvm_user_version = 'unknown';
 590
 591     my $tmp = `kvm -help 2>/dev/null`;
 592
 593     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+\.\d+) /) {
 594         $kvm_user_version = $2;
 595     }
 596
 597     return $kvm_user_version;
 598
 599 }
 600
 601 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 602
 603 sub disknames {
 604     # order is important - used to autoselect boot disk
 605     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 606             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 607             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))));
 608 }
 609
 610 sub valid_drivename {
 611     my $dev = shift;
 612
 613     return defined($drivename_hash->{$dev});
 614 }
 615
 616 sub option_exists {
 617     my $key = shift;
 618     return defined($confdesc->{$key});
 619 }
 620
 621 sub nic_models {
 622     return $nic_model_list;
 623 }
 624
 625 sub os_list_description {
 626
 627     return {
 628         other => 'Other',
 629         wxp => 'Windows XP',
 630         w2k => 'Windows 2000',
 631         w2k3 =>, 'Windows 2003',
 632         w2k8 => 'Windows 2008',
 633         wvista => 'Windows Vista',
 634         win7 => 'Windows 7',
 635         l24 => 'Linux 2.4',
 636         l26 => 'Linux 2.6',
 637     };
 638 }
 639
 640 sub disk_devive_info {
 641     my $dev = shift;
 642
 643     die "unknown disk device format '$dev'" if $dev !~ m/^(ide|scsi|virtio)(\d+)$/;
 644
 645     my $bus = $1;
 646     my $index = $2;
 647     my $maxdev = 1024;
 648
 649     if ($bus eq 'ide') {
 650         $maxdev = 2;
 651     } elsif ($bus eq 'scsi') {
 652         $maxdev = 7;
 653     }
 654
 655     my $controller = int($index / $maxdev);
 656     my $unit = $index % $maxdev;
 657
 658
 659     return { bus => $bus, desc => uc($bus) . " $controller:$unit",
 660              controller => $controller, unit => $unit, index => $index };
 661
 662 }
 663
 664 sub qemu_drive_name {
 665     my ($dev, $media) = @_;
 666
 667     my $info = disk_devive_info($dev);
 668     my $mediastr = '';
 669
 670     if (($info->{bus} eq 'ide') || ($info->{bus} eq 'scsi')) {
 671         $mediastr = ($media eq 'cdrom') ? "-cd" : "-hd";
 672         return sprintf("%s%i%s%i", $info->{bus}, $info->{controller},
 673                        $mediastr, $info->{unit});
 674     } else {
 675         return sprintf("%s%i", $info->{bus}, $info->{index});
 676     }
 677 }
 678
 679 my $cdrom_path;
 680
 681 sub get_cdrom_path {
 682
 683     return  $cdrom_path if $cdrom_path;
 684
 685     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 686     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 687     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 688 }
 689
 690 sub get_iso_path {
 691     my ($storecfg, $vmid, $cdrom) = @_;
 692
 693     if ($cdrom eq 'cdrom') {
 694         return get_cdrom_path();
 695     } elsif ($cdrom eq 'none') {
 696         return '';
 697     } elsif ($cdrom =~ m|^/|) {
 698         return $cdrom;
 699     } else {
 700         return PVE::Storage::path($storecfg, $cdrom);
 701     }
 702 }
 703
 704 # try to convert old style file names to volume IDs
 705 sub filename_to_volume_id {
 706     my ($vmid, $file, $media) = @_;
 707
 708     if (!($file eq 'none' || $file eq 'cdrom' ||
 709           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 710
 711         return undef if $file =~ m|/|;
 712
 713         if ($media && $media eq 'cdrom') {
 714             $file = "local:iso/$file";
 715         } else {
 716             $file = "local:$vmid/$file";
 717         }
 718     }
 719
 720     return $file;
 721 }
 722
 723 sub verify_media_type {
 724     my ($opt, $vtype, $media) = @_;
 725
 726     return if !$media;
 727
 728     my $etype;
 729     if ($media eq 'disk') {
 730         $etype = 'image';
 731     } elsif ($media eq 'cdrom') {
 732         $etype = 'iso';
 733     } else {
 734         die "internal error";
 735     }
 736
 737     return if ($vtype eq $etype);
 738
 739     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 740 }
 741
 742 sub cleanup_drive_path {
 743     my ($opt, $storecfg, $drive) = @_;
 744
 745     # try to convert filesystem paths to volume IDs
 746
 747     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 748         ($drive->{file} !~ m|^/dev/.+|) &&
 749         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 750         ($drive->{file} !~ m/^\d+$/)) {
 751         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 752         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 753         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 754         verify_media_type($opt, $vtype, $drive->{media});
 755         $drive->{file} = $volid;
 756     }
 757
 758     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 759 }
 760
 761 sub create_conf_nolock {
 762     my ($vmid, $settings) = @_;
 763
 764     my $filename = config_file($vmid);
 765
 766     die "configuration file '$filename' already exists\n" if -f $filename;
 767
 768     my $defaults = load_defaults();
 769
 770     $settings->{name} = "vm$vmid" if !$settings->{name};
 771     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 772
 773     my $data = '';
 774     foreach my $opt (keys %$settings) {
 775         next if !$confdesc->{$opt};
 776
 777         my $value = $settings->{$opt};
 778         next if !$value;
 779
 780         $data .= "$opt: $value\n";
 781     }
 782
 783     PVE::Tools::file_set_contents($filename, $data);
 784 }
 785
 786 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 787 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 788 #        [,aio=native|threads]
 789
 790 sub parse_drive {
 791     my ($key, $data) = @_;
 792
 793     my $res = {};
 794
 795     # $key may be undefined - used to verify JSON parameters
 796     if (!defined($key)) {
 797         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 798         $res->{index} = 0;
 799     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 800         $res->{interface} = $1;
 801         $res->{index} = $2;
 802     } else {
 803         return undef;
 804     }
 805
 806     foreach my $p (split (/,/, $data)) {
 807         next if $p =~ m/^\s*$/;
 808
 809         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio)=(.+)$/) {
 810             my ($k, $v) = ($1, $2);
 811
 812             $k = 'file' if $k eq 'volume';
 813
 814             return undef if defined $res->{$k};
 815
 816             $res->{$k} = $v;
 817         } else {
 818             if (!$res->{file} && $p !~ m/=/) {
 819                 $res->{file} = $p;
 820             } else {
 821                 return undef;
 822             }
 823         }
 824     }
 825
 826     return undef if !$res->{file};
 827
 828     return undef if $res->{cache} &&
 829         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe)$/;
 830     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 831     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 832     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 833     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 834     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 835     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
 836     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
 837     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
 838     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
 839     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 840     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
 841
 842     if ($res->{media} && ($res->{media} eq 'cdrom')) {
 843         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
 844         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
 845         return undef if $res->{interface} eq 'virtio';
 846     }
 847
 848     # rerror does not work with scsi drives
 849     if ($res->{rerror}) {
 850         return undef if $res->{interface} eq 'scsi';
 851     }
 852
 853     return $res;
 854 }
 855
 856 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio);
 857
 858 sub print_drive {
 859     my ($vmid, $drive) = @_;
 860
 861     my $opts = '';
 862     foreach my $o (@qemu_drive_options, 'backup') {
 863         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 864     }
 865
 866     return "$drive->{file}$opts";
 867 }
 868
 869 sub print_drivedevice_full {
 870     my ($storecfg, $vmid, $drive) = @_;
 871
 872     my $device = '';
 873     my $maxdev = 0;
 874
 875     if ($drive->{interface} eq 'virtio') {
 876       my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}");
 877       $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
 878     }
 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     my $cpucount = $cpuinfo->{cpus} || 1;
1802
1803     foreach my $vmid (keys %$list) {
1804         next if $opt_vmid && ($vmid ne $opt_vmid);
1805
1806         my $cfspath = cfs_config_path($vmid);
1807         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
1808
1809         my $d = {};
1810         $d->{pid} = $list->{$vmid}->{pid};
1811
1812         # fixme: better status?
1813         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
1814
1815         my ($size, $used) = disksize($storecfg, $conf);
1816         if (defined($size) && defined($used)) {
1817             $d->{disk} = $used;
1818             $d->{maxdisk} = $size;
1819         } else {
1820             $d->{disk} = 0;
1821             $d->{maxdisk} = 0;
1822         }
1823
1824         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
1825         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
1826
1827         $d->{name} = $conf->{name} || "VM $vmid";
1828         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1829
1830         $d->{uptime} = 0;
1831         $d->{cpu} = 0;
1832         $d->{mem} = 0;
1833
1834         $d->{netout} = 0;
1835         $d->{netin} = 0;
1836
1837         $d->{diskread} = 0;
1838         $d->{diskwrite} = 0;
1839
1840         $res->{$vmid} = $d;
1841     }
1842
1843     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1844     foreach my $dev (keys %$netdev) {
1845         next if $dev !~ m/^tap([1-9]\d*)i/;
1846         my $vmid = $1;
1847         my $d = $res->{$vmid};
1848         next if !$d;
1849
1850         $d->{netout} += $netdev->{$dev}->{receive};
1851         $d->{netin} += $netdev->{$dev}->{transmit};
1852     }
1853
1854     my $ctime = gettimeofday;
1855
1856     foreach my $vmid (keys %$list) {
1857
1858         my $d = $res->{$vmid};
1859         my $pid = $d->{pid};
1860         next if !$pid;
1861
1862         if (my $fh = IO::File->new("/proc/$pid/io", "r")) {
1863             my $data = {};
1864             while (defined(my $line = <$fh>)) {
1865                 if ($line =~ m/^([rw]char):\s+(\d+)$/) {
1866                     $data->{$1} = $2;
1867                 }
1868             }
1869             close($fh);
1870             $d->{diskread} = $data->{rchar} || 0;
1871             $d->{diskwrite} = $data->{wchar} || 0;
1872         }
1873
1874         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
1875         next if !$pstat; # not running
1876
1877         my $used = $pstat->{utime} + $pstat->{stime};
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             };
1892             next;
1893         }
1894
1895         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
1896
1897         if ($dtime > 1000) {
1898             my $dutime = $used -  $old->{used};
1899
1900             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
1901             $last_proc_pid_stat->{$pid} = {
1902                 time => $ctime,
1903                 used => $used,
1904                 cpu => $d->{cpu},
1905             };
1906         } else {
1907             $d->{cpu} = $old->{cpu};
1908         }
1909     }
1910
1911     return $res;
1912 }
1913
1914 sub foreach_drive {
1915     my ($conf, $func) = @_;
1916
1917     foreach my $ds (keys %$conf) {
1918         next if !valid_drivename($ds);
1919
1920         my $drive = parse_drive($ds, $conf->{$ds});
1921         next if !$drive;
1922
1923         &$func($ds, $drive);
1924     }
1925 }
1926
1927 sub config_to_command {
1928     my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
1929
1930     my $cmd = [];
1931     my $pciaddr = '';
1932     my $kvmver = kvm_user_version();
1933     my $vernum = 0; # unknown
1934     if ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
1935         $vernum = $1*1000000+$2*1000+$3;
1936     }
1937
1938     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 14000;
1939
1940     my $have_ovz = -f '/proc/vz/vestat';
1941
1942     push @$cmd, '/usr/bin/kvm';
1943
1944     push @$cmd, '-id', $vmid;
1945
1946     my $use_virtio = 0;
1947
1948     my $socket = monitor_socket($vmid);
1949     push @$cmd, '-chardev', "socket,id=monitor,path=$socket,server,nowait";
1950     push @$cmd, '-mon', "chardev=monitor,mode=readline";
1951
1952     $socket = vnc_socket($vmid);
1953     push @$cmd,  '-vnc', "unix:$socket,x509,password";
1954
1955     push @$cmd, '-pidfile' , pidfile_name($vmid);
1956
1957     push @$cmd, '-daemonize';
1958
1959     push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
1960
1961     # include usb device config
1962     push @$cmd, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg';
1963
1964     # enable absolute mouse coordinates (needed by vnc)
1965     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
1966     push @$cmd, '-device', 'usb-tablet,bus=ehci.0,port=6' if $tablet;
1967
1968     # host pci devices
1969     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
1970           my $d = parse_hostpci($conf->{"hostpci$i"});
1971           next if !$d;
1972           $pciaddr = print_pci_addr("hostpci$i");
1973           push @$cmd, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
1974     }
1975
1976     # usb devices
1977     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
1978         my $d = parse_usb_device($conf->{"usb$i"});
1979         next if !$d;
1980         if ($d->{vendorid} && $d->{productid}) {
1981             push @$cmd, '-device', "usb-host,vendorid=$d->{vendorid},productid=$d->{productid}";
1982         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
1983             push @$cmd, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
1984         }
1985     }
1986
1987     # serial devices
1988     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
1989         if (my $path = $conf->{"serial$i"}) {
1990             die "no such serial device\n" if ! -c $path;
1991             push @$cmd, '-chardev', "tty,id=serial$i,path=$path";
1992             push @$cmd, '-device', "isa-serial,chardev=serial$i";
1993         }
1994     }
1995
1996     # parallel devices
1997     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
1998         if (my $path = $conf->{"parallel$i"}) {
1999             die "no such parallel device\n" if ! -c $path;
2000             push @$cmd, '-chardev', "parport,id=parallel$i,path=$path";
2001             push @$cmd, '-device', "isa-parallel,chardev=parallel$i";
2002         }
2003     }
2004
2005     my $vmname = $conf->{name} || "vm$vmid";
2006
2007     push @$cmd, '-name', $vmname;
2008
2009     my $sockets = 1;
2010     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2011     $sockets = $conf->{sockets} if  $conf->{sockets};
2012
2013     my $cores = $conf->{cores} || 1;
2014
2015     my $boot_opt;
2016
2017     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2018
2019     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2020
2021     push @$cmd, '-nodefaults';
2022
2023     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2024     push @$cmd, '-boot', "menu=on,order=$bootorder";
2025
2026     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2027
2028     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2029
2030     my $vga = $conf->{vga};
2031     if (!$vga) {
2032         if ($conf->{ostype} && ($conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2033             $vga = 'std';
2034         } else {
2035             $vga = 'cirrus';
2036         }
2037     }
2038
2039     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2040
2041     # time drift fix
2042     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2043     push @$cmd, '-tdf' if $tdf;
2044
2045     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2046
2047     if (my $ost = $conf->{ostype}) {
2048         # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2049
2050         if ($ost =~ m/^w/) { # windows
2051             push @$cmd, '-localtime' if !defined($conf->{localtime});
2052
2053             # use rtc-td-hack when acpi is enabled
2054             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2055                 push @$cmd, '-rtc-td-hack';
2056             }
2057         }
2058
2059         # -tdf ?
2060         # -no-acpi
2061         # -no-kvm
2062         # -win2k-hack ?
2063     }
2064
2065     if ($nokvm) {
2066         push @$cmd, '-no-kvm';
2067     } else {
2068         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2069     }
2070
2071     push @$cmd, '-localtime' if $conf->{localtime};
2072
2073     push @$cmd, '-startdate', $conf->{startdate} if $conf->{startdate};
2074
2075     push @$cmd, '-S' if $conf->{freeze};
2076
2077     # set keyboard layout
2078     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2079     push @$cmd, '-k', $kb if $kb;
2080
2081     # enable sound
2082     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2083     #push @$cmd, '-soundhw', 'es1370';
2084     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2085     $pciaddr = print_pci_addr("balloon0");
2086     push @$cmd, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2087
2088     if ($conf->{watchdog}) {
2089         my $wdopts = parse_watchdog($conf->{watchdog});
2090         $pciaddr = print_pci_addr("watchdog");
2091         my $watchdog = $wdopts->{model} || 'i6300esb';
2092         push @$cmd, '-device', "$watchdog$pciaddr";
2093         push @$cmd, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2094     }
2095
2096     my $vollist = [];
2097     my $scsicontroller = {};
2098
2099     foreach_drive($conf, sub {
2100         my ($ds, $drive) = @_;
2101
2102         eval {
2103             PVE::Storage::parse_volume_id($drive->{file});
2104             push @$vollist, $drive->{file};
2105         }; # ignore errors
2106
2107         $use_virtio = 1 if $ds =~ m/^virtio/;
2108         if ($drive->{interface} eq 'scsi') {
2109            my $maxdev = 7;
2110            my $controller = int($drive->{index} / $maxdev);
2111            $pciaddr = print_pci_addr("scsi$controller");
2112            push @$cmd, '-device', "lsi,id=scsi$controller$pciaddr" if !$scsicontroller->{$controller};
2113            $scsicontroller->{$controller}=1;
2114         }
2115         my $tmp = print_drive_full($storecfg, $vmid, $drive);
2116         $tmp .= ",boot=on" if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2117         push @$cmd, '-drive', $tmp;
2118         push @$cmd, '-device',print_drivedevice_full($storecfg,$vmid, $drive);
2119     });
2120
2121     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2122
2123     my $foundnet = 0;
2124
2125     foreach my $k (sort keys %$conf) {
2126         next if $k !~ m/^net(\d+)$/;
2127         my $i = int($1);
2128
2129         die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
2130
2131         if ($conf->{"net$i"} && (my $net = parse_net($conf->{"net$i"}))) {
2132
2133             $foundnet = 1;
2134
2135             my $ifname = "tap${vmid}i$i";
2136
2137             # kvm uses TUNSETIFF ioctl, and that limits ifname length
2138             die "interface name '$ifname' is too long (max 15 character)\n"
2139                 if length($ifname) >= 16;
2140
2141             my $device = $net->{model};
2142             my $vhostparam = '';
2143             if ($net->{model} eq 'virtio') {
2144                 $use_virtio = 1;
2145                 $device = 'virtio-net-pci';
2146                 $vhostparam = ',vhost=on' if $kernel_has_vhost_net;
2147             };
2148
2149             if ($net->{bridge}) {
2150                 push @$cmd, '-netdev', "type=tap,id=${k},ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
2151             } else {
2152                 push @$cmd, '-netdev', "type=user,id=${k},hostname=$vmname";
2153             }
2154
2155             # qemu > 0.15 always try to boot from network - we disable that by
2156             # not loading the pxe rom file
2157             my $extra = (!$conf->{boot} || ($conf->{boot} !~ m/n/)) ?
2158                 "romfile=," : '';
2159             $pciaddr = print_pci_addr("${k}");
2160             push @$cmd, '-device', "$device,${extra}mac=$net->{macaddr},netdev=${k}$pciaddr";
2161         }
2162     }
2163
2164     push @$cmd, '-net', 'none' if !$foundnet;
2165
2166     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2167     # when the VM uses virtio devices.
2168     if (!$use_virtio && $have_ovz) {
2169
2170         my $cpuunits = defined($conf->{cpuunits}) ?
2171             $conf->{cpuunits} : $defaults->{cpuunits};
2172
2173         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2174
2175         # fixme: cpulimit is currently ignored
2176         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2177     }
2178
2179     # add custom args
2180     if ($conf->{args}) {
2181         my $aa = PVE::Tools::split_args($conf->{args});
2182         push @$cmd, @$aa;
2183     }
2184
2185     return wantarray ? ($cmd, $vollist) : $cmd;
2186 }
2187
2188 sub vnc_socket {
2189     my ($vmid) = @_;
2190     return "${var_run_tmpdir}/$vmid.vnc";
2191 }
2192
2193 sub monitor_socket {
2194     my ($vmid) = @_;
2195     return "${var_run_tmpdir}/$vmid.mon";
2196 }
2197
2198 sub pidfile_name {
2199     my ($vmid) = @_;
2200     return "${var_run_tmpdir}/$vmid.pid";
2201 }
2202
2203 sub next_migrate_port {
2204
2205     for (my $p = 60000; $p < 60010; $p++) {
2206
2207         my $sock = IO::Socket::INET->new(Listen => 5,
2208                                          LocalAddr => 'localhost',
2209                                          LocalPort => $p,
2210                                          ReuseAddr => 1,
2211                                          Proto     => 0);
2212
2213         if ($sock) {
2214             close($sock);
2215             return $p;
2216         }
2217     }
2218
2219     die "unable to find free migration port";
2220 }
2221
2222 sub vm_devices_list {
2223     my ($vmid) = @_;
2224
2225     my $res = vm_monitor_command ($vmid, "info pci", 1);
2226
2227     my @lines = split ("\n", $res);
2228     my $devices;
2229     my $bus;
2230     my $addr;
2231     my $id;
2232
2233     foreach my $line (@lines) {
2234         $line =~ s/^\s+//;
2235         if ($line =~ m/^Bus  (\d+), device   (\d+), function (\d+):$/) {
2236             $bus=$1;
2237             $addr=$2;
2238         }
2239         if ($line =~ m/^id "([a-z][a-z_\-]*\d*)"$/) {
2240             $id=$1;
2241             $devices->{$id}->{bus}=$bus;
2242             $devices->{$id}->{addr}=$addr;
2243         }
2244     }
2245
2246     return $devices;
2247 }
2248
2249 sub vm_deviceadd {
2250     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2251     return if !check_running($vmid) || !$conf->{hotplug} || $conf->{$deviceid};
2252
2253     if($deviceid =~ m/^(virtio)(\d+)$/) {
2254
2255         my $drive = print_drive_full($storecfg, $vmid, $device);
2256         my $ret = vm_monitor_command($vmid, "drive_add auto $drive", 1);
2257         # If the command succeeds qemu prints: "OK"
2258         if ($ret !~ m/OK/s) {
2259            die "adding drive failed: $ret";
2260         }
2261
2262         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2263         $ret = vm_monitor_command($vmid, "device_add $devicefull", 1);
2264         $ret =~ s/^\s+//;
2265         # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2266         die 'error on hotplug device : $ret' if $ret ne "";
2267     }
2268
2269     for (my $i = 0; $i <= 5; $i++) {
2270         my $devices_list = vm_devices_list($vmid);
2271         return if defined($devices_list->{$deviceid});
2272         sleep 1;
2273     }
2274
2275     die "error on hotplug device $deviceid";
2276 }
2277
2278 sub vm_devicedel {
2279     my ($vmid, $conf, $deviceid) = @_;
2280
2281     return if !check_running ($vmid) || !$conf->{hotplug};
2282
2283     die "can't unplug bootdisk" if $conf->{bootdisk} eq $deviceid;
2284
2285     if($deviceid =~ m/^(virtio)(\d+)$/){
2286
2287         my $ret = vm_monitor_command($vmid, "drive_del drive-$deviceid", 1);
2288         $ret =~ s/^\s+//;
2289         if ($ret =~ m/Device \'.*?\' not found/s) {
2290             # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2291         }
2292         elsif ($ret ne "") {
2293             die "deleting drive $deviceid failed : $ret";
2294         }
2295
2296         $ret = vm_monitor_command($vmid, "device_del $deviceid", 1);
2297         $ret =~ s/^\s+//;
2298         die 'detaching device $deviceid failed : $ret' if $ret ne "";
2299
2300     }
2301
2302     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2303     for (my $i = 0; $i <= 5; $i++) {
2304         my $devices_list = vm_devices_list($vmid);
2305         return if !defined($devices_list->{$deviceid});
2306         sleep 1;
2307     }
2308     die "error on hot-plugging device $deviceid";
2309
2310
2311 }
2312
2313 sub vm_start {
2314     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2315
2316     lock_config($vmid, sub {
2317         my $conf = load_config($vmid);
2318
2319         check_lock($conf) if !$skiplock;
2320
2321         if (check_running($vmid)) {
2322             my $msg = "VM $vmid already running - start failed\n" ;
2323             syslog('err', $msg);
2324             die $msg;
2325         } else {
2326             syslog('info', "VM $vmid start");
2327         }
2328
2329         my $migrate_uri;
2330         my $migrate_port = 0;
2331
2332         if ($statefile) {
2333             if ($statefile eq 'tcp') {
2334                 $migrate_port = next_migrate_port();
2335                 $migrate_uri = "tcp:localhost:${migrate_port}";
2336             } else {
2337                 if (-f $statefile) {
2338                     $migrate_uri = "exec:cat $statefile";
2339                 } else {
2340                     warn "state file '$statefile' does not exist - doing normal startup\n";
2341                 }
2342             }
2343         }
2344
2345         my $defaults = load_defaults();
2346
2347         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2348         # host pci devices
2349         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2350           my $d = parse_hostpci($conf->{"hostpci$i"});
2351           next if !$d;
2352           my $info = pci_device_info("0000:$d->{pciid}");
2353           die "IOMMU not present\n" if !check_iommu_support();
2354           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2355           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2356           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2357         }
2358
2359         PVE::Storage::activate_volumes($storecfg, $vollist);
2360
2361         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2362
2363         my $err = $@;
2364
2365         if ($err) {
2366             my $msg = "start failed: $err";
2367             syslog('err', "VM $vmid $msg");
2368             die $msg;
2369         }
2370
2371         if ($statefile) {
2372
2373             if ($statefile eq 'tcp') {
2374                 print "migration listens on port $migrate_port\n";
2375             } else {
2376                 unlink $statefile;
2377                 # fixme: send resume - is that necessary ?
2378                 eval  { vm_monitor_command($vmid, "cont", 1) };
2379             }
2380         }
2381
2382         # always set migrate speed (overwrite kvm default of 32m)
2383         # we set a very hight default of 8192m which is basically unlimited
2384         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2385         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2386         eval {
2387             my $cmd = "migrate_set_speed ${migrate_speed}m";
2388             vm_monitor_command($vmid, $cmd, 1);
2389         };
2390
2391         if (my $migrate_downtime =
2392             $conf->{migrate_downtime} || $defaults->{migrate_downtime}) {
2393             my $cmd = "migrate_set_downtime ${migrate_downtime}";
2394             eval { vm_monitor_command($vmid, $cmd, 1); };
2395         }
2396
2397         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2398     });
2399 }
2400
2401 sub __read_avail {
2402     my ($fh, $timeout) = @_;
2403
2404     my $sel = new IO::Select;
2405     $sel->add($fh);
2406
2407     my $res = '';
2408     my $buf;
2409
2410     my @ready;
2411     while (scalar (@ready = $sel->can_read($timeout))) {
2412         my $count;
2413         if ($count = $fh->sysread($buf, 8192)) {
2414             if ($buf =~ /^(.*)\(qemu\) $/s) {
2415                 $res .= $1;
2416                 last;
2417             } else {
2418                 $res .= $buf;
2419             }
2420         } else {
2421             if (!defined($count)) {
2422                 die "$!\n";
2423             }
2424             last;
2425         }
2426     }
2427
2428     die "monitor read timeout\n" if !scalar(@ready);
2429
2430     return $res;
2431 }
2432
2433 sub vm_monitor_command {
2434     my ($vmid, $cmdstr, $nolog, $nocheck) = @_;
2435
2436     my $res;
2437
2438     syslog("info", "VM $vmid monitor command '$cmdstr'") if !$nolog;
2439
2440     eval {
2441         die "VM not running\n" if !check_running($vmid, $nocheck);
2442
2443         my $sname = monitor_socket($vmid);
2444
2445         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2446             die "unable to connect to VM $vmid socket - $!\n";
2447
2448         my $timeout = 3;
2449
2450         # hack: migrate sometime blocks the monitor (when migrate_downtime
2451         # is set)
2452         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2453             $timeout = 60*60; # 1 hour
2454         }
2455
2456         # read banner;
2457         my $data = __read_avail($sock, $timeout);
2458
2459         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2460             die "got unexpected qemu monitor banner\n";
2461         }
2462
2463         my $sel = new IO::Select;
2464         $sel->add($sock);
2465
2466         if (!scalar(my @ready = $sel->can_write($timeout))) {
2467             die "monitor write error - timeout";
2468         }
2469
2470         my $fullcmd = "$cmdstr\r";
2471
2472         my $b;
2473         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2474             die "monitor write error - $!";
2475         }
2476
2477         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2478
2479         $timeout = 20;
2480
2481         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2482             $timeout = 60*60; # 1 hour
2483         } elsif ($cmdstr =~ m/^(eject|change)/) {
2484             $timeout = 60; # note: cdrom mount command is slow
2485         }
2486         if ($res = __read_avail($sock, $timeout)) {
2487
2488             my @lines = split("\r?\n", $res);
2489
2490             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2491
2492             $res = join("\n", @lines);
2493             $res .= "\n";
2494         }
2495     };
2496
2497     my $err = $@;
2498
2499     if ($err) {
2500         syslog("err", "VM $vmid monitor command failed - $err");
2501         die $err;
2502     }
2503
2504     return $res;
2505 }
2506
2507 sub vm_commandline {
2508     my ($storecfg, $vmid) = @_;
2509
2510     my $conf = load_config($vmid);
2511
2512     my $defaults = load_defaults();
2513
2514     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2515
2516     return join(' ', @$cmd);
2517 }
2518
2519 sub vm_reset {
2520     my ($vmid, $skiplock) = @_;
2521
2522     lock_config($vmid, sub {
2523
2524         my $conf = load_config($vmid);
2525
2526         check_lock($conf) if !$skiplock;
2527
2528         syslog("info", "VM $vmid sending 'reset'");
2529
2530         vm_monitor_command($vmid, "system_reset", 1);
2531     });
2532 }
2533
2534 sub vm_shutdown {
2535     my ($vmid, $skiplock) = @_;
2536
2537     lock_config($vmid, sub {
2538
2539         my $conf = load_config($vmid);
2540
2541         check_lock($conf) if !$skiplock;
2542
2543         syslog("info", "VM $vmid sending 'shutdown'");
2544
2545         vm_monitor_command($vmid, "system_powerdown", 1);
2546     });
2547 }
2548
2549 # Note: use $nockeck to skip tests if VM configuration file exists.
2550 # We need that when migration VMs to other nodes (files already moved)
2551 sub vm_stop {
2552     my ($vmid, $skiplock, $nocheck) = @_;
2553
2554     lock_config($vmid, sub {
2555
2556         my $pid = check_running($vmid, $nocheck);
2557
2558         if (!$pid) {
2559             syslog('info', "VM $vmid already stopped");
2560             return;
2561         }
2562
2563         if (!$nocheck) {
2564             my $conf = load_config($vmid);
2565             check_lock($conf) if !$skiplock;
2566         }
2567
2568         syslog("info", "VM $vmid stopping");
2569
2570         eval { vm_monitor_command($vmid, "quit", 1, $nocheck); };
2571
2572         my $err = $@;
2573
2574         if (!$err) {
2575             # wait some time
2576             my $timeout = 50; # fixme: how long?
2577
2578             my $count = 0;
2579             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2580                 $count++;
2581                 sleep 1;
2582             }
2583
2584             if ($count >= $timeout) {
2585                 syslog('info', "VM $vmid still running - terminating now with SIGTERM");
2586                 kill 15, $pid;
2587             }
2588         } else {
2589             syslog('info', "VM $vmid quit failed - terminating now with SIGTERM");
2590             kill 15, $pid;
2591         }
2592
2593         # wait again
2594         my $timeout = 10;
2595
2596         my $count = 0;
2597         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2598             $count++;
2599             sleep 1;
2600         }
2601
2602         if ($count >= $timeout) {
2603             syslog('info', "VM $vmid still running - terminating now with SIGKILL\n");
2604             kill 9, $pid;
2605         }
2606
2607         fairsched_rmnod($vmid); # try to destroy group
2608     });
2609 }
2610
2611 sub vm_suspend {
2612     my ($vmid, $skiplock) = @_;
2613
2614     lock_config($vmid, sub {
2615
2616         my $conf = load_config($vmid);
2617
2618         check_lock($conf) if !$skiplock;
2619
2620         syslog("info", "VM $vmid suspend");
2621
2622         vm_monitor_command($vmid, "stop", 1);
2623     });
2624 }
2625
2626 sub vm_resume {
2627     my ($vmid, $skiplock) = @_;
2628
2629     lock_config($vmid, sub {
2630
2631         my $conf = load_config($vmid);
2632
2633         check_lock($conf) if !$skiplock;
2634
2635         syslog("info", "VM $vmid resume");
2636
2637         vm_monitor_command($vmid, "cont", 1);
2638     });
2639 }
2640
2641 sub vm_sendkey {
2642     my ($vmid, $skiplock, $key) = @_;
2643
2644     lock_config($vmid, sub {
2645
2646         my $conf = load_config($vmid);
2647
2648         check_lock($conf) if !$skiplock;
2649
2650         syslog("info", "VM $vmid sending key $key");
2651
2652         vm_monitor_command($vmid, "sendkey $key", 1);
2653     });
2654 }
2655
2656 sub vm_destroy {
2657     my ($storecfg, $vmid, $skiplock) = @_;
2658
2659     lock_config($vmid, sub {
2660
2661         my $conf = load_config($vmid);
2662
2663         check_lock($conf) if !$skiplock;
2664
2665         syslog("info", "VM $vmid destroy called (removing all data)");
2666
2667         eval {
2668             if (!check_running($vmid)) {
2669                 fairsched_rmnod($vmid); # try to destroy group
2670                 destroy_vm($storecfg, $vmid);
2671             } else {
2672                 die "VM is running\n";
2673             }
2674         };
2675
2676         my $err = $@;
2677
2678         if ($err) {
2679             syslog("err", "VM $vmid destroy failed - $err");
2680             die $err;
2681         }
2682     });
2683 }
2684
2685 sub vm_stopall {
2686     my ($timeout) = @_;
2687
2688     $timeout = 3*60 if !$timeout;
2689
2690     my $vzlist = vzlist();
2691     my $count = 0;
2692     foreach my $vmid (keys %$vzlist) {
2693         next if !$vzlist->{$vmid}->{pid};
2694         $count++;
2695     }
2696
2697     if ($count) {
2698
2699         my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs\n";
2700         syslog('info', $msg);
2701         print STDERR $msg;
2702
2703         foreach my $vmid (keys %$vzlist) {
2704             next if !$vzlist->{$vmid}->{pid};
2705             eval { vm_shutdown($vmid, 1); };
2706             print STDERR $@ if $@;
2707         }
2708
2709         my $wt = 5;
2710         my $maxtries = int(($timeout + $wt -1)/$wt);
2711         my $try = 0;
2712         while (($try < $maxtries) && $count) {
2713             $try++;
2714             sleep $wt;
2715
2716             $vzlist = vzlist();
2717             $count = 0;
2718             foreach my $vmid (keys %$vzlist) {
2719                 next if !$vzlist->{$vmid}->{pid};
2720                 $count++;
2721             }
2722             last if !$count;
2723         }
2724
2725         return if !$count;
2726
2727         foreach my $vmid (keys %$vzlist) {
2728             next if !$vzlist->{$vmid}->{pid};
2729
2730             $msg = "VM $vmid still running - sending stop now\n";
2731             syslog('info', $msg);
2732             print $msg;
2733
2734             eval { vm_monitor_command($vmid, "quit", 1); };
2735             print STDERR $@ if $@;
2736
2737         }
2738
2739         $timeout = 30;
2740         $maxtries = int(($timeout + $wt -1)/$wt);
2741         $try = 0;
2742         while (($try < $maxtries) && $count) {
2743             $try++;
2744             sleep $wt;
2745
2746             $vzlist = vzlist();
2747             $count = 0;
2748             foreach my $vmid (keys %$vzlist) {
2749                 next if !$vzlist->{$vmid}->{pid};
2750                 $count++;
2751             }
2752             last if !$count;
2753         }
2754
2755         return if !$count;
2756
2757         foreach my $vmid (keys %$vzlist) {
2758             next if !$vzlist->{$vmid}->{pid};
2759
2760             $msg = "VM $vmid still running - terminating now with SIGTERM\n";
2761             syslog('info', $msg);
2762             print $msg;
2763             kill 15, $vzlist->{$vmid}->{pid};
2764         }
2765
2766         # this is called by system shotdown scripts, so remaining
2767         # processes gets killed anyways (no need to send kill -9 here)
2768
2769         $msg = "Qemu Server stopped\n";
2770         syslog('info', $msg);
2771         print STDERR $msg;
2772     }
2773 }
2774
2775 # pci helpers
2776
2777 sub file_write {
2778     my ($filename, $buf) = @_;
2779
2780     my $fh = IO::File->new($filename, "w");
2781     return undef if !$fh;
2782
2783     my $res = print $fh $buf;
2784
2785     $fh->close();
2786
2787     return $res;
2788 }
2789
2790 sub pci_device_info {
2791     my ($name) = @_;
2792
2793     my $res;
2794
2795     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
2796     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
2797
2798     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
2799     return undef if !defined($irq) || $irq !~ m/^\d+$/;
2800
2801     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
2802     return undef if !defined($vendor) || $vendor !~ s/^0x//;
2803
2804     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
2805     return undef if !defined($product) || $product !~ s/^0x//;
2806
2807     $res = {
2808         name => $name,
2809         vendor => $vendor,
2810         product => $product,
2811         domain => $domain,
2812         bus => $bus,
2813         slot => $slot,
2814         func => $func,
2815         irq => $irq,
2816         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
2817     };
2818
2819     return $res;
2820 }
2821
2822 sub pci_dev_reset {
2823     my ($dev) = @_;
2824
2825     my $name = $dev->{name};
2826
2827     my $fn = "$pcisysfs/devices/$name/reset";
2828
2829     return file_write($fn, "1");
2830 }
2831
2832 sub pci_dev_bind_to_stub {
2833     my ($dev) = @_;
2834
2835     my $name = $dev->{name};
2836
2837     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
2838     return 1 if -d $testdir;
2839
2840     my $data = "$dev->{vendor} $dev->{product}";
2841     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
2842
2843     my $fn = "$pcisysfs/devices/$name/driver/unbind";
2844     if (!file_write($fn, $name)) {
2845         return undef if -f $fn;
2846     }
2847
2848     $fn = "$pcisysfs/drivers/pci-stub/bind";
2849     if (! -d $testdir) {
2850         return undef if !file_write($fn, $name);
2851     }
2852
2853     return -d $testdir;
2854 }
2855
2856 sub print_pci_addr {
2857     my ($id) = @_;
2858
2859     my $res = '';
2860     my $devices = {
2861         #addr1 : ide,parallel,serial (motherboard)
2862         #addr2 : first videocard
2863         balloon0 => { bus => 0, addr => 3 },
2864         watchdog => { bus => 0, addr => 4 },
2865         scsi0 => { bus => 0, addr => 5 },
2866         scsi1 => { bus => 0, addr => 6 },
2867         virtio0 => { bus => 0, addr => 10 },
2868         virtio1 => { bus => 0, addr => 11 },
2869         virtio2 => { bus => 0, addr => 12 },
2870         virtio3 => { bus => 0, addr => 13 },
2871         virtio4 => { bus => 0, addr => 14 },
2872         virtio5 => { bus => 0, addr => 15 },
2873         hostpci0 => { bus => 0, addr => 16 },
2874         hostpci1 => { bus => 0, addr => 17 },
2875         net0 => { bus => 0, addr => 18 },
2876         net1 => { bus => 0, addr => 19 },
2877         net2 => { bus => 0, addr => 20 },
2878         net3 => { bus => 0, addr => 21 },
2879         net4 => { bus => 0, addr => 22 },
2880         net5 => { bus => 0, addr => 23 },
2881         #addr29 : usb-host (pve-usb.cfg)
2882     };
2883
2884     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
2885            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
2886            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
2887     }
2888     return $res;
2889
2890 }
2891
2892 sub vm_balloonset {
2893     my ($vmid, $value) = @_;
2894
2895     vm_monitor_command($vmid, "balloon $value", 1);
2896 }
2897
2898 # vzdump restore implementaion
2899
2900 sub archive_read_firstfile {
2901     my $archive = shift;
2902
2903     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
2904
2905     # try to detect archive type first
2906     my $pid = open (TMP, "tar tf '$archive'|") ||
2907         die "unable to open file '$archive'\n";
2908     my $firstfile = <TMP>;
2909     kill 15, $pid;
2910     close TMP;
2911
2912     die "ERROR: archive contaions no data\n" if !$firstfile;
2913     chomp $firstfile;
2914
2915     return $firstfile;
2916 }
2917
2918 sub restore_cleanup {
2919     my $statfile = shift;
2920
2921     print STDERR "starting cleanup\n";
2922
2923     if (my $fd = IO::File->new($statfile, "r")) {
2924         while (defined(my $line = <$fd>)) {
2925             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
2926                 my $volid = $2;
2927                 eval {
2928                     if ($volid =~ m|^/|) {
2929                         unlink $volid || die 'unlink failed\n';
2930                     } else {
2931                         my $cfg = cfs_read_file('storage.cfg');
2932                         PVE::Storage::vdisk_free($cfg, $volid);
2933                     }
2934                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
2935                 };
2936                 print STDERR "unable to cleanup '$volid' - $@" if $@;
2937             } else {
2938                 print STDERR "unable to parse line in statfile - $line";
2939             }
2940         }
2941         $fd->close();
2942     }
2943 }
2944
2945 sub restore_archive {
2946     my ($archive, $vmid, $opts) = @_;
2947
2948     if ($archive ne '-') {
2949         my $firstfile = archive_read_firstfile($archive);
2950         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
2951             if $firstfile ne 'qemu-server.conf';
2952     }
2953
2954     my $tocmd = "/usr/lib/qemu-server/qmextract";
2955
2956     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
2957     $tocmd .= ' --prealloc' if $opts->{prealloc};
2958     $tocmd .= ' --info' if $opts->{info};
2959
2960     # tar option "xf" does not autodetect compression when read fron STDIN,
2961     # so we pipe to zcat
2962     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
2963         PVE::Tools::shellquote("--to-command=$tocmd");
2964
2965     my $tmpdir = "/var/tmp/vzdumptmp$$";
2966     mkpath $tmpdir;
2967
2968     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
2969     local $ENV{VZDUMP_VMID} = $vmid;
2970
2971     my $conffile = PVE::QemuServer::config_file($vmid);
2972     my $tmpfn = "$conffile.$$.tmp";
2973
2974     # disable interrupts (always do cleanups)
2975     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
2976         print STDERR "got interrupt - ignored\n";
2977     };
2978
2979     eval {
2980         # enable interrupts
2981         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
2982             die "interrupted by signal\n";
2983         };
2984
2985         if ($archive eq '-') {
2986             print "extracting archive from STDIN\n";
2987             run_command($cmd, input => "<&STDIN");
2988         } else {
2989             print "extracting archive '$archive'\n";
2990             run_command($cmd);
2991         }
2992
2993         return if $opts->{info};
2994
2995         # read new mapping
2996         my $map = {};
2997         my $statfile = "$tmpdir/qmrestore.stat";
2998         if (my $fd = IO::File->new($statfile, "r")) {
2999             while (defined (my $line = <$fd>)) {
3000                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3001                     $map->{$1} = $2 if $1;
3002                 } else {
3003                     print STDERR "unable to parse line in statfile - $line\n";
3004                 }
3005             }
3006             $fd->close();
3007         }
3008
3009         my $confsrc = "$tmpdir/qemu-server.conf";
3010
3011         my $srcfd = new IO::File($confsrc, "r") ||
3012             die "unable to open file '$confsrc'\n";
3013
3014         my $outfd = new IO::File ($tmpfn, "w") ||
3015             die "unable to write config for VM $vmid\n";
3016
3017         my $netcount = 0;
3018
3019         while (defined (my $line = <$srcfd>)) {
3020             next if $line =~ m/^\#vzdump\#/;
3021             next if $line =~ m/^lock:/;
3022             next if $line =~ m/^unused\d+:/;
3023
3024             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3025                 # try to convert old 1.X settings
3026                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3027                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3028                     my ($model, $macaddr) = split(/\=/, $devconfig);
3029                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3030                     my $net = {
3031                         model => $model,
3032                         bridge => "vmbr$ind",
3033                         macaddr => $macaddr,
3034                     };
3035                     my $netstr = print_net($net);
3036                     print $outfd "net${netcount}: $netstr\n";
3037                     $netcount++;
3038                 }
3039             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3040                 my ($id, $netstr) = ($1, $2);
3041                 my $net = parse_net($netstr);
3042                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3043                 $netstr = print_net($net);
3044                 print $outfd "$id: $netstr\n";
3045             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3046                 my $virtdev = $1;
3047                 my $value = $2;
3048                 if ($line =~ m/backup=no/) {
3049                     print $outfd "#$line";
3050                 } elsif ($virtdev && $map->{$virtdev}) {
3051                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3052                     $di->{file} = $map->{$virtdev};
3053                     $value = PVE::QemuServer::print_drive($vmid, $di);
3054                     print $outfd "$virtdev: $value\n";
3055                 } else {
3056                     print $outfd $line;
3057                 }
3058             } else {
3059                 print $outfd $line;
3060             }
3061         }
3062
3063         $srcfd->close();
3064         $outfd->close();
3065     };
3066     my $err = $@;
3067
3068     if ($err) {
3069
3070         unlink $tmpfn;
3071
3072         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3073
3074         die $err;
3075     }
3076
3077     rmtree $tmpdir;
3078
3079     rename $tmpfn, $conffile ||
3080         die "unable to commit configuration file '$conffile'\n";
3081 };
3082
3083 1;