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