PVE/QemuServer.pm

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