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