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