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