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