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