PVE/QemuServer.pm

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