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