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