PVE/QemuServer.pm

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