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