PVE/QemuServer.pm

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