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