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