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. This is saved as comment inside the configuration file.",
 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     my $descr = '';
1439
1440     while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
1441         my $line = $1;
1442
1443         next if $line =~ m/^\s*$/;
1444
1445         if ($line =~ m/^\#(.*)\s*$/) {
1446             $descr .= PVE::Tools::decode_text($1) . "\n";
1447             next;
1448         }
1449
1450         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1451             $descr .= PVE::Tools::decode_text($2);
1452         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1453             my $key = $1;
1454             my $value = $2;
1455             $res->{$key} = $value;
1456         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1457             my $key = $1;
1458             my $value = $2;
1459             eval { $value = check_type($key, $value); };
1460             if ($@) {
1461                 warn "vm $vmid - unable to parse value of '$key' - $@";
1462             } else {
1463                 my $fmt = $confdesc->{$key}->{format};
1464                 if ($fmt && $fmt eq 'pve-qm-drive') {
1465                     my $v = parse_drive($key, $value);
1466                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1467                         $v->{file} = $volid;
1468                         $value = print_drive($vmid, $v);
1469                     } else {
1470                         warn "vm $vmid - unable to parse value of '$key'\n";
1471                         next;
1472                     }
1473                 }
1474
1475                 if ($key eq 'cdrom') {
1476                     $res->{ide2} = $value;
1477                 } else {
1478                     $res->{$key} = $value;
1479                 }
1480             }
1481         }
1482     }
1483
1484     $res->{description} = $descr if $descr;
1485
1486     # convert old smp to sockets
1487     if ($res->{smp} && !$res->{sockets}) {
1488         $res->{sockets} = $res->{smp};
1489     }
1490     delete $res->{smp};
1491
1492     return $res;
1493 }
1494
1495 sub write_vm_config {
1496     my ($filename, $conf) = @_;
1497
1498     if ($conf->{cdrom}) {
1499         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1500         $conf->{ide2} = $conf->{cdrom};
1501         delete $conf->{cdrom};
1502     }
1503
1504     # we do not use 'smp' any longer
1505     if ($conf->{sockets}) {
1506         delete $conf->{smp};
1507     } elsif ($conf->{smp}) {
1508         $conf->{sockets} = $conf->{smp};
1509         delete $conf->{cores};
1510         delete $conf->{smp};
1511     }
1512
1513     my $new_volids = {};
1514     foreach my $key (keys %$conf) {
1515         next if $key eq 'digest' || $key eq 'description';
1516         my $value = $conf->{$key};
1517         eval { $value = check_type($key, $value); };
1518         die "unable to parse value of '$key' - $@" if $@;
1519
1520         $conf->{$key} = $value;
1521
1522         if (valid_drivename($key)) {
1523             my $drive = PVE::QemuServer::parse_drive($key, $value);
1524             $new_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1525         }
1526     }
1527
1528     # remove 'unusedX' settings if we re-add a volume
1529     foreach my $key (keys %$conf) {
1530         my $value = $conf->{$key};
1531         if ($key =~ m/^unused/ && $new_volids->{$value}) {
1532             delete $conf->{$key};
1533         }
1534     }
1535
1536     # gererate RAW data
1537     my $raw = '';
1538
1539     # add description as comment to top of file
1540     my $descr = $conf->{description} || '';
1541     foreach my $cl (split(/\n/, $descr)) {
1542         $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1543     }
1544
1545     foreach my $key (sort keys %$conf) {
1546         next if $key eq 'digest' || $key eq 'description';
1547         $raw .= "$key: $conf->{$key}\n";
1548     }
1549
1550     return $raw;
1551 }
1552
1553 sub update_config_nolock {
1554     my ($vmid, $conf, $skiplock) = @_;
1555
1556     check_lock($conf) if !$skiplock;
1557
1558     my $cfspath = cfs_config_path($vmid);
1559
1560     PVE::Cluster::cfs_write_file($cfspath, $conf);
1561 }
1562
1563 sub update_config {
1564     my ($vmid, $conf, $skiplock) = @_;
1565
1566     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1567 }
1568
1569 sub load_defaults {
1570
1571     my $res = {};
1572
1573     # we use static defaults from our JSON schema configuration
1574     foreach my $key (keys %$confdesc) {
1575         if (defined(my $default = $confdesc->{$key}->{default})) {
1576             $res->{$key} = $default;
1577         }
1578     }
1579
1580     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1581     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1582
1583     return $res;
1584 }
1585
1586 sub config_list {
1587     my $vmlist = PVE::Cluster::get_vmlist();
1588     my $res = {};
1589     return $res if !$vmlist || !$vmlist->{ids};
1590     my $ids = $vmlist->{ids};
1591
1592     foreach my $vmid (keys %$ids) {
1593         my $d = $ids->{$vmid};
1594         next if !$d->{node} || $d->{node} ne $nodename;
1595         next if !$d->{type} || $d->{type} ne 'qemu';
1596         $res->{$vmid}->{exists} = 1;
1597     }
1598     return $res;
1599 }
1600
1601 # test if VM uses local resources (to prevent migration)
1602 sub check_local_resources {
1603     my ($conf, $noerr) = @_;
1604
1605     my $loc_res = 0;
1606
1607     $loc_res = 1 if $conf->{hostusb}; # old syntax
1608     $loc_res = 1 if $conf->{hostpci}; # old syntax
1609
1610     foreach my $k (keys %$conf) {
1611         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1612     }
1613
1614     die "VM uses local resources\n" if $loc_res && !$noerr;
1615
1616     return $loc_res;
1617 }
1618
1619 sub check_lock {
1620     my ($conf) = @_;
1621
1622     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1623 }
1624
1625 sub check_cmdline {
1626     my ($pidfile, $pid) = @_;
1627
1628     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1629     if (defined($fh)) {
1630         my $line = <$fh>;
1631         $fh->close;
1632         return undef if !$line;
1633         my @param = split(/\0/, $line);
1634
1635         my $cmd = $param[0];
1636         return if !$cmd || ($cmd !~ m|kvm$|);
1637
1638         for (my $i = 0; $i < scalar (@param); $i++) {
1639             my $p = $param[$i];
1640             next if !$p;
1641             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1642                 my $p = $param[$i+1];
1643                 return 1 if $p && ($p eq $pidfile);
1644                 return undef;
1645             }
1646         }
1647     }
1648     return undef;
1649 }
1650
1651 sub check_running {
1652     my ($vmid, $nocheck) = @_;
1653
1654     my $filename = config_file($vmid);
1655
1656     die "unable to find configuration file for VM $vmid - no such machine\n"
1657         if !$nocheck && ! -f $filename;
1658
1659     my $pidfile = pidfile_name($vmid);
1660
1661     if (my $fd = IO::File->new("<$pidfile")) {
1662         my $st = stat($fd);
1663         my $line = <$fd>;
1664         close($fd);
1665
1666         my $mtime = $st->mtime;
1667         if ($mtime > time()) {
1668             warn "file '$filename' modified in future\n";
1669         }
1670
1671         if ($line =~ m/^(\d+)$/) {
1672             my $pid = $1;
1673             if (check_cmdline($pidfile, $pid)) {
1674                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1675                     return $pid;
1676                 }
1677             }
1678         }
1679     }
1680
1681     return undef;
1682 }
1683
1684 sub vzlist {
1685
1686     my $vzlist = config_list();
1687
1688     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1689
1690     while (defined(my $de = $fd->read)) {
1691         next if $de !~ m/^(\d+)\.pid$/;
1692         my $vmid = $1;
1693         next if !defined($vzlist->{$vmid});
1694         if (my $pid = check_running($vmid)) {
1695             $vzlist->{$vmid}->{pid} = $pid;
1696         }
1697     }
1698
1699     return $vzlist;
1700 }
1701
1702 my $storage_timeout_hash = {};
1703
1704 sub disksize {
1705     my ($storecfg, $conf) = @_;
1706
1707     my $bootdisk = $conf->{bootdisk};
1708     return undef if !$bootdisk;
1709     return undef if !valid_drivename($bootdisk);
1710
1711     return undef if !$conf->{$bootdisk};
1712
1713     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1714     return undef if !defined($drive);
1715
1716     return undef if drive_is_cdrom($drive);
1717
1718     my $volid = $drive->{file};
1719     return undef if !$volid;
1720
1721     my $path;
1722     my $storeid;
1723     my $timeoutid;
1724
1725     if ($volid =~ m|^/|) {
1726         $path = $timeoutid = $volid;
1727     } else {
1728         eval {
1729             $storeid = $timeoutid = PVE::Storage::parse_volume_id($volid);
1730             $path = PVE::Storage::path($storecfg, $volid);
1731         };
1732         if (my $err = $@) {
1733             warn $err;
1734             return undef;
1735         }
1736     }
1737
1738     my $last_timeout = $storage_timeout_hash->{$timeoutid};
1739     if ($last_timeout) {
1740         if ((time() - $last_timeout) < 30) {
1741             # skip storage with errors
1742             return undef ;
1743         }
1744         delete $storage_timeout_hash->{$timeoutid};
1745     }
1746
1747     my ($size, $format, $used);
1748
1749     ($size, $format, $used) = PVE::Storage::file_size_info($path, 1);
1750
1751     if (!defined($format)) {
1752         # got timeout
1753         $storage_timeout_hash->{$timeoutid} = time();
1754         return undef;
1755     }
1756
1757     return wantarray ? ($size, $used) : $size;
1758 }
1759
1760 my $last_proc_pid_stat;
1761
1762 sub vmstatus {
1763     my ($opt_vmid) = @_;
1764
1765     my $res = {};
1766
1767     my $storecfg = PVE::Storage::config();
1768
1769     my $list = vzlist();
1770     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
1771
1772     my $cpucount = $cpuinfo->{cpus} || 1;
1773
1774     foreach my $vmid (keys %$list) {
1775         next if $opt_vmid && ($vmid ne $opt_vmid);
1776
1777         my $cfspath = cfs_config_path($vmid);
1778         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
1779
1780         my $d = {};
1781         $d->{pid} = $list->{$vmid}->{pid};
1782
1783         # fixme: better status?
1784         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
1785
1786         my ($size, $used) = disksize($storecfg, $conf);
1787         if (defined($size) && defined($used)) {
1788             $d->{disk} = $used;
1789             $d->{maxdisk} = $size;
1790         } else {
1791             $d->{disk} = 0;
1792             $d->{maxdisk} = 0;
1793         }
1794
1795         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
1796         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
1797
1798         $d->{name} = $conf->{name} || "VM $vmid";
1799         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1800
1801         $d->{uptime} = 0;
1802         $d->{cpu} = 0;
1803         $d->{mem} = 0;
1804
1805         $d->{netout} = 0;
1806         $d->{netin} = 0;
1807
1808         $d->{diskread} = 0;
1809         $d->{diskwrite} = 0;
1810
1811         $res->{$vmid} = $d;
1812     }
1813
1814     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1815     foreach my $dev (keys %$netdev) {
1816         next if $dev !~ m/^tap([1-9]\d*)i/;
1817         my $vmid = $1;
1818         my $d = $res->{$vmid};
1819         next if !$d;
1820
1821         $d->{netout} += $netdev->{$dev}->{receive};
1822         $d->{netin} += $netdev->{$dev}->{transmit};
1823     }
1824
1825     my $ctime = gettimeofday;
1826
1827     foreach my $vmid (keys %$list) {
1828
1829         my $d = $res->{$vmid};
1830         my $pid = $d->{pid};
1831         next if !$pid;
1832
1833         if (my $fh = IO::File->new("/proc/$pid/io", "r")) {
1834             my $data = {};
1835             while (defined(my $line = <$fh>)) {
1836                 if ($line =~ m/^([rw]char):\s+(\d+)$/) {
1837                     $data->{$1} = $2;
1838                 }
1839             }
1840             close($fh);
1841             $d->{diskread} = $data->{rchar} || 0;
1842             $d->{diskwrite} = $data->{wchar} || 0;
1843         }
1844
1845         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
1846         next if !$pstat; # not running
1847
1848         my $used = $pstat->{utime} + $pstat->{stime};
1849
1850         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
1851
1852         if ($pstat->{vsize}) {
1853             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
1854         }
1855
1856         my $old = $last_proc_pid_stat->{$pid};
1857         if (!$old) {
1858             $last_proc_pid_stat->{$pid} = {
1859                 time => $ctime,
1860                 used => $used,
1861                 cpu => 0,
1862             };
1863             next;
1864         }
1865
1866         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
1867
1868         if ($dtime > 1000) {
1869             my $dutime = $used -  $old->{used};
1870
1871             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
1872             $last_proc_pid_stat->{$pid} = {
1873                 time => $ctime,
1874                 used => $used,
1875                 cpu => $d->{cpu},
1876             };
1877         } else {
1878             $d->{cpu} = $old->{cpu};
1879         }
1880     }
1881
1882     return $res;
1883 }
1884
1885 sub foreach_drive {
1886     my ($conf, $func) = @_;
1887
1888     foreach my $ds (keys %$conf) {
1889         next if !valid_drivename($ds);
1890
1891         my $drive = parse_drive($ds, $conf->{$ds});
1892         next if !$drive;
1893
1894         &$func($ds, $drive);
1895     }
1896 }
1897
1898 sub config_to_command {
1899     my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
1900
1901     my $cmd = [];
1902     my $pciaddr = '';
1903     my $kvmver = kvm_user_version();
1904     my $vernum = 0; # unknown
1905     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
1906         $vernum = $1*1000000+$2*1000;
1907     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
1908         $vernum = $1*1000000+$2*1000+$3;
1909     }
1910
1911     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
1912
1913     my $have_ovz = -f '/proc/vz/vestat';
1914
1915     push @$cmd, '/usr/bin/kvm';
1916
1917     push @$cmd, '-id', $vmid;
1918
1919     my $use_virtio = 0;
1920
1921     my $socket = monitor_socket($vmid);
1922     push @$cmd, '-chardev', "socket,id=monitor,path=$socket,server,nowait";
1923     push @$cmd, '-mon', "chardev=monitor,mode=readline";
1924
1925     $socket = vnc_socket($vmid);
1926     push @$cmd,  '-vnc', "unix:$socket,x509,password";
1927
1928     push @$cmd, '-pidfile' , pidfile_name($vmid);
1929
1930     push @$cmd, '-daemonize';
1931
1932     push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
1933
1934     my $use_usb2 = 0;
1935     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
1936         next if !$conf->{"usb$i"};
1937         $use_usb2 = 1;
1938     }
1939     # include usb device config
1940     push @$cmd, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
1941
1942     # enable absolute mouse coordinates (needed by vnc)
1943     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
1944     if ($tablet) {
1945         if ($use_usb2) {
1946             push @$cmd, '-device', 'usb-tablet,bus=ehci.0,port=6';
1947         } else {
1948             push @$cmd, '-usbdevice', 'tablet';
1949         }
1950     }
1951
1952     # host pci devices
1953     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
1954           my $d = parse_hostpci($conf->{"hostpci$i"});
1955           next if !$d;
1956           $pciaddr = print_pci_addr("hostpci$i");
1957           push @$cmd, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
1958     }
1959
1960     # usb devices
1961     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
1962         my $d = parse_usb_device($conf->{"usb$i"});
1963         next if !$d;
1964         if ($d->{vendorid} && $d->{productid}) {
1965             push @$cmd, '-device', "usb-host,vendorid=$d->{vendorid},productid=$d->{productid}";
1966         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
1967             push @$cmd, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
1968         }
1969     }
1970
1971     # serial devices
1972     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
1973         if (my $path = $conf->{"serial$i"}) {
1974             die "no such serial device\n" if ! -c $path;
1975             push @$cmd, '-chardev', "tty,id=serial$i,path=$path";
1976             push @$cmd, '-device', "isa-serial,chardev=serial$i";
1977         }
1978     }
1979
1980     # parallel devices
1981     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
1982         if (my $path = $conf->{"parallel$i"}) {
1983             die "no such parallel device\n" if ! -c $path;
1984             push @$cmd, '-chardev', "parport,id=parallel$i,path=$path";
1985             push @$cmd, '-device', "isa-parallel,chardev=parallel$i";
1986         }
1987     }
1988
1989     my $vmname = $conf->{name} || "vm$vmid";
1990
1991     push @$cmd, '-name', $vmname;
1992
1993     my $sockets = 1;
1994     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
1995     $sockets = $conf->{sockets} if  $conf->{sockets};
1996
1997     my $cores = $conf->{cores} || 1;
1998
1999     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2000
2001     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2002
2003     push @$cmd, '-nodefaults';
2004
2005     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2006
2007     my $bootindex_hash = {};
2008     my $i = 1;
2009     foreach my $o (split(//, $bootorder)) {
2010         $bootindex_hash->{$o} = $i*100;
2011         $i++;
2012     }
2013
2014     push @$cmd, '-boot', "menu=on";
2015
2016     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2017
2018     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2019
2020     my $vga = $conf->{vga};
2021     if (!$vga) {
2022         if ($conf->{ostype} && ($conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2023             $vga = 'std';
2024         } else {
2025             $vga = 'cirrus';
2026         }
2027     }
2028
2029     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2030
2031     # time drift fix
2032     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2033     # ignore - no longer supported by newer kvm
2034     # push @$cmd, '-tdf' if $tdf;
2035
2036     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2037
2038     if (my $ost = $conf->{ostype}) {
2039         # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2040
2041         if ($ost =~ m/^w/) { # windows
2042             push @$cmd, '-localtime' if !defined($conf->{localtime});
2043
2044             # use rtc-td-hack when acpi is enabled
2045             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2046                 push @$cmd, '-rtc-td-hack';
2047             }
2048         }
2049
2050         # -tdf ?
2051         # -no-acpi
2052         # -no-kvm
2053         # -win2k-hack ?
2054     }
2055
2056     if ($nokvm) {
2057         push @$cmd, '-no-kvm';
2058     } else {
2059         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2060     }
2061
2062     push @$cmd, '-localtime' if $conf->{localtime};
2063
2064     push @$cmd, '-startdate', $conf->{startdate} if $conf->{startdate};
2065
2066     push @$cmd, '-S' if $conf->{freeze};
2067
2068     # set keyboard layout
2069     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2070     push @$cmd, '-k', $kb if $kb;
2071
2072     # enable sound
2073     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2074     #push @$cmd, '-soundhw', 'es1370';
2075     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2076     $pciaddr = print_pci_addr("balloon0");
2077     push @$cmd, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2078
2079     if ($conf->{watchdog}) {
2080         my $wdopts = parse_watchdog($conf->{watchdog});
2081         $pciaddr = print_pci_addr("watchdog");
2082         my $watchdog = $wdopts->{model} || 'i6300esb';
2083         push @$cmd, '-device', "$watchdog$pciaddr";
2084         push @$cmd, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2085     }
2086
2087     my $vollist = [];
2088     my $scsicontroller = {};
2089     my $ahcicontroller = {};
2090
2091     foreach_drive($conf, sub {
2092         my ($ds, $drive) = @_;
2093
2094         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2095             push @$vollist, $drive->{file};
2096         }
2097
2098         $use_virtio = 1 if $ds =~ m/^virtio/;
2099
2100         if (drive_is_cdrom ($drive)) {
2101             if ($bootindex_hash->{d}) {
2102                 $drive->{bootindex} = $bootindex_hash->{d};
2103                 $bootindex_hash->{d} += 1;
2104             }
2105         } else {
2106             if ($bootindex_hash->{c}) {
2107                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2108                 $bootindex_hash->{c} += 1;
2109             }
2110         }
2111
2112         if ($drive->{interface} eq 'scsi') {
2113            my $maxdev = 7;
2114            my $controller = int($drive->{index} / $maxdev);
2115            $pciaddr = print_pci_addr("lsi$controller");
2116            push @$cmd, '-device', "lsi,id=lsi$controller$pciaddr" if !$scsicontroller->{$controller};
2117            $scsicontroller->{$controller}=1;
2118         }
2119
2120         if ($drive->{interface} eq 'sata') {
2121            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2122            $pciaddr = print_pci_addr("ahci$controller");
2123            push @$cmd, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2124            $ahcicontroller->{$controller}=1;
2125         }
2126
2127         push @$cmd, '-drive',print_drive_full($storecfg, $vmid, $drive);
2128         push @$cmd, '-device',print_drivedevice_full($storecfg,$vmid, $drive);
2129     });
2130
2131     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2132
2133     for (my $i = 0; $i < $MAX_NETS; $i++) {
2134          next if !$conf->{"net$i"};
2135          my $d = parse_net($conf->{"net$i"});
2136          next if !$d;
2137
2138          $use_virtio = 1 if $d->{model} eq 'virtio';
2139
2140          if ($bootindex_hash->{n}) {
2141             $d->{bootindex} = $bootindex_hash->{n};
2142             $bootindex_hash->{n} += 1;
2143          }
2144
2145          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2146          push @$cmd, '-netdev', $netdevfull;
2147
2148          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i");
2149          push @$cmd, '-device', $netdevicefull;
2150     }
2151
2152
2153     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2154     # when the VM uses virtio devices.
2155     if (!$use_virtio && $have_ovz) {
2156
2157         my $cpuunits = defined($conf->{cpuunits}) ?
2158             $conf->{cpuunits} : $defaults->{cpuunits};
2159
2160         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2161
2162         # fixme: cpulimit is currently ignored
2163         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2164     }
2165
2166     # add custom args
2167     if ($conf->{args}) {
2168         my $aa = PVE::Tools::split_args($conf->{args});
2169         push @$cmd, @$aa;
2170     }
2171
2172     return wantarray ? ($cmd, $vollist) : $cmd;
2173 }
2174
2175 sub vnc_socket {
2176     my ($vmid) = @_;
2177     return "${var_run_tmpdir}/$vmid.vnc";
2178 }
2179
2180 sub monitor_socket {
2181     my ($vmid) = @_;
2182     return "${var_run_tmpdir}/$vmid.mon";
2183 }
2184
2185 sub pidfile_name {
2186     my ($vmid) = @_;
2187     return "${var_run_tmpdir}/$vmid.pid";
2188 }
2189
2190 sub next_migrate_port {
2191
2192     for (my $p = 60000; $p < 60010; $p++) {
2193
2194         my $sock = IO::Socket::INET->new(Listen => 5,
2195                                          LocalAddr => 'localhost',
2196                                          LocalPort => $p,
2197                                          ReuseAddr => 1,
2198                                          Proto     => 0);
2199
2200         if ($sock) {
2201             close($sock);
2202             return $p;
2203         }
2204     }
2205
2206     die "unable to find free migration port";
2207 }
2208
2209 sub vm_devices_list {
2210     my ($vmid) = @_;
2211
2212     my $res = vm_monitor_command ($vmid, "info pci");
2213
2214     my @lines = split ("\n", $res);
2215     my $devices;
2216     my $bus;
2217     my $addr;
2218     my $id;
2219
2220     foreach my $line (@lines) {
2221         $line =~ s/^\s+//;
2222         if ($line =~ m/^Bus  (\d+), device   (\d+), function (\d+):$/) {
2223             $bus=$1;
2224             $addr=$2;
2225         }
2226         if ($line =~ m/^id "([a-z][a-z_\-]*\d*)"$/) {
2227             $id=$1;
2228             $devices->{$id}->{bus}=$bus;
2229             $devices->{$id}->{addr}=$addr;
2230         }
2231     }
2232
2233     return $devices;
2234 }
2235
2236 sub vm_deviceplug {
2237     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2238
2239     return 1 if !check_running($vmid) || !$conf->{hotplug};
2240
2241     my $devices_list = vm_devices_list($vmid);
2242     return 1 if defined($devices_list->{$deviceid});
2243
2244     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2245         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2246         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2247         qemu_deviceadd($vmid, $devicefull);
2248         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2249            qemu_drivedel($vmid, $deviceid);
2250            return undef;
2251         }
2252     }
2253
2254     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2255         my $pciaddr = print_pci_addr($deviceid);
2256         my $devicefull = "lsi,id=$deviceid$pciaddr";
2257         qemu_deviceadd($vmid, $devicefull);
2258         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2259     }
2260
2261     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2262         return undef if !qemu_findorcreatelsi($storecfg,$conf, $vmid, $device);
2263         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2264         my $devicefull = print_drivedevice_full($storecfg, $vmid, $device);
2265         if(!qemu_deviceadd($vmid, $devicefull)) {
2266            qemu_drivedel($vmid, $deviceid);
2267            return undef;
2268         }
2269     }
2270
2271     if ($deviceid =~ m/^(net)(\d+)$/) {
2272         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2273         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2274         qemu_deviceadd($vmid, $netdevicefull);
2275         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2276            qemu_netdevdel($vmid, $deviceid);
2277            return undef;
2278         }
2279     }
2280
2281     return 1;
2282 }
2283
2284 sub vm_deviceunplug {
2285     my ($vmid, $conf, $deviceid) = @_;
2286
2287     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2288
2289     my $devices_list = vm_devices_list($vmid);
2290     return 1 if !defined($devices_list->{$deviceid});
2291
2292     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2293
2294     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2295         return undef if !qemu_drivedel($vmid, $deviceid);
2296         qemu_devicedel($vmid, $deviceid);
2297         return undef if !qemu_devicedelverify($vmid, $deviceid);
2298     }
2299
2300     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2301         return undef if !qemu_devicedel($vmid, $deviceid);
2302     }
2303
2304     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2305         return undef if !qemu_devicedel($vmid, $deviceid);
2306         return undef if !qemu_drivedel($vmid, $deviceid);
2307     }
2308
2309     if ($deviceid =~ m/^(net)(\d+)$/) {
2310         return undef if !qemu_netdevdel($vmid, $deviceid);
2311         qemu_devicedel($vmid, $deviceid);
2312         return undef if !qemu_devicedelverify($vmid, $deviceid);
2313     }
2314
2315     return 1;
2316 }
2317
2318 sub qemu_deviceadd {
2319     my ($vmid, $devicefull) = @_;
2320
2321     my $ret = vm_monitor_command($vmid, "device_add $devicefull");
2322     $ret =~ s/^\s+//;
2323     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2324     return 1 if $ret eq "";
2325     syslog("err", "error on hotplug device : $ret");
2326     return undef;
2327
2328 }
2329
2330 sub qemu_devicedel {
2331     my($vmid, $deviceid) = @_;
2332
2333     my $ret = vm_monitor_command($vmid, "device_del $deviceid");
2334     $ret =~ s/^\s+//;
2335     return 1 if $ret eq "";
2336     syslog("err", "detaching device $deviceid failed : $ret");
2337     return undef;
2338 }
2339
2340 sub qemu_driveadd {
2341     my($storecfg, $vmid, $device) = @_;
2342
2343     my $drive = print_drive_full($storecfg, $vmid, $device);
2344     my $ret = vm_monitor_command($vmid, "drive_add auto $drive");
2345     # If the command succeeds qemu prints: "OK"
2346     if ($ret !~ m/OK/s) {
2347         syslog("err", "adding drive failed: $ret");
2348         return undef;
2349     }
2350     return 1;
2351 }
2352
2353 sub qemu_drivedel {
2354     my($vmid, $deviceid) = @_;
2355
2356     my $ret = vm_monitor_command($vmid, "drive_del drive-$deviceid");
2357     $ret =~ s/^\s+//;
2358     if ($ret =~ m/Device \'.*?\' not found/s) {
2359         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2360     }
2361     elsif ($ret ne "") {
2362       syslog("err", "deleting drive $deviceid failed : $ret");
2363       return undef;
2364     }
2365     return 1;
2366 }
2367
2368 sub qemu_deviceaddverify {
2369     my ($vmid,$deviceid) = @_;
2370
2371     for (my $i = 0; $i <= 5; $i++) {
2372          my $devices_list = vm_devices_list($vmid);
2373          return 1 if defined($devices_list->{$deviceid});
2374          sleep 1;
2375     }
2376     syslog("err", "error on hotplug device $deviceid");
2377     return undef;
2378 }
2379
2380
2381 sub qemu_devicedelverify {
2382     my ($vmid,$deviceid) = @_;
2383
2384     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2385     for (my $i = 0; $i <= 5; $i++) {
2386          my $devices_list = vm_devices_list($vmid);
2387          return 1 if !defined($devices_list->{$deviceid});
2388          sleep 1;
2389     }
2390     syslog("err", "error on hot-unplugging device $deviceid");
2391     return undef;
2392 }
2393
2394 sub qemu_findorcreatelsi {
2395     my ($storecfg, $conf, $vmid, $device) = @_;
2396
2397     my $maxdev = 7;
2398     my $controller = int($device->{index} / $maxdev);
2399     my $lsiid="lsi$controller";
2400     my $devices_list = vm_devices_list($vmid);
2401
2402     if(!defined($devices_list->{$lsiid})) {
2403        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $lsiid);
2404     }
2405     return 1;
2406 }
2407
2408 sub qemu_netdevadd {
2409     my ($vmid, $conf, $device, $deviceid) = @_;
2410
2411     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2412     my $ret = vm_monitor_command($vmid, "netdev_add $netdev");
2413     $ret =~ s/^\s+//;
2414
2415     #if the command succeeds, no output is sent. So any non-empty string shows an error
2416     return 1 if $ret eq "";
2417     syslog("err", "adding netdev failed: $ret");
2418     return undef;
2419 }
2420
2421 sub qemu_netdevdel {
2422     my ($vmid, $deviceid) = @_;
2423
2424     my $ret = vm_monitor_command($vmid, "netdev_del $deviceid");
2425     $ret =~ s/^\s+//;
2426     #if the command succeeds, no output is sent. So any non-empty string shows an error
2427     return 1 if $ret eq "";
2428     syslog("err", "deleting netdev failed: $ret");
2429     return undef;
2430 }
2431
2432 sub vm_start {
2433     my ($storecfg, $vmid, $statefile, $skiplock) = @_;
2434
2435     lock_config($vmid, sub {
2436         my $conf = load_config($vmid);
2437
2438         check_lock($conf) if !$skiplock;
2439
2440         die "VM $vmid already running\n" if check_running($vmid);
2441
2442         my $migrate_uri;
2443         my $migrate_port = 0;
2444
2445         if ($statefile) {
2446             if ($statefile eq 'tcp') {
2447                 $migrate_port = next_migrate_port();
2448                 $migrate_uri = "tcp:localhost:${migrate_port}";
2449             } else {
2450                 if (-f $statefile) {
2451                     $migrate_uri = "exec:cat $statefile";
2452                 } else {
2453                     warn "state file '$statefile' does not exist - doing normal startup\n";
2454                 }
2455             }
2456         }
2457
2458         my $defaults = load_defaults();
2459
2460         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2461         # host pci devices
2462         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2463           my $d = parse_hostpci($conf->{"hostpci$i"});
2464           next if !$d;
2465           my $info = pci_device_info("0000:$d->{pciid}");
2466           die "IOMMU not present\n" if !check_iommu_support();
2467           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2468           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2469           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2470         }
2471
2472         PVE::Storage::activate_volumes($storecfg, $vollist);
2473
2474         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2475         my $err = $@;
2476         die "start failed: $err" if $err;
2477
2478         if ($statefile) {
2479
2480             if ($statefile eq 'tcp') {
2481                 print "migration listens on port $migrate_port\n";
2482             } else {
2483                 unlink $statefile;
2484                 # fixme: send resume - is that necessary ?
2485                 eval { vm_monitor_command($vmid, "cont"); };
2486             }
2487         }
2488
2489         # always set migrate speed (overwrite kvm default of 32m)
2490         # we set a very hight default of 8192m which is basically unlimited
2491         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2492         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2493         eval {
2494             my $cmd = "migrate_set_speed ${migrate_speed}m";
2495             vm_monitor_command($vmid, $cmd);
2496         };
2497
2498         if (my $migrate_downtime =
2499             $conf->{migrate_downtime} || $defaults->{migrate_downtime}) {
2500             my $cmd = "migrate_set_downtime ${migrate_downtime}";
2501             eval { vm_monitor_command($vmid, $cmd); };
2502         }
2503
2504         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2505
2506     });
2507 }
2508
2509 sub __read_avail {
2510     my ($fh, $timeout) = @_;
2511
2512     my $sel = new IO::Select;
2513     $sel->add($fh);
2514
2515     my $res = '';
2516     my $buf;
2517
2518     my @ready;
2519     while (scalar (@ready = $sel->can_read($timeout))) {
2520         my $count;
2521         if ($count = $fh->sysread($buf, 8192)) {
2522             if ($buf =~ /^(.*)\(qemu\) $/s) {
2523                 $res .= $1;
2524                 last;
2525             } else {
2526                 $res .= $buf;
2527             }
2528         } else {
2529             if (!defined($count)) {
2530                 die "$!\n";
2531             }
2532             last;
2533         }
2534     }
2535
2536     die "monitor read timeout\n" if !scalar(@ready);
2537
2538     return $res;
2539 }
2540
2541 sub vm_monitor_command {
2542     my ($vmid, $cmdstr, $nocheck) = @_;
2543
2544     my $res;
2545
2546     eval {
2547         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2548
2549         my $sname = monitor_socket($vmid);
2550
2551         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2552             die "unable to connect to VM $vmid socket - $!\n";
2553
2554         my $timeout = 3;
2555
2556         # hack: migrate sometime blocks the monitor (when migrate_downtime
2557         # is set)
2558         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2559             $timeout = 60*60; # 1 hour
2560         }
2561
2562         # read banner;
2563         my $data = __read_avail($sock, $timeout);
2564
2565         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2566             die "got unexpected qemu monitor banner\n";
2567         }
2568
2569         my $sel = new IO::Select;
2570         $sel->add($sock);
2571
2572         if (!scalar(my @ready = $sel->can_write($timeout))) {
2573             die "monitor write error - timeout";
2574         }
2575
2576         my $fullcmd = "$cmdstr\r";
2577
2578         # syslog('info', "VM $vmid monitor command: $cmdstr");
2579
2580         my $b;
2581         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2582             die "monitor write error - $!";
2583         }
2584
2585         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2586
2587         $timeout = 20;
2588
2589         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2590             $timeout = 60*60; # 1 hour
2591         } elsif ($cmdstr =~ m/^(eject|change)/) {
2592             $timeout = 60; # note: cdrom mount command is slow
2593         }
2594         if ($res = __read_avail($sock, $timeout)) {
2595
2596             my @lines = split("\r?\n", $res);
2597
2598             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2599
2600             $res = join("\n", @lines);
2601             $res .= "\n";
2602         }
2603     };
2604
2605     my $err = $@;
2606
2607     if ($err) {
2608         syslog("err", "VM $vmid monitor command failed - $err");
2609         die $err;
2610     }
2611
2612     return $res;
2613 }
2614
2615 sub vm_commandline {
2616     my ($storecfg, $vmid) = @_;
2617
2618     my $conf = load_config($vmid);
2619
2620     my $defaults = load_defaults();
2621
2622     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2623
2624     return join(' ', @$cmd);
2625 }
2626
2627 sub vm_reset {
2628     my ($vmid, $skiplock) = @_;
2629
2630     lock_config($vmid, sub {
2631
2632         my $conf = load_config($vmid);
2633
2634         check_lock($conf) if !$skiplock;
2635
2636         vm_monitor_command($vmid, "system_reset");
2637     });
2638 }
2639
2640 sub get_vm_volumes {
2641     my ($conf) = @_;
2642
2643     my $vollist = [];
2644     foreach_drive($conf, sub {
2645         my ($ds, $drive) = @_;
2646
2647         my ($sid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
2648         return if !$sid;
2649
2650         my $volid = $drive->{file};
2651         return if !$volid || $volid =~ m|^/|;
2652
2653         push @$vollist, $volid;
2654     });
2655
2656     return $vollist;
2657 }
2658
2659 sub vm_stop_cleanup {
2660     my ($storecfg, $vmid, $conf, $keepActive) = @_;
2661
2662     eval {
2663         fairsched_rmnod($vmid); # try to destroy group
2664
2665         if (!$keepActive) {
2666             my $vollist = get_vm_volumes($conf);
2667             PVE::Storage::deactivate_volumes($storecfg, $vollist);
2668         }
2669     };
2670     warn $@ if $@; # avoid errors - just warn
2671 }
2672
2673 # Note: use $nockeck to skip tests if VM configuration file exists.
2674 # We need that when migration VMs to other nodes (files already moved)
2675 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
2676 sub vm_stop {
2677     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
2678
2679     $timeout = 60 if !defined($timeout);
2680
2681     $force = 1 if !defined($force) && !$shutdown;
2682
2683     lock_config($vmid, sub {
2684
2685         my $pid = check_running($vmid, $nocheck);
2686         return if !$pid;
2687
2688         my $conf;
2689         if (!$nocheck) {
2690             $conf = load_config($vmid);
2691             check_lock($conf) if !$skiplock;
2692         }
2693
2694         eval {
2695             if ($shutdown) {
2696                 vm_monitor_command($vmid, "system_powerdown", $nocheck);
2697             } else {
2698                 vm_monitor_command($vmid, "quit", $nocheck);
2699             }
2700         };
2701         my $err = $@;
2702
2703         if (!$err) {
2704             my $count = 0;
2705             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2706                 $count++;
2707                 sleep 1;
2708             }
2709
2710             if ($count >= $timeout) {
2711                 if ($force) {
2712                     warn "VM still running - terminating now with SIGTERM\n";
2713                     kill 15, $pid;
2714                 } else {
2715                     die "VM quit/powerdown failed - got timeout\n";
2716                 }
2717             } else {
2718                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2719                 return;
2720             }
2721         } else {
2722             if ($force) {
2723                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
2724                 kill 15, $pid;
2725             } else {
2726                 die "VM quit/powerdown failed\n";
2727             }
2728         }
2729
2730         # wait again
2731         $timeout = 10;
2732
2733         my $count = 0;
2734         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2735             $count++;
2736             sleep 1;
2737         }
2738
2739         if ($count >= $timeout) {
2740             warn "VM still running - terminating now with SIGKILL\n";
2741             kill 9, $pid;
2742             sleep 1;
2743         }
2744
2745         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2746    });
2747 }
2748
2749 sub vm_suspend {
2750     my ($vmid, $skiplock) = @_;
2751
2752     lock_config($vmid, sub {
2753
2754         my $conf = load_config($vmid);
2755
2756         check_lock($conf) if !$skiplock;
2757
2758         vm_monitor_command($vmid, "stop");
2759     });
2760 }
2761
2762 sub vm_resume {
2763     my ($vmid, $skiplock) = @_;
2764
2765     lock_config($vmid, sub {
2766
2767         my $conf = load_config($vmid);
2768
2769         check_lock($conf) if !$skiplock;
2770
2771         vm_monitor_command($vmid, "cont");
2772     });
2773 }
2774
2775 sub vm_sendkey {
2776     my ($vmid, $skiplock, $key) = @_;
2777
2778     lock_config($vmid, sub {
2779
2780         my $conf = load_config($vmid);
2781
2782         vm_monitor_command($vmid, "sendkey $key");
2783     });
2784 }
2785
2786 sub vm_destroy {
2787     my ($storecfg, $vmid, $skiplock) = @_;
2788
2789     lock_config($vmid, sub {
2790
2791         my $conf = load_config($vmid);
2792
2793         check_lock($conf) if !$skiplock;
2794
2795         if (!check_running($vmid)) {
2796             fairsched_rmnod($vmid); # try to destroy group
2797             destroy_vm($storecfg, $vmid);
2798         } else {
2799             die "VM $vmid is running - destroy failed\n";
2800         }
2801     });
2802 }
2803
2804 sub vm_stopall {
2805     my ($storecfg, $timeout) = @_;
2806
2807     $timeout = 3*60 if !$timeout;
2808
2809     my $cleanuphash = {};
2810
2811     my $vzlist = vzlist();
2812     my $count = 0;
2813     foreach my $vmid (keys %$vzlist) {
2814         next if !$vzlist->{$vmid}->{pid};
2815         $count++;
2816         $cleanuphash->{$vmid} = 1;
2817     }
2818
2819     return if !$count;
2820
2821     my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs\n";
2822     syslog('info', $msg);
2823     warn $msg;
2824
2825     foreach my $vmid (keys %$vzlist) {
2826         next if !$vzlist->{$vmid}->{pid};
2827         eval { vm_monitor_command($vmid, "system_powerdown"); };
2828         warn $@ if $@;
2829     }
2830
2831     my $wt = 5;
2832     my $maxtries = int(($timeout + $wt -1)/$wt);
2833     my $try = 0;
2834     while (($try < $maxtries) && $count) {
2835         $try++;
2836         sleep $wt;
2837
2838         $vzlist = vzlist();
2839         $count = 0;
2840         foreach my $vmid (keys %$vzlist) {
2841             next if !$vzlist->{$vmid}->{pid};
2842             $count++;
2843         }
2844         last if !$count;
2845     }
2846
2847     if ($count) {
2848
2849         foreach my $vmid (keys %$vzlist) {
2850             next if !$vzlist->{$vmid}->{pid};
2851
2852             warn "VM $vmid still running - sending stop now\n";
2853             eval { vm_monitor_command($vmid, "quit"); };
2854             warn $@ if $@;
2855         }
2856
2857         $timeout = 30;
2858         $maxtries = int(($timeout + $wt -1)/$wt);
2859         $try = 0;
2860         while (($try < $maxtries) && $count) {
2861             $try++;
2862             sleep $wt;
2863
2864             $vzlist = vzlist();
2865             $count = 0;
2866             foreach my $vmid (keys %$vzlist) {
2867                 next if !$vzlist->{$vmid}->{pid};
2868                 $count++;
2869             }
2870             last if !$count;
2871         }
2872
2873         if ($count) {
2874
2875             foreach my $vmid (keys %$vzlist) {
2876                 next if !$vzlist->{$vmid}->{pid};
2877
2878                 warn "VM $vmid still running - terminating now with SIGTERM\n";
2879                 kill 15, $vzlist->{$vmid}->{pid};
2880             }
2881             sleep 1;
2882         }
2883
2884         # this is called by system shotdown scripts, so remaining
2885         # processes gets killed anyways (no need to send kill -9 here)
2886     }
2887
2888     $vzlist = vzlist();
2889     foreach my $vmid (keys %$cleanuphash) {
2890         next if $vzlist->{$vmid}->{pid};
2891         eval {
2892             my $conf = load_config($vmid);
2893             vm_stop_cleanup($storecfg, $vmid, $conf);
2894         };
2895         warn $@ if $@;
2896     }
2897
2898     $msg = "Qemu Server stopped\n";
2899     syslog('info', $msg);
2900     print $msg;
2901 }
2902
2903 # pci helpers
2904
2905 sub file_write {
2906     my ($filename, $buf) = @_;
2907
2908     my $fh = IO::File->new($filename, "w");
2909     return undef if !$fh;
2910
2911     my $res = print $fh $buf;
2912
2913     $fh->close();
2914
2915     return $res;
2916 }
2917
2918 sub pci_device_info {
2919     my ($name) = @_;
2920
2921     my $res;
2922
2923     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
2924     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
2925
2926     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
2927     return undef if !defined($irq) || $irq !~ m/^\d+$/;
2928
2929     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
2930     return undef if !defined($vendor) || $vendor !~ s/^0x//;
2931
2932     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
2933     return undef if !defined($product) || $product !~ s/^0x//;
2934
2935     $res = {
2936         name => $name,
2937         vendor => $vendor,
2938         product => $product,
2939         domain => $domain,
2940         bus => $bus,
2941         slot => $slot,
2942         func => $func,
2943         irq => $irq,
2944         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
2945     };
2946
2947     return $res;
2948 }
2949
2950 sub pci_dev_reset {
2951     my ($dev) = @_;
2952
2953     my $name = $dev->{name};
2954
2955     my $fn = "$pcisysfs/devices/$name/reset";
2956
2957     return file_write($fn, "1");
2958 }
2959
2960 sub pci_dev_bind_to_stub {
2961     my ($dev) = @_;
2962
2963     my $name = $dev->{name};
2964
2965     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
2966     return 1 if -d $testdir;
2967
2968     my $data = "$dev->{vendor} $dev->{product}";
2969     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
2970
2971     my $fn = "$pcisysfs/devices/$name/driver/unbind";
2972     if (!file_write($fn, $name)) {
2973         return undef if -f $fn;
2974     }
2975
2976     $fn = "$pcisysfs/drivers/pci-stub/bind";
2977     if (! -d $testdir) {
2978         return undef if !file_write($fn, $name);
2979     }
2980
2981     return -d $testdir;
2982 }
2983
2984 sub print_pci_addr {
2985     my ($id) = @_;
2986
2987     my $res = '';
2988     my $devices = {
2989         #addr1 : ide,parallel,serial (motherboard)
2990         #addr2 : first videocard
2991         balloon0 => { bus => 0, addr => 3 },
2992         watchdog => { bus => 0, addr => 4 },
2993         lsi0 => { bus => 0, addr => 5 },
2994         lsi1 => { bus => 0, addr => 6 },
2995         ahci0 => { bus => 0, addr => 7 },
2996         virtio0 => { bus => 0, addr => 10 },
2997         virtio1 => { bus => 0, addr => 11 },
2998         virtio2 => { bus => 0, addr => 12 },
2999         virtio3 => { bus => 0, addr => 13 },
3000         virtio4 => { bus => 0, addr => 14 },
3001         virtio5 => { bus => 0, addr => 15 },
3002         hostpci0 => { bus => 0, addr => 16 },
3003         hostpci1 => { bus => 0, addr => 17 },
3004         net0 => { bus => 0, addr => 18 },
3005         net1 => { bus => 0, addr => 19 },
3006         net2 => { bus => 0, addr => 20 },
3007         net3 => { bus => 0, addr => 21 },
3008         net4 => { bus => 0, addr => 22 },
3009         net5 => { bus => 0, addr => 23 },
3010         #addr29 : usb-host (pve-usb.cfg)
3011     };
3012
3013     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3014            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3015            $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
3016     }
3017     return $res;
3018
3019 }
3020
3021 sub vm_balloonset {
3022     my ($vmid, $value) = @_;
3023
3024     vm_monitor_command($vmid, "balloon $value");
3025 }
3026
3027 # vzdump restore implementaion
3028
3029 sub archive_read_firstfile {
3030     my $archive = shift;
3031
3032     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3033
3034     # try to detect archive type first
3035     my $pid = open (TMP, "tar tf '$archive'|") ||
3036         die "unable to open file '$archive'\n";
3037     my $firstfile = <TMP>;
3038     kill 15, $pid;
3039     close TMP;
3040
3041     die "ERROR: archive contaions no data\n" if !$firstfile;
3042     chomp $firstfile;
3043
3044     return $firstfile;
3045 }
3046
3047 sub restore_cleanup {
3048     my $statfile = shift;
3049
3050     print STDERR "starting cleanup\n";
3051
3052     if (my $fd = IO::File->new($statfile, "r")) {
3053         while (defined(my $line = <$fd>)) {
3054             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3055                 my $volid = $2;
3056                 eval {
3057                     if ($volid =~ m|^/|) {
3058                         unlink $volid || die 'unlink failed\n';
3059                     } else {
3060                         my $cfg = cfs_read_file('storage.cfg');
3061                         PVE::Storage::vdisk_free($cfg, $volid);
3062                     }
3063                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3064                 };
3065                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3066             } else {
3067                 print STDERR "unable to parse line in statfile - $line";
3068             }
3069         }
3070         $fd->close();
3071     }
3072 }
3073
3074 sub restore_archive {
3075     my ($archive, $vmid, $user, $opts) = @_;
3076
3077     if ($archive ne '-') {
3078         my $firstfile = archive_read_firstfile($archive);
3079         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3080             if $firstfile ne 'qemu-server.conf';
3081     }
3082
3083     my $tocmd = "/usr/lib/qemu-server/qmextract";
3084
3085     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3086     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3087     $tocmd .= ' --prealloc' if $opts->{prealloc};
3088     $tocmd .= ' --info' if $opts->{info};
3089
3090     # tar option "xf" does not autodetect compression when read from STDIN,
3091     # so we pipe to zcat
3092     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3093         PVE::Tools::shellquote("--to-command=$tocmd");
3094
3095     my $tmpdir = "/var/tmp/vzdumptmp$$";
3096     mkpath $tmpdir;
3097
3098     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3099     local $ENV{VZDUMP_VMID} = $vmid;
3100     local $ENV{VZDUMP_USER} = $user;
3101
3102     my $conffile = PVE::QemuServer::config_file($vmid);
3103     my $tmpfn = "$conffile.$$.tmp";
3104
3105     # disable interrupts (always do cleanups)
3106     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3107         print STDERR "got interrupt - ignored\n";
3108     };
3109
3110     eval {
3111         # enable interrupts
3112         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3113             die "interrupted by signal\n";
3114         };
3115
3116         if ($archive eq '-') {
3117             print "extracting archive from STDIN\n";
3118             run_command($cmd, input => "<&STDIN");
3119         } else {
3120             print "extracting archive '$archive'\n";
3121             run_command($cmd);
3122         }
3123
3124         return if $opts->{info};
3125
3126         # read new mapping
3127         my $map = {};
3128         my $statfile = "$tmpdir/qmrestore.stat";
3129         if (my $fd = IO::File->new($statfile, "r")) {
3130             while (defined (my $line = <$fd>)) {
3131                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3132                     $map->{$1} = $2 if $1;
3133                 } else {
3134                     print STDERR "unable to parse line in statfile - $line\n";
3135                 }
3136             }
3137             $fd->close();
3138         }
3139
3140         my $confsrc = "$tmpdir/qemu-server.conf";
3141
3142         my $srcfd = new IO::File($confsrc, "r") ||
3143             die "unable to open file '$confsrc'\n";
3144
3145         my $outfd = new IO::File ($tmpfn, "w") ||
3146             die "unable to write config for VM $vmid\n";
3147
3148         my $netcount = 0;
3149
3150         while (defined (my $line = <$srcfd>)) {
3151             next if $line =~ m/^\#vzdump\#/;
3152             next if $line =~ m/^lock:/;
3153             next if $line =~ m/^unused\d+:/;
3154
3155             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3156                 # try to convert old 1.X settings
3157                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3158                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3159                     my ($model, $macaddr) = split(/\=/, $devconfig);
3160                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3161                     my $net = {
3162                         model => $model,
3163                         bridge => "vmbr$ind",
3164                         macaddr => $macaddr,
3165                     };
3166                     my $netstr = print_net($net);
3167                     print $outfd "net${netcount}: $netstr\n";
3168                     $netcount++;
3169                 }
3170             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3171                 my ($id, $netstr) = ($1, $2);
3172                 my $net = parse_net($netstr);
3173                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3174                 $netstr = print_net($net);
3175                 print $outfd "$id: $netstr\n";
3176             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3177                 my $virtdev = $1;
3178                 my $value = $2;
3179                 if ($line =~ m/backup=no/) {
3180                     print $outfd "#$line";
3181                 } elsif ($virtdev && $map->{$virtdev}) {
3182                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3183                     $di->{file} = $map->{$virtdev};
3184                     $value = PVE::QemuServer::print_drive($vmid, $di);
3185                     print $outfd "$virtdev: $value\n";
3186                 } else {
3187                     print $outfd $line;
3188                 }
3189             } else {
3190                 print $outfd $line;
3191             }
3192         }
3193
3194         $srcfd->close();
3195         $outfd->close();
3196     };
3197     my $err = $@;
3198
3199     if ($err) {
3200
3201         unlink $tmpfn;
3202
3203         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3204
3205         die $err;
3206     }
3207
3208     rmtree $tmpdir;
3209
3210     rename $tmpfn, $conffile ||
3211         die "unable to commit configuration file '$conffile'\n";
3212 };
3213
3214 1;