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