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