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 => "Activate 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 => 'qemu64',
 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         if (!$drive->{cache} && ($path =~ m|^/dev/| || $path =~ m|\.raw$|)) {
1108             $opts .= ",cache=none";
1109         }
1110     }
1111
1112     my $pathinfo = $path ? "file=$path," : '';
1113
1114     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1115 }
1116
1117 sub print_netdevice_full {
1118     my ($vmid, $conf, $net, $netid, $bridges) = @_;
1119
1120     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
1121
1122     my $device = $net->{model};
1123     if ($net->{model} eq 'virtio') {
1124          $device = 'virtio-net-pci';
1125      };
1126
1127     # qemu > 0.15 always try to boot from network - we disable that by
1128     # not loading the pxe rom file
1129     my $extra = ($bootorder !~ m/n/) ? "romfile=," : '';
1130     my $pciaddr = print_pci_addr("$netid", $bridges);
1131     my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1132     $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
1133     return $tmpstr;
1134 }
1135
1136 sub print_netdev_full {
1137     my ($vmid, $conf, $net, $netid) = @_;
1138
1139     my $i = '';
1140     if ($netid =~ m/^net(\d+)$/) {
1141         $i = int($1);
1142     }
1143
1144     die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
1145
1146     my $ifname = "tap${vmid}i$i";
1147
1148     # kvm uses TUNSETIFF ioctl, and that limits ifname length
1149     die "interface name '$ifname' is too long (max 15 character)\n"
1150         if length($ifname) >= 16;
1151
1152     my $vhostparam = '';
1153     $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model} eq 'virtio';
1154
1155     my $vmname = $conf->{name} || "vm$vmid";
1156
1157     if ($net->{bridge}) {
1158         return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1159     } else {
1160         return "type=user,id=$netid,hostname=$vmname";
1161     }
1162 }
1163
1164 sub drive_is_cdrom {
1165     my ($drive) = @_;
1166
1167     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
1168
1169 }
1170
1171 sub parse_hostpci {
1172     my ($value) = @_;
1173
1174     return undef if !$value;
1175
1176     my $res = {};
1177
1178     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1179        $res->{pciid} = $value;
1180     } else {
1181        return undef;
1182     }
1183
1184     return $res;
1185 }
1186
1187 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1188 sub parse_net {
1189     my ($data) = @_;
1190
1191     my $res = {};
1192
1193     foreach my $kvp (split(/,/, $data)) {
1194
1195         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1196             my $model = lc($1);
1197             my $mac = uc($3) || PVE::Tools::random_ether_addr();
1198             $res->{model} = $model;
1199             $res->{macaddr} = $mac;
1200         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1201             $res->{bridge} = $1;
1202         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1203             $res->{rate} = $1;
1204         } elsif ($kvp =~ m/^tag=(\d+)$/) {
1205             $res->{tag} = $1;
1206         } else {
1207             return undef;
1208         }
1209
1210     }
1211
1212     return undef if !$res->{model};
1213
1214     return $res;
1215 }
1216
1217 sub print_net {
1218     my $net = shift;
1219
1220     my $res = "$net->{model}";
1221     $res .= "=$net->{macaddr}" if $net->{macaddr};
1222     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1223     $res .= ",rate=$net->{rate}" if $net->{rate};
1224     $res .= ",tag=$net->{tag}" if $net->{tag};
1225
1226     return $res;
1227 }
1228
1229 sub add_random_macs {
1230     my ($settings) = @_;
1231
1232     foreach my $opt (keys %$settings) {
1233         next if $opt !~ m/^net(\d+)$/;
1234         my $net = parse_net($settings->{$opt});
1235         next if !$net;
1236         $settings->{$opt} = print_net($net);
1237     }
1238 }
1239
1240 sub add_unused_volume {
1241     my ($config, $volid) = @_;
1242
1243     my $key;
1244     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1245         my $test = "unused$ind";
1246         if (my $vid = $config->{$test}) {
1247             return if $vid eq $volid; # do not add duplicates
1248         } else {
1249             $key = $test;
1250         }
1251     }
1252
1253     die "To many unused volume - please delete them first.\n" if !$key;
1254
1255     $config->{$key} = $volid;
1256
1257     return $key;
1258 }
1259
1260 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1261 sub verify_bootdisk {
1262     my ($value, $noerr) = @_;
1263
1264     return $value if valid_drivename($value);
1265
1266     return undef if $noerr;
1267
1268     die "invalid boot disk '$value'\n";
1269 }
1270
1271 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1272 sub verify_net {
1273     my ($value, $noerr) = @_;
1274
1275     return $value if parse_net($value);
1276
1277     return undef if $noerr;
1278
1279     die "unable to parse network options\n";
1280 }
1281
1282 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1283 sub verify_drive {
1284     my ($value, $noerr) = @_;
1285
1286     return $value if parse_drive(undef, $value);
1287
1288     return undef if $noerr;
1289
1290     die "unable to parse drive options\n";
1291 }
1292
1293 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1294 sub verify_hostpci {
1295     my ($value, $noerr) = @_;
1296
1297     return $value if parse_hostpci($value);
1298
1299     return undef if $noerr;
1300
1301     die "unable to parse pci id\n";
1302 }
1303
1304 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1305 sub verify_watchdog {
1306     my ($value, $noerr) = @_;
1307
1308     return $value if parse_watchdog($value);
1309
1310     return undef if $noerr;
1311
1312     die "unable to parse watchdog options\n";
1313 }
1314
1315 sub parse_watchdog {
1316     my ($value) = @_;
1317
1318     return undef if !$value;
1319
1320     my $res = {};
1321
1322     foreach my $p (split(/,/, $value)) {
1323         next if $p =~ m/^\s*$/;
1324
1325         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1326             $res->{model} = $2;
1327         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1328             $res->{action} = $2;
1329         } else {
1330             return undef;
1331         }
1332     }
1333
1334     return $res;
1335 }
1336
1337 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1338 sub verify_startup {
1339     my ($value, $noerr) = @_;
1340
1341     return $value if parse_startup($value);
1342
1343     return undef if $noerr;
1344
1345     die "unable to parse startup options\n";
1346 }
1347
1348 sub parse_startup {
1349     my ($value) = @_;
1350
1351     return undef if !$value;
1352
1353     my $res = {};
1354
1355     foreach my $p (split(/,/, $value)) {
1356         next if $p =~ m/^\s*$/;
1357
1358         if ($p =~ m/^(order=)?(\d+)$/) {
1359             $res->{order} = $2;
1360         } elsif ($p =~ m/^up=(\d+)$/) {
1361             $res->{up} = $1;
1362         } elsif ($p =~ m/^down=(\d+)$/) {
1363             $res->{down} = $1;
1364         } else {
1365             return undef;
1366         }
1367     }
1368
1369     return $res;
1370 }
1371
1372 sub parse_usb_device {
1373     my ($value) = @_;
1374
1375     return undef if !$value;
1376
1377     my @dl = split(/,/, $value);
1378     my $found;
1379
1380     my $res = {};
1381     foreach my $v (@dl) {
1382         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1383             $found = 1;
1384             $res->{vendorid} = $2;
1385             $res->{productid} = $4;
1386         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1387             $found = 1;
1388             $res->{hostbus} = $1;
1389             $res->{hostport} = $2;
1390         } else {
1391             return undef;
1392         }
1393     }
1394     return undef if !$found;
1395
1396     return $res;
1397 }
1398
1399 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1400 sub verify_usb_device {
1401     my ($value, $noerr) = @_;
1402
1403     return $value if parse_usb_device($value);
1404
1405     return undef if $noerr;
1406
1407     die "unable to parse usb device\n";
1408 }
1409
1410 # add JSON properties for create and set function
1411 sub json_config_properties {
1412     my $prop = shift;
1413
1414     foreach my $opt (keys %$confdesc) {
1415         next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1416         $prop->{$opt} = $confdesc->{$opt};
1417     }
1418
1419     return $prop;
1420 }
1421
1422 sub check_type {
1423     my ($key, $value) = @_;
1424
1425     die "unknown setting '$key'\n" if !$confdesc->{$key};
1426
1427     my $type = $confdesc->{$key}->{type};
1428
1429     if (!defined($value)) {
1430         die "got undefined value\n";
1431     }
1432
1433     if ($value =~ m/[\n\r]/) {
1434         die "property contains a line feed\n";
1435     }
1436
1437     if ($type eq 'boolean') {
1438         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1439         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1440         die "type check ('boolean') failed - got '$value'\n";
1441     } elsif ($type eq 'integer') {
1442         return int($1) if $value =~ m/^(\d+)$/;
1443         die "type check ('integer') failed - got '$value'\n";
1444     } elsif ($type eq 'number') {
1445         return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1446         die "type check ('number') failed - got '$value'\n";
1447     } elsif ($type eq 'string') {
1448         if (my $fmt = $confdesc->{$key}->{format}) {
1449             if ($fmt eq 'pve-qm-drive') {
1450                 # special case - we need to pass $key to parse_drive()
1451                 my $drive = parse_drive($key, $value);
1452                 return $value if $drive;
1453                 die "unable to parse drive options\n";
1454             }
1455             PVE::JSONSchema::check_format($fmt, $value);
1456             return $value;
1457         }
1458         $value =~ s/^\"(.*)\"$/$1/;
1459         return $value;
1460     } else {
1461         die "internal error"
1462     }
1463 }
1464
1465 sub lock_config_full {
1466     my ($vmid, $timeout, $code, @param) = @_;
1467
1468     my $filename = config_file_lock($vmid);
1469
1470     my $res = lock_file($filename, $timeout, $code, @param);
1471
1472     die $@ if $@;
1473
1474     return $res;
1475 }
1476
1477 sub lock_config {
1478     my ($vmid, $code, @param) = @_;
1479
1480     return lock_config_full($vmid, 10, $code, @param);
1481 }
1482
1483 sub cfs_config_path {
1484     my ($vmid, $node) = @_;
1485
1486     $node = $nodename if !$node;
1487     return "nodes/$node/qemu-server/$vmid.conf";
1488 }
1489
1490 sub check_iommu_support{
1491     #fixme : need to check IOMMU support
1492     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1493
1494     my $iommu=1;
1495     return $iommu;
1496
1497 }
1498
1499 sub config_file {
1500     my ($vmid, $node) = @_;
1501
1502     my $cfspath = cfs_config_path($vmid, $node);
1503     return "/etc/pve/$cfspath";
1504 }
1505
1506 sub config_file_lock {
1507     my ($vmid) = @_;
1508
1509     return "$lock_dir/lock-$vmid.conf";
1510 }
1511
1512 sub touch_config {
1513     my ($vmid) = @_;
1514
1515     my $conf = config_file($vmid);
1516     utime undef, undef, $conf;
1517 }
1518
1519 sub destroy_vm {
1520     my ($storecfg, $vmid, $keep_empty_config) = @_;
1521
1522     my $conffile = config_file($vmid);
1523
1524     my $conf = load_config($vmid);
1525
1526     check_lock($conf);
1527
1528     # only remove disks owned by this VM
1529     foreach_drive($conf, sub {
1530         my ($ds, $drive) = @_;
1531
1532         return if drive_is_cdrom($drive);
1533
1534         my $volid = $drive->{file};
1535
1536         return if !$volid || $volid =~ m|^/|;
1537
1538         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1539         return if !$path || !$owner || ($owner != $vmid);
1540
1541         PVE::Storage::vdisk_free($storecfg, $volid);
1542     });
1543
1544     if ($keep_empty_config) {
1545         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1546     } else {
1547         unlink $conffile;
1548     }
1549
1550     # also remove unused disk
1551     eval {
1552         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1553
1554         eval {
1555             PVE::Storage::foreach_volid($dl, sub {
1556                 my ($volid, $sid, $volname, $d) = @_;
1557                 PVE::Storage::vdisk_free($storecfg, $volid);
1558             });
1559         };
1560         warn $@ if $@;
1561
1562     };
1563     warn $@ if $@;
1564 }
1565
1566 sub load_config {
1567     my ($vmid, $node) = @_;
1568
1569     my $cfspath = cfs_config_path($vmid, $node);
1570
1571     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1572
1573     die "no such VM ('$vmid')\n" if !defined($conf);
1574
1575     return $conf;
1576 }
1577
1578 sub parse_vm_config {
1579     my ($filename, $raw) = @_;
1580
1581     return undef if !defined($raw);
1582
1583     my $res = {
1584         digest => Digest::SHA::sha1_hex($raw),
1585         snapshots => {},
1586     };
1587
1588     $filename =~ m|/qemu-server/(\d+)\.conf$|
1589         || die "got strange filename '$filename'";
1590
1591     my $vmid = $1;
1592
1593     my $conf = $res;
1594     my $descr = '';
1595
1596     my @lines = split(/\n/, $raw);
1597     foreach my $line (@lines) {
1598         next if $line =~ m/^\s*$/;
1599
1600         if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1601             my $snapname = $1;
1602             $conf->{description} = $descr if $descr;
1603             $descr = '';
1604             $conf = $res->{snapshots}->{$snapname} = {};
1605             next;
1606         }
1607
1608         if ($line =~ m/^\#(.*)\s*$/) {
1609             $descr .= PVE::Tools::decode_text($1) . "\n";
1610             next;
1611         }
1612
1613         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1614             $descr .= PVE::Tools::decode_text($2);
1615         } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1616             $conf->{snapstate} = $1;
1617         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1618             my $key = $1;
1619             my $value = $2;
1620             $conf->{$key} = $value;
1621         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1622             my $key = $1;
1623             my $value = $2;
1624             eval { $value = check_type($key, $value); };
1625             if ($@) {
1626                 warn "vm $vmid - unable to parse value of '$key' - $@";
1627             } else {
1628                 my $fmt = $confdesc->{$key}->{format};
1629                 if ($fmt && $fmt eq 'pve-qm-drive') {
1630                     my $v = parse_drive($key, $value);
1631                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1632                         $v->{file} = $volid;
1633                         $value = print_drive($vmid, $v);
1634                     } else {
1635                         warn "vm $vmid - unable to parse value of '$key'\n";
1636                         next;
1637                     }
1638                 }
1639
1640                 if ($key eq 'cdrom') {
1641                     $conf->{ide2} = $value;
1642                 } else {
1643                     $conf->{$key} = $value;
1644                 }
1645             }
1646         }
1647     }
1648
1649     $conf->{description} = $descr if $descr;
1650
1651     delete $res->{snapstate}; # just to be sure
1652
1653     return $res;
1654 }
1655
1656 sub write_vm_config {
1657     my ($filename, $conf) = @_;
1658
1659     delete $conf->{snapstate}; # just to be sure
1660
1661     if ($conf->{cdrom}) {
1662         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1663         $conf->{ide2} = $conf->{cdrom};
1664         delete $conf->{cdrom};
1665     }
1666
1667     # we do not use 'smp' any longer
1668     if ($conf->{sockets}) {
1669         delete $conf->{smp};
1670     } elsif ($conf->{smp}) {
1671         $conf->{sockets} = $conf->{smp};
1672         delete $conf->{cores};
1673         delete $conf->{smp};
1674     }
1675
1676     my $used_volids = {};
1677
1678     my $cleanup_config = sub {
1679         my ($cref) = @_;
1680
1681         foreach my $key (keys %$cref) {
1682             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1683                 $key eq 'snapstate';
1684             my $value = $cref->{$key};
1685             eval { $value = check_type($key, $value); };
1686             die "unable to parse value of '$key' - $@" if $@;
1687
1688             $cref->{$key} = $value;
1689
1690             if (valid_drivename($key)) {
1691                 my $drive = parse_drive($key, $value);
1692                 $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1693             }
1694         }
1695     };
1696
1697     &$cleanup_config($conf);
1698     foreach my $snapname (keys %{$conf->{snapshots}}) {
1699         &$cleanup_config($conf->{snapshots}->{$snapname});
1700     }
1701
1702     # remove 'unusedX' settings if we re-add a volume
1703     foreach my $key (keys %$conf) {
1704         my $value = $conf->{$key};
1705         if ($key =~ m/^unused/ && $used_volids->{$value}) {
1706             delete $conf->{$key};
1707         }
1708     }
1709
1710     my $generate_raw_config = sub {
1711         my ($conf) = @_;
1712
1713         my $raw = '';
1714
1715         # add description as comment to top of file
1716         my $descr = $conf->{description} || '';
1717         foreach my $cl (split(/\n/, $descr)) {
1718             $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1719         }
1720
1721         foreach my $key (sort keys %$conf) {
1722             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1723             $raw .= "$key: $conf->{$key}\n";
1724         }
1725         return $raw;
1726     };
1727
1728     my $raw = &$generate_raw_config($conf);
1729     foreach my $snapname (sort keys %{$conf->{snapshots}}) {
1730         $raw .= "\n[$snapname]\n";
1731         $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
1732     }
1733
1734     return $raw;
1735 }
1736
1737 sub update_config_nolock {
1738     my ($vmid, $conf, $skiplock) = @_;
1739
1740     check_lock($conf) if !$skiplock;
1741
1742     my $cfspath = cfs_config_path($vmid);
1743
1744     PVE::Cluster::cfs_write_file($cfspath, $conf);
1745 }
1746
1747 sub update_config {
1748     my ($vmid, $conf, $skiplock) = @_;
1749
1750     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1751 }
1752
1753 sub load_defaults {
1754
1755     my $res = {};
1756
1757     # we use static defaults from our JSON schema configuration
1758     foreach my $key (keys %$confdesc) {
1759         if (defined(my $default = $confdesc->{$key}->{default})) {
1760             $res->{$key} = $default;
1761         }
1762     }
1763
1764     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1765     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1766
1767     return $res;
1768 }
1769
1770 sub config_list {
1771     my $vmlist = PVE::Cluster::get_vmlist();
1772     my $res = {};
1773     return $res if !$vmlist || !$vmlist->{ids};
1774     my $ids = $vmlist->{ids};
1775
1776     foreach my $vmid (keys %$ids) {
1777         my $d = $ids->{$vmid};
1778         next if !$d->{node} || $d->{node} ne $nodename;
1779         next if !$d->{type} || $d->{type} ne 'qemu';
1780         $res->{$vmid}->{exists} = 1;
1781     }
1782     return $res;
1783 }
1784
1785 # test if VM uses local resources (to prevent migration)
1786 sub check_local_resources {
1787     my ($conf, $noerr) = @_;
1788
1789     my $loc_res = 0;
1790
1791     $loc_res = 1 if $conf->{hostusb}; # old syntax
1792     $loc_res = 1 if $conf->{hostpci}; # old syntax
1793
1794     foreach my $k (keys %$conf) {
1795         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1796     }
1797
1798     die "VM uses local resources\n" if $loc_res && !$noerr;
1799
1800     return $loc_res;
1801 }
1802
1803 # check is used storages are available on all nodes (use by migrate)
1804 sub check_storage_availability {
1805     my ($storecfg, $conf, $node) = @_;
1806
1807     foreach_drive($conf, sub {
1808         my ($ds, $drive) = @_;
1809
1810         my $volid = $drive->{file};
1811         return if !$volid;
1812
1813         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1814         return if !$sid;
1815
1816         # check if storage is available on both nodes
1817         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1818         PVE::Storage::storage_check_node($storecfg, $sid, $node);
1819    });
1820 }
1821
1822 sub check_lock {
1823     my ($conf) = @_;
1824
1825     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1826 }
1827
1828 sub check_cmdline {
1829     my ($pidfile, $pid) = @_;
1830
1831     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1832     if (defined($fh)) {
1833         my $line = <$fh>;
1834         $fh->close;
1835         return undef if !$line;
1836         my @param = split(/\0/, $line);
1837
1838         my $cmd = $param[0];
1839         return if !$cmd || ($cmd !~ m|kvm$|);
1840
1841         for (my $i = 0; $i < scalar (@param); $i++) {
1842             my $p = $param[$i];
1843             next if !$p;
1844             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1845                 my $p = $param[$i+1];
1846                 return 1 if $p && ($p eq $pidfile);
1847                 return undef;
1848             }
1849         }
1850     }
1851     return undef;
1852 }
1853
1854 sub check_running {
1855     my ($vmid, $nocheck, $node) = @_;
1856
1857     my $filename = config_file($vmid, $node);
1858
1859     die "unable to find configuration file for VM $vmid - no such machine\n"
1860         if !$nocheck && ! -f $filename;
1861
1862     my $pidfile = pidfile_name($vmid);
1863
1864     if (my $fd = IO::File->new("<$pidfile")) {
1865         my $st = stat($fd);
1866         my $line = <$fd>;
1867         close($fd);
1868
1869         my $mtime = $st->mtime;
1870         if ($mtime > time()) {
1871             warn "file '$filename' modified in future\n";
1872         }
1873
1874         if ($line =~ m/^(\d+)$/) {
1875             my $pid = $1;
1876             if (check_cmdline($pidfile, $pid)) {
1877                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1878                     return $pid;
1879                 }
1880             }
1881         }
1882     }
1883
1884     return undef;
1885 }
1886
1887 sub vzlist {
1888
1889     my $vzlist = config_list();
1890
1891     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1892
1893     while (defined(my $de = $fd->read)) {
1894         next if $de !~ m/^(\d+)\.pid$/;
1895         my $vmid = $1;
1896         next if !defined($vzlist->{$vmid});
1897         if (my $pid = check_running($vmid)) {
1898             $vzlist->{$vmid}->{pid} = $pid;
1899         }
1900     }
1901
1902     return $vzlist;
1903 }
1904
1905 sub disksize {
1906     my ($storecfg, $conf) = @_;
1907
1908     my $bootdisk = $conf->{bootdisk};
1909     return undef if !$bootdisk;
1910     return undef if !valid_drivename($bootdisk);
1911
1912     return undef if !$conf->{$bootdisk};
1913
1914     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1915     return undef if !defined($drive);
1916
1917     return undef if drive_is_cdrom($drive);
1918
1919     my $volid = $drive->{file};
1920     return undef if !$volid;
1921
1922     return $drive->{size};
1923 }
1924
1925 my $last_proc_pid_stat;
1926
1927 # get VM status information
1928 # This must be fast and should not block ($full == false)
1929 # We only query KVM using QMP if $full == true (this can be slow)
1930 sub vmstatus {
1931     my ($opt_vmid, $full) = @_;
1932
1933     my $res = {};
1934
1935     my $storecfg = PVE::Storage::config();
1936
1937     my $list = vzlist();
1938     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
1939
1940     my $cpucount = $cpuinfo->{cpus} || 1;
1941
1942     foreach my $vmid (keys %$list) {
1943         next if $opt_vmid && ($vmid ne $opt_vmid);
1944
1945         my $cfspath = cfs_config_path($vmid);
1946         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
1947
1948         my $d = {};
1949         $d->{pid} = $list->{$vmid}->{pid};
1950
1951         # fixme: better status?
1952         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
1953
1954         my $size = disksize($storecfg, $conf);
1955         if (defined($size)) {
1956             $d->{disk} = 0; # no info available
1957             $d->{maxdisk} = $size;
1958         } else {
1959             $d->{disk} = 0;
1960             $d->{maxdisk} = 0;
1961         }
1962
1963         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
1964         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
1965
1966         $d->{name} = $conf->{name} || "VM $vmid";
1967         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1968
1969         if ($conf->{balloon}) {
1970             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
1971             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
1972         }
1973
1974         $d->{uptime} = 0;
1975         $d->{cpu} = 0;
1976         $d->{mem} = 0;
1977
1978         $d->{netout} = 0;
1979         $d->{netin} = 0;
1980
1981         $d->{diskread} = 0;
1982         $d->{diskwrite} = 0;
1983
1984         $res->{$vmid} = $d;
1985     }
1986
1987     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1988     foreach my $dev (keys %$netdev) {
1989         next if $dev !~ m/^tap([1-9]\d*)i/;
1990         my $vmid = $1;
1991         my $d = $res->{$vmid};
1992         next if !$d;
1993
1994         $d->{netout} += $netdev->{$dev}->{receive};
1995         $d->{netin} += $netdev->{$dev}->{transmit};
1996     }
1997
1998     my $ctime = gettimeofday;
1999
2000     foreach my $vmid (keys %$list) {
2001
2002         my $d = $res->{$vmid};
2003         my $pid = $d->{pid};
2004         next if !$pid;
2005
2006         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2007         next if !$pstat; # not running
2008
2009         my $used = $pstat->{utime} + $pstat->{stime};
2010
2011         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2012
2013         if ($pstat->{vsize}) {
2014             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2015         }
2016
2017         my $old = $last_proc_pid_stat->{$pid};
2018         if (!$old) {
2019             $last_proc_pid_stat->{$pid} = {
2020                 time => $ctime,
2021                 used => $used,
2022                 cpu => 0,
2023             };
2024             next;
2025         }
2026
2027         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2028
2029         if ($dtime > 1000) {
2030             my $dutime = $used -  $old->{used};
2031
2032             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2033             $last_proc_pid_stat->{$pid} = {
2034                 time => $ctime,
2035                 used => $used,
2036                 cpu => $d->{cpu},
2037             };
2038         } else {
2039             $d->{cpu} = $old->{cpu};
2040         }
2041     }
2042
2043     return $res if !$full;
2044
2045     my $qmpclient = PVE::QMPClient->new();
2046
2047     my $ballooncb = sub {
2048         my ($vmid, $resp) = @_;
2049
2050         my $info = $resp->{'return'};
2051         return if !$info->{max_mem};
2052
2053         my $d = $res->{$vmid};
2054
2055         # use memory assigned to VM
2056         $d->{maxmem} = $info->{max_mem};
2057         $d->{balloon} = $info->{actual};
2058
2059         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2060             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2061             $d->{freemem} = $info->{free_mem};
2062         }
2063
2064     };
2065
2066     my $blockstatscb = sub {
2067         my ($vmid, $resp) = @_;
2068         my $data = $resp->{'return'} || [];
2069         my $totalrdbytes = 0;
2070         my $totalwrbytes = 0;
2071         for my $blockstat (@$data) {
2072             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2073             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2074         }
2075         $res->{$vmid}->{diskread} = $totalrdbytes;
2076         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2077     };
2078
2079     my $statuscb = sub {
2080         my ($vmid, $resp) = @_;
2081
2082         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2083         # this fails if ballon driver is not loaded, so this must be
2084         # the last commnand (following command are aborted if this fails).
2085         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2086
2087         my $status = 'unknown';
2088         if (!defined($status = $resp->{'return'}->{status})) {
2089             warn "unable to get VM status\n";
2090             return;
2091         }
2092
2093         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2094     };
2095
2096     foreach my $vmid (keys %$list) {
2097         next if $opt_vmid && ($vmid ne $opt_vmid);
2098         next if !$res->{$vmid}->{pid}; # not running
2099         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2100     }
2101
2102     $qmpclient->queue_execute();
2103
2104     foreach my $vmid (keys %$list) {
2105         next if $opt_vmid && ($vmid ne $opt_vmid);
2106         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2107     }
2108
2109     return $res;
2110 }
2111
2112 sub foreach_drive {
2113     my ($conf, $func) = @_;
2114
2115     foreach my $ds (keys %$conf) {
2116         next if !valid_drivename($ds);
2117
2118         my $drive = parse_drive($ds, $conf->{$ds});
2119         next if !$drive;
2120
2121         &$func($ds, $drive);
2122     }
2123 }
2124
2125 sub foreach_volid {
2126     my ($conf, $func) = @_;
2127
2128     my $volhash = {};
2129
2130     my $test_volid = sub {
2131         my ($volid, $is_cdrom) = @_;
2132
2133         return if !$volid;
2134
2135         $volhash->{$volid} = $is_cdrom || 0;
2136     };
2137
2138     foreach_drive($conf, sub {
2139         my ($ds, $drive) = @_;
2140         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2141     });
2142
2143     foreach my $snapname (keys %{$conf->{snapshots}}) {
2144         my $snap = $conf->{snapshots}->{$snapname};
2145         &$test_volid($snap->{vmstate}, 0);
2146         foreach_drive($snap, sub {
2147             my ($ds, $drive) = @_;
2148             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2149         });
2150     }
2151
2152     foreach my $volid (keys %$volhash) {
2153         &$func($volid, $volhash->{$volid});
2154     }
2155 }
2156
2157 sub config_to_command {
2158     my ($storecfg, $vmid, $conf, $defaults) = @_;
2159
2160     my $cmd = [];
2161     my $globalFlags = [];
2162     my $machineFlags = [];
2163     my $rtcFlags = [];
2164     my $devices = [];
2165     my $pciaddr = '';
2166     my $bridges = {};
2167     my $kvmver = kvm_user_version();
2168     my $vernum = 0; # unknown
2169     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2170         $vernum = $1*1000000+$2*1000;
2171     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2172         $vernum = $1*1000000+$2*1000+$3;
2173     }
2174
2175     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2176
2177     my $have_ovz = -f '/proc/vz/vestat';
2178
2179     push @$cmd, '/usr/bin/kvm';
2180
2181     push @$cmd, '-id', $vmid;
2182
2183     my $use_virtio = 0;
2184
2185     my $qmpsocket = qmp_socket($vmid);
2186     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2187     push @$cmd, '-mon', "chardev=qmp,mode=control";
2188
2189     my $socket = vnc_socket($vmid);
2190     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2191
2192     push @$cmd, '-pidfile' , pidfile_name($vmid);
2193
2194     push @$cmd, '-daemonize';
2195
2196     my $use_usb2 = 0;
2197     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2198         next if !$conf->{"usb$i"};
2199         $use_usb2 = 1;
2200     }
2201     # include usb device config
2202     push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2203
2204     # enable absolute mouse coordinates (needed by vnc)
2205     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
2206     if ($tablet) {
2207         if ($use_usb2) {
2208             push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
2209         } else {
2210             push @$devices, '-usbdevice', 'tablet';
2211         }
2212     }
2213
2214     # host pci devices
2215     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2216           my $d = parse_hostpci($conf->{"hostpci$i"});
2217           next if !$d;
2218           $pciaddr = print_pci_addr("hostpci$i", $bridges);
2219           push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2220     }
2221
2222     # usb devices
2223     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2224         my $d = parse_usb_device($conf->{"usb$i"});
2225         next if !$d;
2226         if ($d->{vendorid} && $d->{productid}) {
2227             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2228         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2229             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2230         }
2231     }
2232
2233     # serial devices
2234     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2235         if (my $path = $conf->{"serial$i"}) {
2236             die "no such serial device\n" if ! -c $path;
2237             push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2238             push @$devices, '-device', "isa-serial,chardev=serial$i";
2239         }
2240     }
2241
2242     # parallel devices
2243     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2244         if (my $path = $conf->{"parallel$i"}) {
2245             die "no such parallel device\n" if ! -c $path;
2246             push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2247             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2248         }
2249     }
2250
2251     my $vmname = $conf->{name} || "vm$vmid";
2252
2253     push @$cmd, '-name', $vmname;
2254
2255     my $sockets = 1;
2256     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2257     $sockets = $conf->{sockets} if  $conf->{sockets};
2258
2259     my $cores = $conf->{cores} || 1;
2260
2261     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2262
2263     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2264
2265     push @$cmd, '-nodefaults';
2266
2267     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2268
2269     my $bootindex_hash = {};
2270     my $i = 1;
2271     foreach my $o (split(//, $bootorder)) {
2272         $bootindex_hash->{$o} = $i*100;
2273         $i++;
2274     }
2275
2276     push @$cmd, '-boot', "menu=on";
2277
2278     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2279
2280     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2281
2282     my $vga = $conf->{vga};
2283     if (!$vga) {
2284         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' || $conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2285             $vga = 'std';
2286         } else {
2287             $vga = 'cirrus';
2288         }
2289     }
2290
2291     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2292
2293     # time drift fix
2294     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2295
2296     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2297     my $useLocaltime = $conf->{localtime};
2298
2299     if (my $ost = $conf->{ostype}) {
2300         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2301
2302         if ($ost =~ m/^w/) { # windows
2303             $useLocaltime = 1 if !defined($conf->{localtime});
2304
2305             # use time drift fix when acpi is enabled
2306             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2307                 $tdf = 1 if !defined($conf->{tdf});
2308             }
2309         }
2310
2311         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2312             $ost eq 'wvista') {
2313             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2314             push @$cmd, '-no-hpet';
2315         }
2316     }
2317
2318     push @$rtcFlags, 'driftfix=slew' if $tdf;
2319
2320     if ($nokvm) {
2321         push @$machineFlags, 'accel=tcg';
2322     } else {
2323         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2324     }
2325
2326     if ($conf->{startdate}) {
2327         push @$rtcFlags, "base=$conf->{startdate}";
2328     } elsif ($useLocaltime) {
2329         push @$rtcFlags, 'base=localtime';
2330     }
2331
2332     push @$cmd, '-S' if $conf->{freeze};
2333
2334     # set keyboard layout
2335     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2336     push @$cmd, '-k', $kb if $kb;
2337
2338     # enable sound
2339     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2340     #push @$cmd, '-soundhw', 'es1370';
2341     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2342
2343     if($conf->{agent}) {
2344         my $qgasocket = qga_socket($vmid);
2345         my $pciaddr = print_pci_addr("qga0", $bridges);
2346         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2347         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2348         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2349     }
2350
2351     # enable balloon by default, unless explicitly disabled
2352     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2353         $pciaddr = print_pci_addr("balloon0", $bridges);
2354         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2355     }
2356
2357     if ($conf->{watchdog}) {
2358         my $wdopts = parse_watchdog($conf->{watchdog});
2359         $pciaddr = print_pci_addr("watchdog", $bridges);
2360         my $watchdog = $wdopts->{model} || 'i6300esb';
2361         push @$devices, '-device', "$watchdog$pciaddr";
2362         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2363     }
2364
2365     my $vollist = [];
2366     my $scsicontroller = {};
2367     my $ahcicontroller = {};
2368     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2369
2370     foreach_drive($conf, sub {
2371         my ($ds, $drive) = @_;
2372
2373         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2374             push @$vollist, $drive->{file};
2375         }
2376
2377         $use_virtio = 1 if $ds =~ m/^virtio/;
2378
2379         if (drive_is_cdrom ($drive)) {
2380             if ($bootindex_hash->{d}) {
2381                 $drive->{bootindex} = $bootindex_hash->{d};
2382                 $bootindex_hash->{d} += 1;
2383             }
2384         } else {
2385             if ($bootindex_hash->{c}) {
2386                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2387                 $bootindex_hash->{c} += 1;
2388             }
2389         }
2390
2391         if ($drive->{interface} eq 'scsi') {
2392
2393             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2394             my $controller = int($drive->{index} / $maxdev);
2395             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2396             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2397             $scsicontroller->{$controller}=1;
2398         }
2399
2400         if ($drive->{interface} eq 'sata') {
2401            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2402            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2403            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2404            $ahcicontroller->{$controller}=1;
2405         }
2406
2407         push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
2408         push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2409     });
2410
2411     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2412
2413     for (my $i = 0; $i < $MAX_NETS; $i++) {
2414          next if !$conf->{"net$i"};
2415          my $d = parse_net($conf->{"net$i"});
2416          next if !$d;
2417
2418          $use_virtio = 1 if $d->{model} eq 'virtio';
2419
2420          if ($bootindex_hash->{n}) {
2421             $d->{bootindex} = $bootindex_hash->{n};
2422             $bootindex_hash->{n} += 1;
2423          }
2424
2425          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2426          push @$devices, '-netdev', $netdevfull;
2427
2428          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2429          push @$devices, '-device', $netdevicefull;
2430     }
2431
2432     #bridges
2433     while (my ($k, $v) = each %$bridges) {
2434         $pciaddr = print_pci_addr("pci.$k");
2435         unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2436     }
2437
2438
2439     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2440     # when the VM uses virtio devices.
2441     if (!$use_virtio && $have_ovz) {
2442
2443         my $cpuunits = defined($conf->{cpuunits}) ?
2444             $conf->{cpuunits} : $defaults->{cpuunits};
2445
2446         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2447
2448         # fixme: cpulimit is currently ignored
2449         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2450     }
2451
2452     # add custom args
2453     if ($conf->{args}) {
2454         my $aa = PVE::Tools::split_args($conf->{args});
2455         push @$cmd, @$aa;
2456     }
2457
2458     push @$cmd, @$devices;
2459     push @$cmd, '-rtc', join(',', @$rtcFlags)
2460         if scalar(@$rtcFlags);
2461     push @$cmd, '-machine', join(',', @$machineFlags)
2462         if scalar(@$machineFlags);
2463     push @$cmd, '-global', join(',', @$globalFlags)
2464         if scalar(@$globalFlags);
2465
2466     return wantarray ? ($cmd, $vollist) : $cmd;
2467 }
2468
2469 sub vnc_socket {
2470     my ($vmid) = @_;
2471     return "${var_run_tmpdir}/$vmid.vnc";
2472 }
2473
2474 sub qmp_socket {
2475     my ($vmid) = @_;
2476     return "${var_run_tmpdir}/$vmid.qmp";
2477 }
2478
2479 sub qga_socket {
2480     my ($vmid) = @_;
2481     return "${var_run_tmpdir}/$vmid.qga";
2482 }
2483
2484 sub pidfile_name {
2485     my ($vmid) = @_;
2486     return "${var_run_tmpdir}/$vmid.pid";
2487 }
2488
2489 sub next_migrate_port {
2490
2491     for (my $p = 60000; $p < 60010; $p++) {
2492
2493         my $sock = IO::Socket::INET->new(Listen => 5,
2494                                          LocalAddr => 'localhost',
2495                                          LocalPort => $p,
2496                                          ReuseAddr => 1,
2497                                          Proto     => 0);
2498
2499         if ($sock) {
2500             close($sock);
2501             return $p;
2502         }
2503     }
2504
2505     die "unable to find free migration port";
2506 }
2507
2508 sub vm_devices_list {
2509     my ($vmid) = @_;
2510
2511     my $res = vm_mon_cmd($vmid, 'query-pci');
2512
2513     my $devices = {};
2514     foreach my $pcibus (@$res) {
2515         foreach my $device (@{$pcibus->{devices}}) {
2516             next if !$device->{'qdev_id'};
2517             $devices->{$device->{'qdev_id'}} = $device;
2518         }
2519     }
2520
2521     return $devices;
2522 }
2523
2524 sub vm_deviceplug {
2525     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2526
2527     return 1 if !check_running($vmid) || !$conf->{hotplug};
2528
2529     my $devices_list = vm_devices_list($vmid);
2530     return 1 if defined($devices_list->{$deviceid});
2531
2532     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2533
2534     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2535         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2536         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2537         qemu_deviceadd($vmid, $devicefull);
2538         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2539            qemu_drivedel($vmid, $deviceid);
2540            return undef;
2541         }
2542     }
2543
2544     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2545         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2546         my $pciaddr = print_pci_addr($deviceid);
2547         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2548         qemu_deviceadd($vmid, $devicefull);
2549         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2550     }
2551
2552     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2553         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2554         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2555         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2556         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2557         if(!qemu_deviceadd($vmid, $devicefull)) {
2558            qemu_drivedel($vmid, $deviceid);
2559            return undef;
2560         }
2561     }
2562
2563     if ($deviceid =~ m/^(net)(\d+)$/) {
2564         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2565         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2566         qemu_deviceadd($vmid, $netdevicefull);
2567         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2568            qemu_netdevdel($vmid, $deviceid);
2569            return undef;
2570         }
2571     }
2572
2573     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2574         my $bridgeid = $2;
2575         my $pciaddr = print_pci_addr($deviceid);
2576         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2577         qemu_deviceadd($vmid, $devicefull);
2578         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2579     }
2580
2581     return 1;
2582 }
2583
2584 sub vm_deviceunplug {
2585     my ($vmid, $conf, $deviceid) = @_;
2586
2587     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2588
2589     my $devices_list = vm_devices_list($vmid);
2590     return 1 if !defined($devices_list->{$deviceid});
2591
2592     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2593
2594     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2595         return undef if !qemu_drivedel($vmid, $deviceid);
2596         qemu_devicedel($vmid, $deviceid);
2597         return undef if !qemu_devicedelverify($vmid, $deviceid);
2598     }
2599
2600     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2601         return undef if !qemu_devicedel($vmid, $deviceid);
2602     }
2603
2604     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2605         return undef if !qemu_devicedel($vmid, $deviceid);
2606         return undef if !qemu_drivedel($vmid, $deviceid);
2607     }
2608
2609     if ($deviceid =~ m/^(net)(\d+)$/) {
2610         return undef if !qemu_netdevdel($vmid, $deviceid);
2611         qemu_devicedel($vmid, $deviceid);
2612         return undef if !qemu_devicedelverify($vmid, $deviceid);
2613     }
2614
2615     return 1;
2616 }
2617
2618 sub qemu_deviceadd {
2619     my ($vmid, $devicefull) = @_;
2620
2621     my $ret = vm_human_monitor_command($vmid, "device_add $devicefull");
2622     $ret =~ s/^\s+//;
2623     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2624     return 1 if $ret eq "";
2625     syslog("err", "error on hotplug device : $ret");
2626     return undef;
2627
2628 }
2629
2630 sub qemu_devicedel {
2631     my($vmid, $deviceid) = @_;
2632
2633     my $ret = vm_human_monitor_command($vmid, "device_del $deviceid");
2634     $ret =~ s/^\s+//;
2635     return 1 if $ret eq "";
2636     syslog("err", "detaching device $deviceid failed : $ret");
2637     return undef;
2638 }
2639
2640 sub qemu_driveadd {
2641     my($storecfg, $vmid, $device) = @_;
2642
2643     my $drive = print_drive_full($storecfg, $vmid, $device);
2644     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2645     # If the command succeeds qemu prints: "OK"
2646     if ($ret !~ m/OK/s) {
2647         syslog("err", "adding drive failed: $ret");
2648         return undef;
2649     }
2650     return 1;
2651 }
2652
2653 sub qemu_drivedel {
2654     my($vmid, $deviceid) = @_;
2655
2656     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2657     $ret =~ s/^\s+//;
2658     if ($ret =~ m/Device \'.*?\' not found/s) {
2659         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2660     }
2661     elsif ($ret ne "") {
2662       syslog("err", "deleting drive $deviceid failed : $ret");
2663       return undef;
2664     }
2665     return 1;
2666 }
2667
2668 sub qemu_deviceaddverify {
2669     my ($vmid,$deviceid) = @_;
2670
2671     for (my $i = 0; $i <= 5; $i++) {
2672          my $devices_list = vm_devices_list($vmid);
2673          return 1 if defined($devices_list->{$deviceid});
2674          sleep 1;
2675     }
2676     syslog("err", "error on hotplug device $deviceid");
2677     return undef;
2678 }
2679
2680
2681 sub qemu_devicedelverify {
2682     my ($vmid,$deviceid) = @_;
2683
2684     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2685     for (my $i = 0; $i <= 5; $i++) {
2686          my $devices_list = vm_devices_list($vmid);
2687          return 1 if !defined($devices_list->{$deviceid});
2688          sleep 1;
2689     }
2690     syslog("err", "error on hot-unplugging device $deviceid");
2691     return undef;
2692 }
2693
2694 sub qemu_findorcreatescsihw {
2695     my ($storecfg, $conf, $vmid, $device) = @_;
2696
2697     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2698     my $controller = int($device->{index} / $maxdev);
2699     my $scsihwid="scsihw$controller";
2700     my $devices_list = vm_devices_list($vmid);
2701
2702     if(!defined($devices_list->{$scsihwid})) {
2703        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2704     }
2705     return 1;
2706 }
2707
2708 sub qemu_bridgeadd {
2709     my ($storecfg, $conf, $vmid, $device) = @_;
2710
2711     my $bridges = {};
2712     my $bridgeid = undef;
2713     print_pci_addr($device, $bridges);
2714
2715     while (my ($k, $v) = each %$bridges) {
2716         $bridgeid = $k;
2717     }
2718     return if $bridgeid < 1;
2719     my $bridge = "pci.$bridgeid";
2720     my $devices_list = vm_devices_list($vmid);
2721
2722     if(!defined($devices_list->{$bridge})) {
2723         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2724     }
2725     return 1;
2726 }
2727
2728 sub qemu_netdevadd {
2729     my ($vmid, $conf, $device, $deviceid) = @_;
2730
2731     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2732     my $ret = vm_human_monitor_command($vmid, "netdev_add $netdev");
2733     $ret =~ s/^\s+//;
2734
2735     #if the command succeeds, no output is sent. So any non-empty string shows an error
2736     return 1 if $ret eq "";
2737     syslog("err", "adding netdev failed: $ret");
2738     return undef;
2739 }
2740
2741 sub qemu_netdevdel {
2742     my ($vmid, $deviceid) = @_;
2743
2744     my $ret = vm_human_monitor_command($vmid, "netdev_del $deviceid");
2745     $ret =~ s/^\s+//;
2746     #if the command succeeds, no output is sent. So any non-empty string shows an error
2747     return 1 if $ret eq "";
2748     syslog("err", "deleting netdev failed: $ret");
2749     return undef;
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         check_lock($conf) if !$skiplock;
2933
2934         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
2935
2936         my $defaults = load_defaults();
2937
2938         # set environment variable useful inside network script
2939         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
2940
2941         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults);
2942
2943         my $migrate_port = 0;
2944
2945         if ($statefile) {
2946             if ($statefile eq 'tcp') {
2947                 $migrate_port = next_migrate_port();
2948                 my $migrate_uri = "tcp:localhost:${migrate_port}";
2949                 push @$cmd, '-incoming', $migrate_uri;
2950                 push @$cmd, '-S';
2951             } else {
2952                 push @$cmd, '-loadstate', $statefile;
2953             }
2954         } elsif ($paused) {
2955             push @$cmd, '-S';
2956         }
2957
2958         # host pci devices
2959         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2960           my $d = parse_hostpci($conf->{"hostpci$i"});
2961           next if !$d;
2962           my $info = pci_device_info("0000:$d->{pciid}");
2963           die "IOMMU not present\n" if !check_iommu_support();
2964           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2965           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2966           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2967         }
2968
2969         PVE::Storage::activate_volumes($storecfg, $vollist);
2970
2971         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
2972                     umask => 0077); };
2973         my $err = $@;
2974         die "start failed: $err" if $err;
2975
2976         print "migration listens on port $migrate_port\n" if $migrate_port;
2977
2978         if ($statefile && $statefile ne 'tcp')  {
2979             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
2980             warn $@ if $@;
2981         }
2982
2983         if($migratedfrom) {
2984             my $capabilities = {};
2985             $capabilities->{capability} =  "xbzrle";
2986             $capabilities->{state} = JSON::true;
2987             eval { vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
2988         }
2989
2990         # fixme: how do we handle that on migration?
2991
2992         if (!defined($conf->{balloon}) || $conf->{balloon}) {
2993             vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
2994                 if $conf->{balloon};
2995             vm_mon_cmd_nocheck($vmid, 'qom-set',
2996                        path => "machine/peripheral/balloon0",
2997                        property => "stats-polling-interval",
2998                        value => 2);
2999         }
3000     });
3001 }
3002
3003 sub vm_mon_cmd {
3004     my ($vmid, $execute, %params) = @_;
3005
3006     my $cmd = { execute => $execute, arguments => \%params };
3007     vm_qmp_command($vmid, $cmd);
3008 }
3009
3010 sub vm_mon_cmd_nocheck {
3011     my ($vmid, $execute, %params) = @_;
3012
3013     my $cmd = { execute => $execute, arguments => \%params };
3014     vm_qmp_command($vmid, $cmd, 1);
3015 }
3016
3017 sub vm_qmp_command {
3018     my ($vmid, $cmd, $nocheck) = @_;
3019
3020     my $res;
3021
3022     my $timeout;
3023     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3024         $timeout = $cmd->{arguments}->{timeout};
3025         delete $cmd->{arguments}->{timeout};
3026     }
3027
3028     eval {
3029         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3030         my $sname = qmp_socket($vmid);
3031         if (-e $sname) {
3032             my $qmpclient = PVE::QMPClient->new();
3033
3034             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3035         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3036             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3037                 if scalar(%{$cmd->{arguments}});
3038             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3039         } else {
3040             die "unable to open monitor socket\n";
3041         }
3042     };
3043     if (my $err = $@) {
3044         syslog("err", "VM $vmid qmp command failed - $err");
3045         die $err;
3046     }
3047
3048     return $res;
3049 }
3050
3051 sub vm_human_monitor_command {
3052     my ($vmid, $cmdline) = @_;
3053
3054     my $res;
3055
3056     my $cmd = {
3057         execute => 'human-monitor-command',
3058         arguments => { 'command-line' => $cmdline},
3059     };
3060
3061     return vm_qmp_command($vmid, $cmd);
3062 }
3063
3064 sub vm_commandline {
3065     my ($storecfg, $vmid) = @_;
3066
3067     my $conf = load_config($vmid);
3068
3069     my $defaults = load_defaults();
3070
3071     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3072
3073     return join(' ', @$cmd);
3074 }
3075
3076 sub vm_reset {
3077     my ($vmid, $skiplock) = @_;
3078
3079     lock_config($vmid, sub {
3080
3081         my $conf = load_config($vmid);
3082
3083         check_lock($conf) if !$skiplock;
3084
3085         vm_mon_cmd($vmid, "system_reset");
3086     });
3087 }
3088
3089 sub get_vm_volumes {
3090     my ($conf) = @_;
3091
3092     my $vollist = [];
3093     foreach_volid($conf, sub {
3094         my ($volid, $is_cdrom) = @_;
3095
3096         return if $volid =~ m|^/|;
3097
3098         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3099         return if !$sid;
3100
3101         push @$vollist, $volid;
3102     });
3103
3104     return $vollist;
3105 }
3106
3107 sub vm_stop_cleanup {
3108     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3109
3110     eval {
3111         fairsched_rmnod($vmid); # try to destroy group
3112
3113         if (!$keepActive) {
3114             my $vollist = get_vm_volumes($conf);
3115             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3116         }
3117
3118         foreach my $ext (qw(mon qmp pid vnc qga)) {
3119             unlink "/var/run/qemu-server/${vmid}.$ext";
3120         }
3121     };
3122     warn $@ if $@; # avoid errors - just warn
3123 }
3124
3125 # Note: use $nockeck to skip tests if VM configuration file exists.
3126 # We need that when migration VMs to other nodes (files already moved)
3127 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3128 sub vm_stop {
3129     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3130
3131     $force = 1 if !defined($force) && !$shutdown;
3132
3133     if ($migratedfrom){
3134         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3135         kill 15, $pid if $pid;
3136         my $conf = load_config($vmid, $migratedfrom);
3137         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3138         return;
3139     }
3140
3141     lock_config($vmid, sub {
3142
3143         my $pid = check_running($vmid, $nocheck);
3144         return if !$pid;
3145
3146         my $conf;
3147         if (!$nocheck) {
3148             $conf = load_config($vmid);
3149             check_lock($conf) if !$skiplock;
3150             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3151                 my $opts = parse_startup($conf->{startup});
3152                 $timeout = $opts->{down} if $opts->{down};
3153             }
3154         }
3155
3156         $timeout = 60 if !defined($timeout);
3157
3158         eval {
3159             if ($shutdown) {
3160                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3161
3162             } else {
3163                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3164             }
3165         };
3166         my $err = $@;
3167
3168         if (!$err) {
3169             my $count = 0;
3170             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3171                 $count++;
3172                 sleep 1;
3173             }
3174
3175             if ($count >= $timeout) {
3176                 if ($force) {
3177                     warn "VM still running - terminating now with SIGTERM\n";
3178                     kill 15, $pid;
3179                 } else {
3180                     die "VM quit/powerdown failed - got timeout\n";
3181                 }
3182             } else {
3183                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3184                 return;
3185             }
3186         } else {
3187             if ($force) {
3188                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3189                 kill 15, $pid;
3190             } else {
3191                 die "VM quit/powerdown failed\n";
3192             }
3193         }
3194
3195         # wait again
3196         $timeout = 10;
3197
3198         my $count = 0;
3199         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3200             $count++;
3201             sleep 1;
3202         }
3203
3204         if ($count >= $timeout) {
3205             warn "VM still running - terminating now with SIGKILL\n";
3206             kill 9, $pid;
3207             sleep 1;
3208         }
3209
3210         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3211    });
3212 }
3213
3214 sub vm_suspend {
3215     my ($vmid, $skiplock) = @_;
3216
3217     lock_config($vmid, sub {
3218
3219         my $conf = load_config($vmid);
3220
3221         check_lock($conf) if !$skiplock;
3222
3223         vm_mon_cmd($vmid, "stop");
3224     });
3225 }
3226
3227 sub vm_resume {
3228     my ($vmid, $skiplock) = @_;
3229
3230     lock_config($vmid, sub {
3231
3232         my $conf = load_config($vmid);
3233
3234         check_lock($conf) if !$skiplock;
3235
3236         vm_mon_cmd($vmid, "cont");
3237     });
3238 }
3239
3240 sub vm_sendkey {
3241     my ($vmid, $skiplock, $key) = @_;
3242
3243     lock_config($vmid, sub {
3244
3245         my $conf = load_config($vmid);
3246
3247         # there is no qmp command, so we use the human monitor command
3248         vm_human_monitor_command($vmid, "sendkey $key");
3249     });
3250 }
3251
3252 sub vm_destroy {
3253     my ($storecfg, $vmid, $skiplock) = @_;
3254
3255     lock_config($vmid, sub {
3256
3257         my $conf = load_config($vmid);
3258
3259         check_lock($conf) if !$skiplock;
3260
3261         if (!check_running($vmid)) {
3262             fairsched_rmnod($vmid); # try to destroy group
3263             destroy_vm($storecfg, $vmid);
3264         } else {
3265             die "VM $vmid is running - destroy failed\n";
3266         }
3267     });
3268 }
3269
3270 # pci helpers
3271
3272 sub file_write {
3273     my ($filename, $buf) = @_;
3274
3275     my $fh = IO::File->new($filename, "w");
3276     return undef if !$fh;
3277
3278     my $res = print $fh $buf;
3279
3280     $fh->close();
3281
3282     return $res;
3283 }
3284
3285 sub pci_device_info {
3286     my ($name) = @_;
3287
3288     my $res;
3289
3290     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3291     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3292
3293     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3294     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3295
3296     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3297     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3298
3299     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3300     return undef if !defined($product) || $product !~ s/^0x//;
3301
3302     $res = {
3303         name => $name,
3304         vendor => $vendor,
3305         product => $product,
3306         domain => $domain,
3307         bus => $bus,
3308         slot => $slot,
3309         func => $func,
3310         irq => $irq,
3311         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3312     };
3313
3314     return $res;
3315 }
3316
3317 sub pci_dev_reset {
3318     my ($dev) = @_;
3319
3320     my $name = $dev->{name};
3321
3322     my $fn = "$pcisysfs/devices/$name/reset";
3323
3324     return file_write($fn, "1");
3325 }
3326
3327 sub pci_dev_bind_to_stub {
3328     my ($dev) = @_;
3329
3330     my $name = $dev->{name};
3331
3332     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3333     return 1 if -d $testdir;
3334
3335     my $data = "$dev->{vendor} $dev->{product}";
3336     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3337
3338     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3339     if (!file_write($fn, $name)) {
3340         return undef if -f $fn;
3341     }
3342
3343     $fn = "$pcisysfs/drivers/pci-stub/bind";
3344     if (! -d $testdir) {
3345         return undef if !file_write($fn, $name);
3346     }
3347
3348     return -d $testdir;
3349 }
3350
3351 sub print_pci_addr {
3352     my ($id, $bridges) = @_;
3353
3354     my $res = '';
3355     my $devices = {
3356         #addr1 : ide,parallel,serial (motherboard)
3357         #addr2 : first videocard
3358         balloon0 => { bus => 0, addr => 3 },
3359         watchdog => { bus => 0, addr => 4 },
3360         scsihw0 => { bus => 0, addr => 5 },
3361         scsihw1 => { bus => 0, addr => 6 },
3362         ahci0 => { bus => 0, addr => 7 },
3363         qga0 => { bus => 0, addr => 8 },
3364         virtio0 => { bus => 0, addr => 10 },
3365         virtio1 => { bus => 0, addr => 11 },
3366         virtio2 => { bus => 0, addr => 12 },
3367         virtio3 => { bus => 0, addr => 13 },
3368         virtio4 => { bus => 0, addr => 14 },
3369         virtio5 => { bus => 0, addr => 15 },
3370         hostpci0 => { bus => 0, addr => 16 },
3371         hostpci1 => { bus => 0, addr => 17 },
3372         net0 => { bus => 0, addr => 18 },
3373         net1 => { bus => 0, addr => 19 },
3374         net2 => { bus => 0, addr => 20 },
3375         net3 => { bus => 0, addr => 21 },
3376         net4 => { bus => 0, addr => 22 },
3377         net5 => { bus => 0, addr => 23 },
3378         #addr29 : usb-host (pve-usb.cfg)
3379         'pci.1' => { bus => 0, addr => 30 },
3380         'pci.2' => { bus => 0, addr => 31 },
3381         'net6' => { bus => 1, addr => 1 },
3382         'net7' => { bus => 1, addr => 2 },
3383         'net8' => { bus => 1, addr => 3 },
3384         'net9' => { bus => 1, addr => 4 },
3385         'net10' => { bus => 1, addr => 5 },
3386         'net11' => { bus => 1, addr => 6 },
3387         'net12' => { bus => 1, addr => 7 },
3388         'net13' => { bus => 1, addr => 8 },
3389         'net14' => { bus => 1, addr => 9 },
3390         'net15' => { bus => 1, addr => 10 },
3391         'net16' => { bus => 1, addr => 11 },
3392         'net17' => { bus => 1, addr => 12 },
3393         'net18' => { bus => 1, addr => 13 },
3394         'net19' => { bus => 1, addr => 14 },
3395         'net20' => { bus => 1, addr => 15 },
3396         'net21' => { bus => 1, addr => 16 },
3397         'net22' => { bus => 1, addr => 17 },
3398         'net23' => { bus => 1, addr => 18 },
3399         'net24' => { bus => 1, addr => 19 },
3400         'net25' => { bus => 1, addr => 20 },
3401         'net26' => { bus => 1, addr => 21 },
3402         'net27' => { bus => 1, addr => 22 },
3403         'net28' => { bus => 1, addr => 23 },
3404         'net29' => { bus => 1, addr => 24 },
3405         'net30' => { bus => 1, addr => 25 },
3406         'net31' => { bus => 1, addr => 26 },
3407         'virtio6' => { bus => 2, addr => 1 },
3408         'virtio7' => { bus => 2, addr => 2 },
3409         'virtio8' => { bus => 2, addr => 3 },
3410         'virtio9' => { bus => 2, addr => 4 },
3411         'virtio10' => { bus => 2, addr => 5 },
3412         'virtio11' => { bus => 2, addr => 6 },
3413         'virtio12' => { bus => 2, addr => 7 },
3414         'virtio13' => { bus => 2, addr => 8 },
3415         'virtio14' => { bus => 2, addr => 9 },
3416         'virtio15' => { bus => 2, addr => 10 },
3417     };
3418
3419     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3420            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3421            my $bus = $devices->{$id}->{bus};
3422            $res = ",bus=pci.$bus,addr=$addr";
3423            $bridges->{$bus} = 1 if $bridges;
3424     }
3425     return $res;
3426
3427 }
3428
3429 # vzdump restore implementaion
3430
3431 sub tar_archive_read_firstfile {
3432     my $archive = shift;
3433
3434     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3435
3436     # try to detect archive type first
3437     my $pid = open (TMP, "tar tf '$archive'|") ||
3438         die "unable to open file '$archive'\n";
3439     my $firstfile = <TMP>;
3440     kill 15, $pid;
3441     close TMP;
3442
3443     die "ERROR: archive contaions no data\n" if !$firstfile;
3444     chomp $firstfile;
3445
3446     return $firstfile;
3447 }
3448
3449 sub tar_restore_cleanup {
3450     my ($storecfg, $statfile) = @_;
3451
3452     print STDERR "starting cleanup\n";
3453
3454     if (my $fd = IO::File->new($statfile, "r")) {
3455         while (defined(my $line = <$fd>)) {
3456             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3457                 my $volid = $2;
3458                 eval {
3459                     if ($volid =~ m|^/|) {
3460                         unlink $volid || die 'unlink failed\n';
3461                     } else {
3462                         PVE::Storage::vdisk_free($storecfg, $volid);
3463                     }
3464                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3465                 };
3466                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3467             } else {
3468                 print STDERR "unable to parse line in statfile - $line";
3469             }
3470         }
3471         $fd->close();
3472     }
3473 }
3474
3475 sub restore_archive {
3476     my ($archive, $vmid, $user, $opts) = @_;
3477
3478     my $format = $opts->{format};
3479     my $comp;
3480
3481     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3482         $format = 'tar' if !$format;
3483         $comp = 'gzip';
3484     } elsif ($archive =~ m/\.tar$/) {
3485         $format = 'tar' if !$format;
3486     } elsif ($archive =~ m/.tar.lzo$/) {
3487         $format = 'tar' if !$format;
3488         $comp = 'lzop';
3489     } elsif ($archive =~ m/\.vma$/) {
3490         $format = 'vma' if !$format;
3491     } elsif ($archive =~ m/\.vma\.gz$/) {
3492         $format = 'vma' if !$format;
3493         $comp = 'gzip';
3494     } elsif ($archive =~ m/\.vma\.lzo$/) {
3495         $format = 'vma' if !$format;
3496         $comp = 'lzop';
3497     } else {
3498         $format = 'vma' if !$format; # default
3499     }
3500
3501     # try to detect archive format
3502     if ($format eq 'tar') {
3503         return restore_tar_archive($archive, $vmid, $user, $opts);
3504     } else {
3505         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3506     }
3507 }
3508
3509 sub restore_update_config_line {
3510     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3511
3512     return if $line =~ m/^\#qmdump\#/;
3513     return if $line =~ m/^\#vzdump\#/;
3514     return if $line =~ m/^lock:/;
3515     return if $line =~ m/^unused\d+:/;
3516     return if $line =~ m/^parent:/;
3517
3518     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3519         # try to convert old 1.X settings
3520         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3521         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3522             my ($model, $macaddr) = split(/\=/, $devconfig);
3523             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3524             my $net = {
3525                 model => $model,
3526                 bridge => "vmbr$ind",
3527                 macaddr => $macaddr,
3528             };
3529             my $netstr = print_net($net);
3530
3531             print $outfd "net$cookie->{netcount}: $netstr\n";
3532             $cookie->{netcount}++;
3533         }
3534     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3535         my ($id, $netstr) = ($1, $2);
3536         my $net = parse_net($netstr);
3537         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3538         $netstr = print_net($net);
3539         print $outfd "$id: $netstr\n";
3540     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3541         my $virtdev = $1;
3542         my $value = $2;
3543         if ($line =~ m/backup=no/) {
3544             print $outfd "#$line";
3545         } elsif ($virtdev && $map->{$virtdev}) {
3546             my $di = parse_drive($virtdev, $value);
3547             $di->{file} = $map->{$virtdev};
3548             $value = print_drive($vmid, $di);
3549             print $outfd "$virtdev: $value\n";
3550         } else {
3551             print $outfd $line;
3552         }
3553     } else {
3554         print $outfd $line;
3555     }
3556 }
3557
3558 sub scan_volids {
3559     my ($cfg, $vmid) = @_;
3560
3561     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3562
3563     my $volid_hash = {};
3564     foreach my $storeid (keys %$info) {
3565         foreach my $item (@{$info->{$storeid}}) {
3566             next if !($item->{volid} && $item->{size});
3567             $volid_hash->{$item->{volid}} = $item;
3568         }
3569     }
3570
3571     return $volid_hash;
3572 }
3573
3574 sub update_disksize {
3575     my ($vmid, $conf, $volid_hash) = @_;
3576
3577     my $changes;
3578
3579     my $used = {};
3580
3581     # update size info
3582     foreach my $opt (keys %$conf) {
3583         if (valid_drivename($opt)) {
3584             my $drive = parse_drive($opt, $conf->{$opt});
3585             my $volid = $drive->{file};
3586             next if !$volid;
3587
3588             $used->{$volid} = 1;
3589
3590             next if drive_is_cdrom($drive);
3591             next if !$volid_hash->{$volid};
3592
3593             $drive->{size} = $volid_hash->{$volid}->{size};
3594             $changes = 1;
3595             $conf->{$opt} = print_drive($vmid, $drive);
3596         }
3597     }
3598
3599     foreach my $volid (sort keys %$volid_hash) {
3600         next if $volid =~ m/vm-$vmid-state-/;
3601         next if $used->{$volid};
3602         $changes = 1;
3603         add_unused_volume($conf, $volid);
3604     }
3605
3606     return $changes;
3607 }
3608
3609 sub rescan {
3610     my ($vmid, $nolock) = @_;
3611
3612     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3613
3614     my $volid_hash = scan_volids($cfg, $vmid);
3615
3616     my $updatefn =  sub {
3617         my ($vmid) = @_;
3618
3619         my $conf = load_config($vmid);
3620
3621         check_lock($conf);
3622
3623         my $changes = update_disksize($vmid, $conf, $volid_hash);
3624
3625         update_config_nolock($vmid, $conf, 1) if $changes;
3626     };
3627
3628     if (defined($vmid)) {
3629         if ($nolock) {
3630             &$updatefn($vmid);
3631         } else {
3632             lock_config($vmid, $updatefn, $vmid);
3633         }
3634     } else {
3635         my $vmlist = config_list();
3636         foreach my $vmid (keys %$vmlist) {
3637             if ($nolock) {
3638                 &$updatefn($vmid);
3639             } else {
3640                 lock_config($vmid, $updatefn, $vmid);
3641             }
3642         }
3643     }
3644 }
3645
3646 sub restore_vma_archive {
3647     my ($archive, $vmid, $user, $opts, $comp) = @_;
3648
3649     my $input = $archive eq '-' ? "<&STDIN" : undef;
3650     my $readfrom = $archive;
3651
3652     my $uncomp = '';
3653     if ($comp) {
3654         $readfrom = '-';
3655         my $qarchive = PVE::Tools::shellquote($archive);
3656         if ($comp eq 'gzip') {
3657             $uncomp = "zcat $qarchive|";
3658         } elsif ($comp eq 'lzop') {
3659             $uncomp = "lzop -d -c $qarchive|";
3660         } else {
3661             die "unknown compression method '$comp'\n";
3662         }
3663
3664     }
3665
3666     my $tmpdir = "/var/tmp/vzdumptmp$$";
3667     rmtree $tmpdir;
3668
3669     # disable interrupts (always do cleanups)
3670     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3671         warn "got interrupt - ignored\n";
3672     };
3673
3674     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3675     POSIX::mkfifo($mapfifo, 0600);
3676     my $fifofh;
3677
3678     my $openfifo = sub {
3679         open($fifofh, '>', $mapfifo) || die $!;
3680     };
3681
3682     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3683
3684     my $oldtimeout;
3685     my $timeout = 5;
3686
3687     my $devinfo = {};
3688
3689     my $rpcenv = PVE::RPCEnvironment::get();
3690
3691     my $conffile = config_file($vmid);
3692     my $tmpfn = "$conffile.$$.tmp";
3693
3694     # Note: $oldconf is undef if VM does not exists
3695     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
3696
3697     my $print_devmap = sub {
3698         my $virtdev_hash = {};
3699
3700         my $cfgfn = "$tmpdir/qemu-server.conf";
3701
3702         # we can read the config - that is already extracted
3703         my $fh = IO::File->new($cfgfn, "r") ||
3704             "unable to read qemu-server.conf - $!\n";
3705
3706         while (defined(my $line = <$fh>)) {
3707             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3708                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3709                 die "archive does not contain data for drive '$virtdev'\n"
3710                     if !$devinfo->{$devname};
3711                 if (defined($opts->{storage})) {
3712                     $storeid = $opts->{storage} || 'local';
3713                 } elsif (!$storeid) {
3714                     $storeid = 'local';
3715                 }
3716                 $format = 'raw' if !$format;
3717                 $devinfo->{$devname}->{devname} = $devname;
3718                 $devinfo->{$devname}->{virtdev} = $virtdev;
3719                 $devinfo->{$devname}->{format} = $format;
3720                 $devinfo->{$devname}->{storeid} = $storeid;
3721
3722                 # check permission on storage
3723                 my $pool = $opts->{pool}; # todo: do we need that?
3724                 if ($user ne 'root@pam') {
3725                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3726                 }
3727
3728                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3729             }
3730         }
3731
3732         foreach my $devname (keys %$devinfo) {
3733             die "found no device mapping information for device '$devname'\n"
3734                 if !$devinfo->{$devname}->{virtdev};
3735         }
3736
3737         my $cfg = cfs_read_file('storage.cfg');
3738
3739         # create empty/temp config
3740         if ($oldconf) {
3741             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
3742             foreach_drive($oldconf, sub {
3743                 my ($ds, $drive) = @_;
3744
3745                 return if drive_is_cdrom($drive);
3746
3747                 my $volid = $drive->{file};
3748
3749                 return if !$volid || $volid =~ m|^/|;
3750
3751                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
3752                 return if !$path || !$owner || ($owner != $vmid);
3753
3754                 # Note: only delete disk we want to restore
3755                 # other volumes will become unused
3756                 if ($virtdev_hash->{$ds}) {
3757                     PVE::Storage::vdisk_free($cfg, $volid);
3758                 }
3759             });
3760         }
3761
3762         my $map = {};
3763         foreach my $virtdev (sort keys %$virtdev_hash) {
3764             my $d = $virtdev_hash->{$virtdev};
3765             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
3766             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
3767             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
3768                                                   $d->{format}, undef, $alloc_size);
3769             print STDERR "new volume ID is '$volid'\n";
3770             $d->{volid} = $volid;
3771             my $path = PVE::Storage::path($cfg, $volid);
3772
3773             my $write_zeros = 1;
3774             # fixme: what other storages types initialize volumes with zero?
3775             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs') {
3776                 $write_zeros = 0;
3777             }
3778
3779             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3780
3781             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3782             $map->{$virtdev} = $volid;
3783         }
3784
3785         $fh->seek(0, 0) || die "seek failed - $!\n";
3786
3787         my $outfd = new IO::File ($tmpfn, "w") ||
3788             die "unable to write config for VM $vmid\n";
3789
3790         my $cookie = { netcount => 0 };
3791         while (defined(my $line = <$fh>)) {
3792             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3793         }
3794
3795         $fh->close();
3796         $outfd->close();
3797     };
3798
3799     eval {
3800         # enable interrupts
3801         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3802             die "interrupted by signal\n";
3803         };
3804         local $SIG{ALRM} = sub { die "got timeout\n"; };
3805
3806         $oldtimeout = alarm($timeout);
3807
3808         my $parser = sub {
3809             my $line = shift;
3810
3811             print "$line\n";
3812
3813             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3814                 my ($dev_id, $size, $devname) = ($1, $2, $3);
3815                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
3816             } elsif ($line =~ m/^CTIME: /) {
3817                 &$print_devmap();
3818                 print $fifofh "done\n";
3819                 my $tmp = $oldtimeout || 0;
3820                 $oldtimeout = undef;
3821                 alarm($tmp);
3822                 close($fifofh);
3823             }
3824         };
3825
3826         print "restore vma archive: $cmd\n";
3827         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
3828     };
3829     my $err = $@;
3830
3831     alarm($oldtimeout) if $oldtimeout;
3832
3833     unlink $mapfifo;
3834
3835     if ($err) {
3836         rmtree $tmpdir;
3837         unlink $tmpfn;
3838
3839         my $cfg = cfs_read_file('storage.cfg');
3840         foreach my $devname (keys %$devinfo) {
3841             my $volid = $devinfo->{$devname}->{volid};
3842             next if !$volid;
3843             eval {
3844                 if ($volid =~ m|^/|) {
3845                     unlink $volid || die 'unlink failed\n';
3846                 } else {
3847                     PVE::Storage::vdisk_free($cfg, $volid);
3848                 }
3849                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
3850             };
3851             print STDERR "unable to cleanup '$volid' - $@" if $@;
3852         }
3853         die $err;
3854     }
3855
3856     rmtree $tmpdir;
3857
3858     rename($tmpfn, $conffile) ||
3859         die "unable to commit configuration file '$conffile'\n";
3860
3861     PVE::Cluster::cfs_update(); # make sure we read new file
3862
3863     eval { rescan($vmid, 1); };
3864     warn $@ if $@;
3865 }
3866
3867 sub restore_tar_archive {
3868     my ($archive, $vmid, $user, $opts) = @_;
3869
3870     if ($archive ne '-') {
3871         my $firstfile = tar_archive_read_firstfile($archive);
3872         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3873             if $firstfile ne 'qemu-server.conf';
3874     }
3875
3876     my $storecfg = cfs_read_file('storage.cfg');
3877     # destroy existing data - keep empty config
3878     destroy_vm($storecfg, $vmid, 1);
3879
3880     my $tocmd = "/usr/lib/qemu-server/qmextract";
3881
3882     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3883     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3884     $tocmd .= ' --prealloc' if $opts->{prealloc};
3885     $tocmd .= ' --info' if $opts->{info};
3886
3887     # tar option "xf" does not autodetect compression when read from STDIN,
3888     # so we pipe to zcat
3889     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3890         PVE::Tools::shellquote("--to-command=$tocmd");
3891
3892     my $tmpdir = "/var/tmp/vzdumptmp$$";
3893     mkpath $tmpdir;
3894
3895     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3896     local $ENV{VZDUMP_VMID} = $vmid;
3897     local $ENV{VZDUMP_USER} = $user;
3898
3899     my $conffile = config_file($vmid);
3900     my $tmpfn = "$conffile.$$.tmp";
3901
3902     # disable interrupts (always do cleanups)
3903     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3904         print STDERR "got interrupt - ignored\n";
3905     };
3906
3907     eval {
3908         # enable interrupts
3909         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3910             die "interrupted by signal\n";
3911         };
3912
3913         if ($archive eq '-') {
3914             print "extracting archive from STDIN\n";
3915             run_command($cmd, input => "<&STDIN");
3916         } else {
3917             print "extracting archive '$archive'\n";
3918             run_command($cmd);
3919         }
3920
3921         return if $opts->{info};
3922
3923         # read new mapping
3924         my $map = {};
3925         my $statfile = "$tmpdir/qmrestore.stat";
3926         if (my $fd = IO::File->new($statfile, "r")) {
3927             while (defined (my $line = <$fd>)) {
3928                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3929                     $map->{$1} = $2 if $1;
3930                 } else {
3931                     print STDERR "unable to parse line in statfile - $line\n";
3932                 }
3933             }
3934             $fd->close();
3935         }
3936
3937         my $confsrc = "$tmpdir/qemu-server.conf";
3938
3939         my $srcfd = new IO::File($confsrc, "r") ||
3940             die "unable to open file '$confsrc'\n";
3941
3942         my $outfd = new IO::File ($tmpfn, "w") ||
3943             die "unable to write config for VM $vmid\n";
3944
3945         my $cookie = { netcount => 0 };
3946         while (defined (my $line = <$srcfd>)) {
3947             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3948         }
3949
3950         $srcfd->close();
3951         $outfd->close();
3952     };
3953     my $err = $@;
3954
3955     if ($err) {
3956
3957         unlink $tmpfn;
3958
3959         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
3960
3961         die $err;
3962     }
3963
3964     rmtree $tmpdir;
3965
3966     rename $tmpfn, $conffile ||
3967         die "unable to commit configuration file '$conffile'\n";
3968
3969     PVE::Cluster::cfs_update(); # make sure we read new file
3970
3971     eval { rescan($vmid, 1); };
3972     warn $@ if $@;
3973 };
3974
3975
3976 # Internal snapshots
3977
3978 # NOTE: Snapshot create/delete involves several non-atomic
3979 # action, and can take a long time.
3980 # So we try to avoid locking the file and use 'lock' variable
3981 # inside the config file instead.
3982
3983 my $snapshot_copy_config = sub {
3984     my ($source, $dest) = @_;
3985
3986     foreach my $k (keys %$source) {
3987         next if $k eq 'snapshots';
3988         next if $k eq 'snapstate';
3989         next if $k eq 'snaptime';
3990         next if $k eq 'vmstate';
3991         next if $k eq 'lock';
3992         next if $k eq 'digest';
3993         next if $k eq 'description';
3994         next if $k =~ m/^unused\d+$/;
3995
3996         $dest->{$k} = $source->{$k};
3997     }
3998 };
3999
4000 my $snapshot_apply_config = sub {
4001     my ($conf, $snap) = @_;
4002
4003     # copy snapshot list
4004     my $newconf = {
4005         snapshots => $conf->{snapshots},
4006     };
4007
4008     # keep description and list of unused disks
4009     foreach my $k (keys %$conf) {
4010         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4011         $newconf->{$k} = $conf->{$k};
4012     }
4013
4014     &$snapshot_copy_config($snap, $newconf);
4015
4016     return $newconf;
4017 };
4018
4019 sub foreach_writable_storage {
4020     my ($conf, $func) = @_;
4021
4022     my $sidhash = {};
4023
4024     foreach my $ds (keys %$conf) {
4025         next if !valid_drivename($ds);
4026
4027         my $drive = parse_drive($ds, $conf->{$ds});
4028         next if !$drive;
4029         next if drive_is_cdrom($drive);
4030
4031         my $volid = $drive->{file};
4032
4033         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4034         $sidhash->{$sid} = $sid if $sid;
4035     }
4036
4037     foreach my $sid (sort keys %$sidhash) {
4038         &$func($sid);
4039     }
4040 }
4041
4042 my $alloc_vmstate_volid = sub {
4043     my ($storecfg, $vmid, $conf, $snapname) = @_;
4044
4045     # Note: we try to be smart when selecting a $target storage
4046
4047     my $target;
4048
4049     # search shared storage first
4050     foreach_writable_storage($conf, sub {
4051         my ($sid) = @_;
4052         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4053         return if !$scfg->{shared};
4054
4055         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4056     });
4057
4058     if (!$target) {
4059         # now search local storage
4060         foreach_writable_storage($conf, sub {
4061             my ($sid) = @_;
4062             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4063             return if $scfg->{shared};
4064
4065             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4066         });
4067     }
4068
4069     $target = 'local' if !$target;
4070
4071     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4072     # we abort live save after $conf->{memory}, so we need at max twice that space
4073     my $size = $conf->{memory}*2 + $driver_state_size;
4074
4075     my $name = "vm-$vmid-state-$snapname";
4076     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4077     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4078     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4079
4080     return $volid;
4081 };
4082
4083 my $snapshot_prepare = sub {
4084     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4085
4086     my $snap;
4087
4088     my $updatefn =  sub {
4089
4090         my $conf = load_config($vmid);
4091
4092         check_lock($conf);
4093
4094         $conf->{lock} = 'snapshot';
4095
4096         die "snapshot name '$snapname' already used\n"
4097             if defined($conf->{snapshots}->{$snapname});
4098
4099         my $storecfg = PVE::Storage::config();
4100         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4101
4102         $snap = $conf->{snapshots}->{$snapname} = {};
4103
4104         if ($save_vmstate && check_running($vmid)) {
4105             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4106         }
4107
4108         &$snapshot_copy_config($conf, $snap);
4109
4110         $snap->{snapstate} = "prepare";
4111         $snap->{snaptime} = time();
4112         $snap->{description} = $comment if $comment;
4113
4114         update_config_nolock($vmid, $conf, 1);
4115     };
4116
4117     lock_config($vmid, $updatefn);
4118
4119     return $snap;
4120 };
4121
4122 my $snapshot_commit = sub {
4123     my ($vmid, $snapname) = @_;
4124
4125     my $updatefn = sub {
4126
4127         my $conf = load_config($vmid);
4128
4129         die "missing snapshot lock\n"
4130             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4131
4132         my $snap = $conf->{snapshots}->{$snapname};
4133
4134         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4135
4136         die "wrong snapshot state\n"
4137             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4138
4139         delete $snap->{snapstate};
4140         delete $conf->{lock};
4141
4142         my $newconf = &$snapshot_apply_config($conf, $snap);
4143
4144         $newconf->{parent} = $snapname;
4145
4146         update_config_nolock($vmid, $newconf, 1);
4147     };
4148
4149     lock_config($vmid, $updatefn);
4150 };
4151
4152 sub snapshot_rollback {
4153     my ($vmid, $snapname) = @_;
4154
4155     my $snap;
4156
4157     my $prepare = 1;
4158
4159     my $storecfg = PVE::Storage::config();
4160
4161     my $updatefn = sub {
4162
4163         my $conf = load_config($vmid);
4164
4165         $snap = $conf->{snapshots}->{$snapname};
4166
4167         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4168
4169         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4170             if $snap->{snapstate};
4171
4172         if ($prepare) {
4173             check_lock($conf);
4174             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4175         }
4176
4177         die "unable to rollback vm $vmid: vm is running\n"
4178             if check_running($vmid);
4179
4180         if ($prepare) {
4181             $conf->{lock} = 'rollback';
4182         } else {
4183             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4184             delete $conf->{lock};
4185         }
4186
4187         if (!$prepare) {
4188             # copy snapshot config to current config
4189             $conf = &$snapshot_apply_config($conf, $snap);
4190             $conf->{parent} = $snapname;
4191         }
4192
4193         update_config_nolock($vmid, $conf, 1);
4194
4195         if (!$prepare && $snap->{vmstate}) {
4196             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4197             vm_start($storecfg, $vmid, $statefile);
4198         }
4199     };
4200
4201     lock_config($vmid, $updatefn);
4202
4203     foreach_drive($snap, sub {
4204         my ($ds, $drive) = @_;
4205
4206         return if drive_is_cdrom($drive);
4207
4208         my $volid = $drive->{file};
4209         my $device = "drive-$ds";
4210
4211         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4212     });
4213
4214     $prepare = 0;
4215     lock_config($vmid, $updatefn);
4216 }
4217
4218 my $savevm_wait = sub {
4219     my ($vmid) = @_;
4220
4221     for(;;) {
4222         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4223         if (!$stat->{status}) {
4224             die "savevm not active\n";
4225         } elsif ($stat->{status} eq 'active') {
4226             sleep(1);
4227             next;
4228         } elsif ($stat->{status} eq 'completed') {
4229             last;
4230         } else {
4231             die "query-savevm returned status '$stat->{status}'\n";
4232         }
4233     }
4234 };
4235
4236 sub snapshot_create {
4237     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4238
4239     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4240
4241     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4242
4243     my $drivehash = {};
4244
4245     my $running = check_running($vmid);
4246
4247     eval {
4248         # create internal snapshots of all drives
4249
4250         my $storecfg = PVE::Storage::config();
4251
4252         if ($running) {
4253             if ($snap->{vmstate}) {
4254                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4255                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4256                 &$savevm_wait($vmid);
4257             } else {
4258                 vm_mon_cmd($vmid, "savevm-start");
4259             }
4260         };
4261
4262         qga_freezefs($vmid) if $running && $freezefs;
4263
4264         foreach_drive($snap, sub {
4265             my ($ds, $drive) = @_;
4266
4267             return if drive_is_cdrom($drive);
4268
4269             my $volid = $drive->{file};
4270             my $device = "drive-$ds";
4271
4272             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4273             $drivehash->{$ds} = 1;
4274        });
4275     };
4276     my $err = $@;
4277
4278     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
4279     warn $@ if $@;
4280
4281     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4282     warn $@ if $@;
4283
4284     if ($err) {
4285         warn "snapshot create failed: starting cleanup\n";
4286         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4287         warn $@ if $@;
4288         die $err;
4289     }
4290
4291     &$snapshot_commit($vmid, $snapname);
4292 }
4293
4294 # Note: $drivehash is only set when called from snapshot_create.
4295 sub snapshot_delete {
4296     my ($vmid, $snapname, $force, $drivehash) = @_;
4297
4298     my $prepare = 1;
4299
4300     my $snap;
4301     my $unused = [];
4302
4303     my $unlink_parent = sub {
4304         my ($confref, $new_parent) = @_;
4305
4306         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4307             if ($new_parent) {
4308                 $confref->{parent} = $new_parent;
4309             } else {
4310                 delete $confref->{parent};
4311             }
4312         }
4313     };
4314
4315     my $updatefn =  sub {
4316         my ($remove_drive) = @_;
4317
4318         my $conf = load_config($vmid);
4319
4320         check_lock($conf) if !$drivehash;
4321
4322         $snap = $conf->{snapshots}->{$snapname};
4323
4324         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4325
4326         # remove parent refs
4327         &$unlink_parent($conf, $snap->{parent});
4328         foreach my $sn (keys %{$conf->{snapshots}}) {
4329             next if $sn eq $snapname;
4330             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4331         }
4332
4333         if ($remove_drive) {
4334             if ($remove_drive eq 'vmstate') {
4335                 delete $snap->{$remove_drive};
4336             } else {
4337                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4338                 my $volid = $drive->{file};
4339                 delete $snap->{$remove_drive};
4340                 add_unused_volume($conf, $volid);
4341             }
4342         }
4343
4344         if ($prepare) {
4345             $snap->{snapstate} = 'delete';
4346         } else {
4347             delete $conf->{snapshots}->{$snapname};
4348             delete $conf->{lock} if $drivehash;
4349             foreach my $volid (@$unused) {
4350                 add_unused_volume($conf, $volid);
4351             }
4352         }
4353
4354         update_config_nolock($vmid, $conf, 1);
4355     };
4356
4357     lock_config($vmid, $updatefn);
4358
4359     # now remove vmstate file
4360
4361     my $storecfg = PVE::Storage::config();
4362
4363     if ($snap->{vmstate}) {
4364         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4365         if (my $err = $@) {
4366             die $err if !$force;
4367             warn $err;
4368         }
4369         # save changes (remove vmstate from snapshot)
4370         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4371     };
4372
4373     # now remove all internal snapshots
4374     foreach_drive($snap, sub {
4375         my ($ds, $drive) = @_;
4376
4377         return if drive_is_cdrom($drive);
4378
4379         my $volid = $drive->{file};
4380         my $device = "drive-$ds";
4381
4382         if (!$drivehash || $drivehash->{$ds}) {
4383             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4384             if (my $err = $@) {
4385                 die $err if !$force;
4386                 warn $err;
4387             }
4388         }
4389
4390         # save changes (remove drive fron snapshot)
4391         lock_config($vmid, $updatefn, $ds) if !$force;
4392         push @$unused, $volid;
4393     });
4394
4395     # now cleanup config
4396     $prepare = 0;
4397     lock_config($vmid, $updatefn);
4398 }
4399
4400 sub has_feature{
4401     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4402
4403     my $err = undef;
4404     foreach_drive($conf, sub {
4405         my ($ds, $drive) = @_;
4406
4407         return if drive_is_cdrom($drive);
4408         my $volid = $drive->{file};
4409         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4410     });
4411
4412     return 1 if !$err;
4413 }
4414 1;