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 pvscsi)],
 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 qxl2 qxl3 qxl4)],
 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         next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
1839         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1840     }
1841
1842     die "VM uses local resources\n" if $loc_res && !$noerr;
1843
1844     return $loc_res;
1845 }
1846
1847 # check if used storages are available on all nodes (use by migrate)
1848 sub check_storage_availability {
1849     my ($storecfg, $conf, $node) = @_;
1850
1851     foreach_drive($conf, sub {
1852         my ($ds, $drive) = @_;
1853
1854         my $volid = $drive->{file};
1855         return if !$volid;
1856
1857         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1858         return if !$sid;
1859
1860         # check if storage is available on both nodes
1861         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1862         PVE::Storage::storage_check_node($storecfg, $sid, $node);
1863    });
1864 }
1865
1866 # list nodes where all VM images are available (used by has_feature API)
1867 sub shared_nodes {
1868     my ($conf, $storecfg) = @_;
1869
1870     my $nodelist = PVE::Cluster::get_nodelist();
1871     my $nodehash = { map { $_ => 1 } @$nodelist };
1872     my $nodename = PVE::INotify::nodename();
1873
1874     foreach_drive($conf, sub {
1875         my ($ds, $drive) = @_;
1876
1877         my $volid = $drive->{file};
1878         return if !$volid;
1879
1880         my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1881         if ($storeid) {
1882             my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
1883             if ($scfg->{disable}) {
1884                 $nodehash = {};
1885             } elsif (my $avail = $scfg->{nodes}) {
1886                 foreach my $node (keys %$nodehash) {
1887                     delete $nodehash->{$node} if !$avail->{$node};
1888                 }
1889             } elsif (!$scfg->{shared}) {
1890                 foreach my $node (keys %$nodehash) {
1891                     delete $nodehash->{$node} if $node ne $nodename
1892                 }
1893             }
1894         }
1895     });
1896
1897     return $nodehash
1898 }
1899
1900 sub check_lock {
1901     my ($conf) = @_;
1902
1903     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1904 }
1905
1906 sub check_cmdline {
1907     my ($pidfile, $pid) = @_;
1908
1909     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1910     if (defined($fh)) {
1911         my $line = <$fh>;
1912         $fh->close;
1913         return undef if !$line;
1914         my @param = split(/\0/, $line);
1915
1916         my $cmd = $param[0];
1917         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m|qemu-system-x86_64$|);
1918
1919         for (my $i = 0; $i < scalar (@param); $i++) {
1920             my $p = $param[$i];
1921             next if !$p;
1922             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1923                 my $p = $param[$i+1];
1924                 return 1 if $p && ($p eq $pidfile);
1925                 return undef;
1926             }
1927         }
1928     }
1929     return undef;
1930 }
1931
1932 sub check_running {
1933     my ($vmid, $nocheck, $node) = @_;
1934
1935     my $filename = config_file($vmid, $node);
1936
1937     die "unable to find configuration file for VM $vmid - no such machine\n"
1938         if !$nocheck && ! -f $filename;
1939
1940     my $pidfile = pidfile_name($vmid);
1941
1942     if (my $fd = IO::File->new("<$pidfile")) {
1943         my $st = stat($fd);
1944         my $line = <$fd>;
1945         close($fd);
1946
1947         my $mtime = $st->mtime;
1948         if ($mtime > time()) {
1949             warn "file '$filename' modified in future\n";
1950         }
1951
1952         if ($line =~ m/^(\d+)$/) {
1953             my $pid = $1;
1954             if (check_cmdline($pidfile, $pid)) {
1955                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1956                     return $pid;
1957                 }
1958             }
1959         }
1960     }
1961
1962     return undef;
1963 }
1964
1965 sub vzlist {
1966
1967     my $vzlist = config_list();
1968
1969     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1970
1971     while (defined(my $de = $fd->read)) {
1972         next if $de !~ m/^(\d+)\.pid$/;
1973         my $vmid = $1;
1974         next if !defined($vzlist->{$vmid});
1975         if (my $pid = check_running($vmid)) {
1976             $vzlist->{$vmid}->{pid} = $pid;
1977         }
1978     }
1979
1980     return $vzlist;
1981 }
1982
1983 sub disksize {
1984     my ($storecfg, $conf) = @_;
1985
1986     my $bootdisk = $conf->{bootdisk};
1987     return undef if !$bootdisk;
1988     return undef if !valid_drivename($bootdisk);
1989
1990     return undef if !$conf->{$bootdisk};
1991
1992     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1993     return undef if !defined($drive);
1994
1995     return undef if drive_is_cdrom($drive);
1996
1997     my $volid = $drive->{file};
1998     return undef if !$volid;
1999
2000     return $drive->{size};
2001 }
2002
2003 my $last_proc_pid_stat;
2004
2005 # get VM status information
2006 # This must be fast and should not block ($full == false)
2007 # We only query KVM using QMP if $full == true (this can be slow)
2008 sub vmstatus {
2009     my ($opt_vmid, $full) = @_;
2010
2011     my $res = {};
2012
2013     my $storecfg = PVE::Storage::config();
2014
2015     my $list = vzlist();
2016     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
2017
2018     my $cpucount = $cpuinfo->{cpus} || 1;
2019
2020     foreach my $vmid (keys %$list) {
2021         next if $opt_vmid && ($vmid ne $opt_vmid);
2022
2023         my $cfspath = cfs_config_path($vmid);
2024         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
2025
2026         my $d = {};
2027         $d->{pid} = $list->{$vmid}->{pid};
2028
2029         # fixme: better status?
2030         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
2031
2032         my $size = disksize($storecfg, $conf);
2033         if (defined($size)) {
2034             $d->{disk} = 0; # no info available
2035             $d->{maxdisk} = $size;
2036         } else {
2037             $d->{disk} = 0;
2038             $d->{maxdisk} = 0;
2039         }
2040
2041         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
2042         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
2043
2044         $d->{name} = $conf->{name} || "VM $vmid";
2045         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2046
2047         if ($conf->{balloon}) {
2048             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2049             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2050         }
2051
2052         $d->{uptime} = 0;
2053         $d->{cpu} = 0;
2054         $d->{mem} = 0;
2055
2056         $d->{netout} = 0;
2057         $d->{netin} = 0;
2058
2059         $d->{diskread} = 0;
2060         $d->{diskwrite} = 0;
2061
2062         $d->{template} = is_template($conf);
2063
2064         $res->{$vmid} = $d;
2065     }
2066
2067     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2068     foreach my $dev (keys %$netdev) {
2069         next if $dev !~ m/^tap([1-9]\d*)i/;
2070         my $vmid = $1;
2071         my $d = $res->{$vmid};
2072         next if !$d;
2073
2074         $d->{netout} += $netdev->{$dev}->{receive};
2075         $d->{netin} += $netdev->{$dev}->{transmit};
2076     }
2077
2078     my $ctime = gettimeofday;
2079
2080     foreach my $vmid (keys %$list) {
2081
2082         my $d = $res->{$vmid};
2083         my $pid = $d->{pid};
2084         next if !$pid;
2085
2086         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2087         next if !$pstat; # not running
2088
2089         my $used = $pstat->{utime} + $pstat->{stime};
2090
2091         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2092
2093         if ($pstat->{vsize}) {
2094             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2095         }
2096
2097         my $old = $last_proc_pid_stat->{$pid};
2098         if (!$old) {
2099             $last_proc_pid_stat->{$pid} = {
2100                 time => $ctime,
2101                 used => $used,
2102                 cpu => 0,
2103             };
2104             next;
2105         }
2106
2107         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2108
2109         if ($dtime > 1000) {
2110             my $dutime = $used -  $old->{used};
2111
2112             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2113             $last_proc_pid_stat->{$pid} = {
2114                 time => $ctime,
2115                 used => $used,
2116                 cpu => $d->{cpu},
2117             };
2118         } else {
2119             $d->{cpu} = $old->{cpu};
2120         }
2121     }
2122
2123     return $res if !$full;
2124
2125     my $qmpclient = PVE::QMPClient->new();
2126
2127     my $ballooncb = sub {
2128         my ($vmid, $resp) = @_;
2129
2130         my $info = $resp->{'return'};
2131         return if !$info->{max_mem};
2132
2133         my $d = $res->{$vmid};
2134
2135         # use memory assigned to VM
2136         $d->{maxmem} = $info->{max_mem};
2137         $d->{balloon} = $info->{actual};
2138
2139         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2140             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2141             $d->{freemem} = $info->{free_mem};
2142         }
2143
2144     };
2145
2146     my $blockstatscb = sub {
2147         my ($vmid, $resp) = @_;
2148         my $data = $resp->{'return'} || [];
2149         my $totalrdbytes = 0;
2150         my $totalwrbytes = 0;
2151         for my $blockstat (@$data) {
2152             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2153             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2154         }
2155         $res->{$vmid}->{diskread} = $totalrdbytes;
2156         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2157     };
2158
2159     my $statuscb = sub {
2160         my ($vmid, $resp) = @_;
2161
2162         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2163         # this fails if ballon driver is not loaded, so this must be
2164         # the last commnand (following command are aborted if this fails).
2165         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2166
2167         my $status = 'unknown';
2168         if (!defined($status = $resp->{'return'}->{status})) {
2169             warn "unable to get VM status\n";
2170             return;
2171         }
2172
2173         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2174     };
2175
2176     foreach my $vmid (keys %$list) {
2177         next if $opt_vmid && ($vmid ne $opt_vmid);
2178         next if !$res->{$vmid}->{pid}; # not running
2179         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2180     }
2181
2182     $qmpclient->queue_execute();
2183
2184     foreach my $vmid (keys %$list) {
2185         next if $opt_vmid && ($vmid ne $opt_vmid);
2186         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2187     }
2188
2189     return $res;
2190 }
2191
2192 sub foreach_drive {
2193     my ($conf, $func) = @_;
2194
2195     foreach my $ds (keys %$conf) {
2196         next if !valid_drivename($ds);
2197
2198         my $drive = parse_drive($ds, $conf->{$ds});
2199         next if !$drive;
2200
2201         &$func($ds, $drive);
2202     }
2203 }
2204
2205 sub foreach_volid {
2206     my ($conf, $func) = @_;
2207
2208     my $volhash = {};
2209
2210     my $test_volid = sub {
2211         my ($volid, $is_cdrom) = @_;
2212
2213         return if !$volid;
2214
2215         $volhash->{$volid} = $is_cdrom || 0;
2216     };
2217
2218     foreach_drive($conf, sub {
2219         my ($ds, $drive) = @_;
2220         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2221     });
2222
2223     foreach my $snapname (keys %{$conf->{snapshots}}) {
2224         my $snap = $conf->{snapshots}->{$snapname};
2225         &$test_volid($snap->{vmstate}, 0);
2226         foreach_drive($snap, sub {
2227             my ($ds, $drive) = @_;
2228             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2229         });
2230     }
2231
2232     foreach my $volid (keys %$volhash) {
2233         &$func($volid, $volhash->{$volid});
2234     }
2235 }
2236
2237 sub vga_conf_has_spice {
2238     my ($vga) = @_;
2239
2240     return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2241
2242     return $1 || 1;
2243 }
2244
2245 sub config_to_command {
2246     my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2247
2248     my $cmd = [];
2249     my $globalFlags = [];
2250     my $machineFlags = [];
2251     my $rtcFlags = [];
2252     my $cpuFlags = [];
2253     my $devices = [];
2254     my $pciaddr = '';
2255     my $bridges = {};
2256     my $kvmver = kvm_user_version();
2257     my $vernum = 0; # unknown
2258     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2259         $vernum = $1*1000000+$2*1000;
2260     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2261         $vernum = $1*1000000+$2*1000+$3;
2262     }
2263
2264     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2265
2266     my $have_ovz = -f '/proc/vz/vestat';
2267
2268     push @$cmd, '/usr/bin/kvm';
2269
2270     push @$cmd, '-id', $vmid;
2271
2272     my $use_virtio = 0;
2273
2274     my $qmpsocket = qmp_socket($vmid);
2275     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2276     push @$cmd, '-mon', "chardev=qmp,mode=control";
2277
2278     my $socket = vnc_socket($vmid);
2279     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2280
2281     push @$cmd, '-pidfile' , pidfile_name($vmid);
2282
2283     push @$cmd, '-daemonize';
2284
2285     $pciaddr = print_pci_addr("piix3", $bridges);
2286     push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2287
2288     my $use_usb2 = 0;
2289     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2290         next if !$conf->{"usb$i"};
2291         $use_usb2 = 1;
2292     }
2293     # include usb device config
2294     push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2295
2296     my $vga = $conf->{vga};
2297
2298     my $qxlnum = vga_conf_has_spice($vga);
2299     $vga = 'qxl' if $qxlnum;
2300
2301     if (!$vga) {
2302         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' ||
2303                                 $conf->{ostype} eq 'win7' ||
2304                                 $conf->{ostype} eq 'w2k8')) {
2305             $vga = 'std';
2306         } else {
2307             $vga = 'cirrus';
2308         }
2309     }
2310
2311     # enable absolute mouse coordinates (needed by vnc)
2312     my $tablet;
2313     if (defined($conf->{tablet})) {
2314         $tablet = $conf->{tablet};
2315     } else {
2316         $tablet = $defaults->{tablet};
2317         $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2318         $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2319     }
2320
2321     push @$devices, '-device', 'usb-tablet,id=tablet,bus=uhci.0,port=1' if $tablet;
2322
2323     # host pci devices
2324     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2325           my $d = parse_hostpci($conf->{"hostpci$i"});
2326           next if !$d;
2327           $pciaddr = print_pci_addr("hostpci$i", $bridges);
2328           push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2329     }
2330
2331     # usb devices
2332     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2333         my $d = parse_usb_device($conf->{"usb$i"});
2334         next if !$d;
2335         if ($d->{vendorid} && $d->{productid}) {
2336             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2337         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2338             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2339         } elsif ($d->{spice}) {
2340             # usb redir support for spice
2341             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2342             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2343         }
2344     }
2345
2346     # serial devices
2347     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2348         if (my $path = $conf->{"serial$i"}) {
2349             if ($path eq 'socket') {
2350                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2351                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2352                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2353             } else {
2354                 die "no such serial device\n" if ! -c $path;
2355                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2356                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2357             }
2358         }
2359     }
2360
2361     # parallel devices
2362     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2363         if (my $path = $conf->{"parallel$i"}) {
2364             die "no such parallel device\n" if ! -c $path;
2365             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2366             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2367             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2368         }
2369     }
2370
2371     my $vmname = $conf->{name} || "vm$vmid";
2372
2373     push @$cmd, '-name', $vmname;
2374
2375     my $sockets = 1;
2376     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2377     $sockets = $conf->{sockets} if  $conf->{sockets};
2378
2379     my $cores = $conf->{cores} || 1;
2380     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2381
2382     push @$cmd, '-nodefaults';
2383
2384     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2385
2386     my $bootindex_hash = {};
2387     my $i = 1;
2388     foreach my $o (split(//, $bootorder)) {
2389         $bootindex_hash->{$o} = $i*100;
2390         $i++;
2391     }
2392
2393     push @$cmd, '-boot', "menu=on";
2394
2395     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2396
2397     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2398
2399     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2400
2401     # time drift fix
2402     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2403
2404     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2405     my $useLocaltime = $conf->{localtime};
2406
2407     if (my $ost = $conf->{ostype}) {
2408         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2409
2410         if ($ost =~ m/^w/) { # windows
2411             $useLocaltime = 1 if !defined($conf->{localtime});
2412
2413             # use time drift fix when acpi is enabled
2414             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2415                 $tdf = 1 if !defined($conf->{tdf});
2416             }
2417         }
2418
2419         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2420             $ost eq 'wvista') {
2421             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2422             push @$cmd, '-no-hpet';
2423             #push @$cpuFlags , 'hv_vapic" if !$nokvm;  #fixme, my win2008R2 hang at boot with this
2424             push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2425         }
2426
2427         if ($ost eq 'win7' || $ost eq 'win8') {
2428             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2429         }
2430     }
2431
2432     push @$rtcFlags, 'driftfix=slew' if $tdf;
2433
2434     if ($nokvm) {
2435         push @$machineFlags, 'accel=tcg';
2436     } else {
2437         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2438     }
2439
2440     my $machine_type = $forcemachine || $conf->{machine};
2441     if ($machine_type) {
2442         push @$machineFlags, "type=${machine_type}";
2443     }
2444
2445     if ($conf->{startdate}) {
2446         push @$rtcFlags, "base=$conf->{startdate}";
2447     } elsif ($useLocaltime) {
2448         push @$rtcFlags, 'base=localtime';
2449     }
2450
2451     my $cpu = $nokvm ? "qemu64" : "kvm64";
2452     $cpu = $conf->{cpu} if $conf->{cpu};
2453
2454     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2455
2456     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2457
2458     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2459
2460     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2461
2462     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2463
2464     push @$cmd, '-cpu', $cpu;
2465
2466     push @$cmd, '-S' if $conf->{freeze};
2467
2468     # set keyboard layout
2469     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2470     push @$cmd, '-k', $kb if $kb;
2471
2472     # enable sound
2473     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2474     #push @$cmd, '-soundhw', 'es1370';
2475     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2476
2477     if($conf->{agent}) {
2478         my $qgasocket = qga_socket($vmid);
2479         my $pciaddr = print_pci_addr("qga0", $bridges);
2480         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2481         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2482         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2483     }
2484
2485     my $spice_port;
2486
2487     if ($qxlnum) {
2488         if ($qxlnum > 1) {
2489             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
2490                 for(my $i = 1; $i < $qxlnum; $i++){
2491                     my $pciaddr = print_pci_addr("vga$i", $bridges);
2492                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2493                 }
2494             } else {
2495                 # assume other OS works like Linux
2496                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2497                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2498             }
2499         }
2500
2501         my $pciaddr = print_pci_addr("spice", $bridges);
2502
2503         $spice_port = PVE::Tools::next_unused_port(61000, 61099);
2504
2505         push @$cmd, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2506
2507         push @$cmd, '-device', "virtio-serial,id=spice$pciaddr";
2508         push @$cmd, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2509         push @$cmd, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2510     }
2511
2512     # enable balloon by default, unless explicitly disabled
2513     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2514         $pciaddr = print_pci_addr("balloon0", $bridges);
2515         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2516     }
2517
2518     if ($conf->{watchdog}) {
2519         my $wdopts = parse_watchdog($conf->{watchdog});
2520         $pciaddr = print_pci_addr("watchdog", $bridges);
2521         my $watchdog = $wdopts->{model} || 'i6300esb';
2522         push @$devices, '-device', "$watchdog$pciaddr";
2523         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2524     }
2525
2526     my $vollist = [];
2527     my $scsicontroller = {};
2528     my $ahcicontroller = {};
2529     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2530
2531     foreach_drive($conf, sub {
2532         my ($ds, $drive) = @_;
2533
2534         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2535             push @$vollist, $drive->{file};
2536         }
2537
2538         $use_virtio = 1 if $ds =~ m/^virtio/;
2539
2540         if (drive_is_cdrom ($drive)) {
2541             if ($bootindex_hash->{d}) {
2542                 $drive->{bootindex} = $bootindex_hash->{d};
2543                 $bootindex_hash->{d} += 1;
2544             }
2545         } else {
2546             if ($bootindex_hash->{c}) {
2547                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2548                 $bootindex_hash->{c} += 1;
2549             }
2550         }
2551
2552         if ($drive->{interface} eq 'scsi') {
2553
2554             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2555             my $controller = int($drive->{index} / $maxdev);
2556             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2557             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2558             $scsicontroller->{$controller}=1;
2559         }
2560
2561         if ($drive->{interface} eq 'sata') {
2562            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2563            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2564            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2565            $ahcicontroller->{$controller}=1;
2566         }
2567
2568         push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
2569         push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2570     });
2571
2572     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2573
2574     for (my $i = 0; $i < $MAX_NETS; $i++) {
2575          next if !$conf->{"net$i"};
2576          my $d = parse_net($conf->{"net$i"});
2577          next if !$d;
2578
2579          $use_virtio = 1 if $d->{model} eq 'virtio';
2580
2581          if ($bootindex_hash->{n}) {
2582             $d->{bootindex} = $bootindex_hash->{n};
2583             $bootindex_hash->{n} += 1;
2584          }
2585
2586          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2587          push @$devices, '-netdev', $netdevfull;
2588
2589          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2590          push @$devices, '-device', $netdevicefull;
2591     }
2592
2593     #bridges
2594     while (my ($k, $v) = each %$bridges) {
2595         $pciaddr = print_pci_addr("pci.$k");
2596         unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2597     }
2598
2599
2600     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2601     # when the VM uses virtio devices.
2602     if (!$use_virtio && $have_ovz) {
2603
2604         my $cpuunits = defined($conf->{cpuunits}) ?
2605             $conf->{cpuunits} : $defaults->{cpuunits};
2606
2607         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2608
2609         # fixme: cpulimit is currently ignored
2610         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2611     }
2612
2613     # add custom args
2614     if ($conf->{args}) {
2615         my $aa = PVE::Tools::split_args($conf->{args});
2616         push @$cmd, @$aa;
2617     }
2618
2619     push @$cmd, @$devices;
2620     push @$cmd, '-rtc', join(',', @$rtcFlags)
2621         if scalar(@$rtcFlags);
2622     push @$cmd, '-machine', join(',', @$machineFlags)
2623         if scalar(@$machineFlags);
2624     push @$cmd, '-global', join(',', @$globalFlags)
2625         if scalar(@$globalFlags);
2626
2627     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
2628 }
2629
2630 sub vnc_socket {
2631     my ($vmid) = @_;
2632     return "${var_run_tmpdir}/$vmid.vnc";
2633 }
2634
2635 sub spice_port {
2636     my ($vmid) = @_;
2637
2638     my $res = vm_mon_cmd($vmid, 'query-spice');
2639
2640     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2641 }
2642
2643 sub qmp_socket {
2644     my ($vmid) = @_;
2645     return "${var_run_tmpdir}/$vmid.qmp";
2646 }
2647
2648 sub qga_socket {
2649     my ($vmid) = @_;
2650     return "${var_run_tmpdir}/$vmid.qga";
2651 }
2652
2653 sub pidfile_name {
2654     my ($vmid) = @_;
2655     return "${var_run_tmpdir}/$vmid.pid";
2656 }
2657
2658 sub vm_devices_list {
2659     my ($vmid) = @_;
2660
2661     my $res = vm_mon_cmd($vmid, 'query-pci');
2662
2663     my $devices = {};
2664     foreach my $pcibus (@$res) {
2665         foreach my $device (@{$pcibus->{devices}}) {
2666             next if !$device->{'qdev_id'};
2667             $devices->{$device->{'qdev_id'}} = $device;
2668         }
2669     }
2670
2671     return $devices;
2672 }
2673
2674 sub vm_deviceplug {
2675     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2676
2677     return 1 if !check_running($vmid);
2678
2679     if ($deviceid eq 'tablet') {
2680         my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2681         qemu_deviceadd($vmid, $devicefull);
2682         return 1;
2683     }
2684
2685     return 1 if !$conf->{hotplug};
2686
2687     my $devices_list = vm_devices_list($vmid);
2688     return 1 if defined($devices_list->{$deviceid});
2689
2690     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2691
2692     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2693         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2694         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2695         qemu_deviceadd($vmid, $devicefull);
2696         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2697            qemu_drivedel($vmid, $deviceid);
2698            return undef;
2699         }
2700     }
2701
2702     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2703         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2704         my $pciaddr = print_pci_addr($deviceid);
2705         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2706         qemu_deviceadd($vmid, $devicefull);
2707         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2708     }
2709
2710     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2711         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2712         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2713         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2714         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2715         if(!qemu_deviceadd($vmid, $devicefull)) {
2716            qemu_drivedel($vmid, $deviceid);
2717            return undef;
2718         }
2719     }
2720
2721     if ($deviceid =~ m/^(net)(\d+)$/) {
2722         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2723         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2724         qemu_deviceadd($vmid, $netdevicefull);
2725         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2726            qemu_netdevdel($vmid, $deviceid);
2727            return undef;
2728         }
2729     }
2730
2731     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2732         my $bridgeid = $2;
2733         my $pciaddr = print_pci_addr($deviceid);
2734         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2735         qemu_deviceadd($vmid, $devicefull);
2736         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2737     }
2738
2739     return 1;
2740 }
2741
2742 sub vm_deviceunplug {
2743     my ($vmid, $conf, $deviceid) = @_;
2744
2745     return 1 if !check_running ($vmid);
2746
2747     if ($deviceid eq 'tablet') {
2748         qemu_devicedel($vmid, $deviceid);
2749         return 1;
2750     }
2751
2752     return 1 if !$conf->{hotplug};
2753
2754     my $devices_list = vm_devices_list($vmid);
2755     return 1 if !defined($devices_list->{$deviceid});
2756
2757     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2758
2759     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2760         qemu_devicedel($vmid, $deviceid);
2761         return undef if !qemu_devicedelverify($vmid, $deviceid);
2762         return undef if !qemu_drivedel($vmid, $deviceid);
2763     }
2764
2765     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2766         return undef if !qemu_devicedel($vmid, $deviceid);
2767     }
2768
2769     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2770         return undef if !qemu_devicedel($vmid, $deviceid);
2771         return undef if !qemu_drivedel($vmid, $deviceid);
2772     }
2773
2774     if ($deviceid =~ m/^(net)(\d+)$/) {
2775         qemu_devicedel($vmid, $deviceid);
2776         return undef if !qemu_devicedelverify($vmid, $deviceid);
2777         return undef if !qemu_netdevdel($vmid, $deviceid);
2778     }
2779
2780     return 1;
2781 }
2782
2783 sub qemu_deviceadd {
2784     my ($vmid, $devicefull) = @_;
2785
2786     $devicefull = "driver=".$devicefull;
2787     my %options =  split(/[=,]/, $devicefull);
2788
2789     vm_mon_cmd($vmid, "device_add" , %options);
2790     return 1;
2791 }
2792
2793 sub qemu_devicedel {
2794     my($vmid, $deviceid) = @_;
2795     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
2796     return 1;
2797 }
2798
2799 sub qemu_driveadd {
2800     my($storecfg, $vmid, $device) = @_;
2801
2802     my $drive = print_drive_full($storecfg, $vmid, $device);
2803     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2804     # If the command succeeds qemu prints: "OK"
2805     if ($ret !~ m/OK/s) {
2806         syslog("err", "adding drive failed: $ret");
2807         return undef;
2808     }
2809     return 1;
2810 }
2811
2812 sub qemu_drivedel {
2813     my($vmid, $deviceid) = @_;
2814
2815     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2816     $ret =~ s/^\s+//;
2817     if ($ret =~ m/Device \'.*?\' not found/s) {
2818         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2819     }
2820     elsif ($ret ne "") {
2821       syslog("err", "deleting drive $deviceid failed : $ret");
2822       return undef;
2823     }
2824     return 1;
2825 }
2826
2827 sub qemu_deviceaddverify {
2828     my ($vmid,$deviceid) = @_;
2829
2830     for (my $i = 0; $i <= 5; $i++) {
2831          my $devices_list = vm_devices_list($vmid);
2832          return 1 if defined($devices_list->{$deviceid});
2833          sleep 1;
2834     }
2835     syslog("err", "error on hotplug device $deviceid");
2836     return undef;
2837 }
2838
2839
2840 sub qemu_devicedelverify {
2841     my ($vmid,$deviceid) = @_;
2842
2843     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2844     for (my $i = 0; $i <= 5; $i++) {
2845          my $devices_list = vm_devices_list($vmid);
2846          return 1 if !defined($devices_list->{$deviceid});
2847          sleep 1;
2848     }
2849     syslog("err", "error on hot-unplugging device $deviceid");
2850     return undef;
2851 }
2852
2853 sub qemu_findorcreatescsihw {
2854     my ($storecfg, $conf, $vmid, $device) = @_;
2855
2856     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2857     my $controller = int($device->{index} / $maxdev);
2858     my $scsihwid="scsihw$controller";
2859     my $devices_list = vm_devices_list($vmid);
2860
2861     if(!defined($devices_list->{$scsihwid})) {
2862        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2863     }
2864     return 1;
2865 }
2866
2867 sub qemu_bridgeadd {
2868     my ($storecfg, $conf, $vmid, $device) = @_;
2869
2870     my $bridges = {};
2871     my $bridgeid = undef;
2872     print_pci_addr($device, $bridges);
2873
2874     while (my ($k, $v) = each %$bridges) {
2875         $bridgeid = $k;
2876     }
2877     return if !$bridgeid || $bridgeid < 1;
2878     my $bridge = "pci.$bridgeid";
2879     my $devices_list = vm_devices_list($vmid);
2880
2881     if(!defined($devices_list->{$bridge})) {
2882         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2883     }
2884     return 1;
2885 }
2886
2887 sub qemu_netdevadd {
2888     my ($vmid, $conf, $device, $deviceid) = @_;
2889
2890     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2891     my %options =  split(/[=,]/, $netdev);
2892
2893     vm_mon_cmd($vmid, "netdev_add",  %options);
2894     return 1;
2895 }
2896
2897 sub qemu_netdevdel {
2898     my ($vmid, $deviceid) = @_;
2899
2900     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
2901     return 1;
2902 }
2903
2904 sub qemu_block_set_io_throttle {
2905     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2906
2907     return if !check_running($vmid) ;
2908
2909     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));
2910
2911 }
2912
2913 # old code, only used to shutdown old VM after update
2914 sub __read_avail {
2915     my ($fh, $timeout) = @_;
2916
2917     my $sel = new IO::Select;
2918     $sel->add($fh);
2919
2920     my $res = '';
2921     my $buf;
2922
2923     my @ready;
2924     while (scalar (@ready = $sel->can_read($timeout))) {
2925         my $count;
2926         if ($count = $fh->sysread($buf, 8192)) {
2927             if ($buf =~ /^(.*)\(qemu\) $/s) {
2928                 $res .= $1;
2929                 last;
2930             } else {
2931                 $res .= $buf;
2932             }
2933         } else {
2934             if (!defined($count)) {
2935                 die "$!\n";
2936             }
2937             last;
2938         }
2939     }
2940
2941     die "monitor read timeout\n" if !scalar(@ready);
2942
2943     return $res;
2944 }
2945
2946 # old code, only used to shutdown old VM after update
2947 sub vm_monitor_command {
2948     my ($vmid, $cmdstr, $nocheck) = @_;
2949
2950     my $res;
2951
2952     eval {
2953         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2954
2955         my $sname = "${var_run_tmpdir}/$vmid.mon";
2956
2957         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2958             die "unable to connect to VM $vmid socket - $!\n";
2959
2960         my $timeout = 3;
2961
2962         # hack: migrate sometime blocks the monitor (when migrate_downtime
2963         # is set)
2964         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2965             $timeout = 60*60; # 1 hour
2966         }
2967
2968         # read banner;
2969         my $data = __read_avail($sock, $timeout);
2970
2971         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2972             die "got unexpected qemu monitor banner\n";
2973         }
2974
2975         my $sel = new IO::Select;
2976         $sel->add($sock);
2977
2978         if (!scalar(my @ready = $sel->can_write($timeout))) {
2979             die "monitor write error - timeout";
2980         }
2981
2982         my $fullcmd = "$cmdstr\r";
2983
2984         # syslog('info', "VM $vmid monitor command: $cmdstr");
2985
2986         my $b;
2987         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2988             die "monitor write error - $!";
2989         }
2990
2991         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2992
2993         $timeout = 20;
2994
2995         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2996             $timeout = 60*60; # 1 hour
2997         } elsif ($cmdstr =~ m/^(eject|change)/) {
2998             $timeout = 60; # note: cdrom mount command is slow
2999         }
3000         if ($res = __read_avail($sock, $timeout)) {
3001
3002             my @lines = split("\r?\n", $res);
3003
3004             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3005
3006             $res = join("\n", @lines);
3007             $res .= "\n";
3008         }
3009     };
3010
3011     my $err = $@;
3012
3013     if ($err) {
3014         syslog("err", "VM $vmid monitor command failed - $err");
3015         die $err;
3016     }
3017
3018     return $res;
3019 }
3020
3021 sub qemu_block_resize {
3022     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3023
3024     my $running = check_running($vmid);
3025
3026     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3027
3028     return if !$running;
3029
3030     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3031
3032 }
3033
3034 sub qemu_volume_snapshot {
3035     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3036
3037     my $running = check_running($vmid);
3038
3039     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3040
3041     return if !$running;
3042
3043     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3044
3045 }
3046
3047 sub qemu_volume_snapshot_delete {
3048     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3049
3050     my $running = check_running($vmid);
3051
3052     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3053
3054     return if !$running;
3055
3056     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3057 }
3058
3059 sub qga_freezefs {
3060     my ($vmid) = @_;
3061
3062     #need to impplement call to qemu-ga
3063 }
3064
3065 sub qga_unfreezefs {
3066     my ($vmid) = @_;
3067
3068     #need to impplement call to qemu-ga
3069 }
3070
3071 sub vm_start {
3072     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3073
3074     lock_config($vmid, sub {
3075         my $conf = load_config($vmid, $migratedfrom);
3076
3077         die "you can't start a vm if it's a template\n" if is_template($conf);
3078
3079         check_lock($conf) if !$skiplock;
3080
3081         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3082
3083         my $defaults = load_defaults();
3084
3085         # set environment variable useful inside network script
3086         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3087
3088         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3089
3090         my $migrate_port = 0;
3091         my $migrate_uri;
3092         if ($statefile) {
3093             if ($statefile eq 'tcp') {
3094                 my $localip = "localhost";
3095                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3096                 if ($datacenterconf->{migration_unsecure}) {
3097                         my $nodename = PVE::INotify::nodename();
3098                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3099                 }
3100                 $migrate_port = PVE::Tools::next_migrate_port();
3101                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3102                 push @$cmd, '-incoming', $migrate_uri;
3103                 push @$cmd, '-S';
3104             } else {
3105                 push @$cmd, '-loadstate', $statefile;
3106             }
3107         } elsif ($paused) {
3108             push @$cmd, '-S';
3109         }
3110
3111         # host pci devices
3112         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3113           my $d = parse_hostpci($conf->{"hostpci$i"});
3114           next if !$d;
3115           my $info = pci_device_info("0000:$d->{pciid}");
3116           die "IOMMU not present\n" if !check_iommu_support();
3117           die "no pci device info for device '$d->{pciid}'\n" if !$info;
3118           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
3119           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
3120         }
3121
3122         PVE::Storage::activate_volumes($storecfg, $vollist);
3123
3124         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3125                     umask => 0077); };
3126         my $err = $@;
3127         die "start failed: $err" if $err;
3128
3129         print "migration listens on $migrate_uri\n" if $migrate_uri;
3130
3131         if ($statefile && $statefile ne 'tcp')  {
3132             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3133             warn $@ if $@;
3134         }
3135
3136         if ($migratedfrom) {
3137             my $capabilities = {};
3138             $capabilities->{capability} =  "xbzrle";
3139             $capabilities->{state} = JSON::true;
3140             eval { vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
3141             warn $@ if $@;
3142
3143             if ($spice_port) {
3144                 print "spice listens on port $spice_port\n";
3145                 if ($spice_ticket) {
3146                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3147                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3148                 }
3149             }
3150
3151         } else {
3152
3153             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3154                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3155                     if $conf->{balloon};
3156                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3157                             path => "machine/peripheral/balloon0",
3158                             property => "guest-stats-polling-interval",
3159                             value => 2);
3160             }
3161         }
3162     });
3163 }
3164
3165 sub vm_mon_cmd {
3166     my ($vmid, $execute, %params) = @_;
3167
3168     my $cmd = { execute => $execute, arguments => \%params };
3169     vm_qmp_command($vmid, $cmd);
3170 }
3171
3172 sub vm_mon_cmd_nocheck {
3173     my ($vmid, $execute, %params) = @_;
3174
3175     my $cmd = { execute => $execute, arguments => \%params };
3176     vm_qmp_command($vmid, $cmd, 1);
3177 }
3178
3179 sub vm_qmp_command {
3180     my ($vmid, $cmd, $nocheck) = @_;
3181
3182     my $res;
3183
3184     my $timeout;
3185     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3186         $timeout = $cmd->{arguments}->{timeout};
3187         delete $cmd->{arguments}->{timeout};
3188     }
3189
3190     eval {
3191         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3192         my $sname = qmp_socket($vmid);
3193         if (-e $sname) {
3194             my $qmpclient = PVE::QMPClient->new();
3195
3196             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3197         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3198             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3199                 if scalar(%{$cmd->{arguments}});
3200             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3201         } else {
3202             die "unable to open monitor socket\n";
3203         }
3204     };
3205     if (my $err = $@) {
3206         syslog("err", "VM $vmid qmp command failed - $err");
3207         die $err;
3208     }
3209
3210     return $res;
3211 }
3212
3213 sub vm_human_monitor_command {
3214     my ($vmid, $cmdline) = @_;
3215
3216     my $res;
3217
3218     my $cmd = {
3219         execute => 'human-monitor-command',
3220         arguments => { 'command-line' => $cmdline},
3221     };
3222
3223     return vm_qmp_command($vmid, $cmd);
3224 }
3225
3226 sub vm_commandline {
3227     my ($storecfg, $vmid) = @_;
3228
3229     my $conf = load_config($vmid);
3230
3231     my $defaults = load_defaults();
3232
3233     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3234
3235     return join(' ', @$cmd);
3236 }
3237
3238 sub vm_reset {
3239     my ($vmid, $skiplock) = @_;
3240
3241     lock_config($vmid, sub {
3242
3243         my $conf = load_config($vmid);
3244
3245         check_lock($conf) if !$skiplock;
3246
3247         vm_mon_cmd($vmid, "system_reset");
3248     });
3249 }
3250
3251 sub get_vm_volumes {
3252     my ($conf) = @_;
3253
3254     my $vollist = [];
3255     foreach_volid($conf, sub {
3256         my ($volid, $is_cdrom) = @_;
3257
3258         return if $volid =~ m|^/|;
3259
3260         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3261         return if !$sid;
3262
3263         push @$vollist, $volid;
3264     });
3265
3266     return $vollist;
3267 }
3268
3269 sub vm_stop_cleanup {
3270     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3271
3272     eval {
3273         fairsched_rmnod($vmid); # try to destroy group
3274
3275         if (!$keepActive) {
3276             my $vollist = get_vm_volumes($conf);
3277             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3278         }
3279
3280         foreach my $ext (qw(mon qmp pid vnc qga)) {
3281             unlink "/var/run/qemu-server/${vmid}.$ext";
3282         }
3283     };
3284     warn $@ if $@; # avoid errors - just warn
3285 }
3286
3287 # Note: use $nockeck to skip tests if VM configuration file exists.
3288 # We need that when migration VMs to other nodes (files already moved)
3289 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3290 sub vm_stop {
3291     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3292
3293     $force = 1 if !defined($force) && !$shutdown;
3294
3295     if ($migratedfrom){
3296         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3297         kill 15, $pid if $pid;
3298         my $conf = load_config($vmid, $migratedfrom);
3299         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3300         return;
3301     }
3302
3303     lock_config($vmid, sub {
3304
3305         my $pid = check_running($vmid, $nocheck);
3306         return if !$pid;
3307
3308         my $conf;
3309         if (!$nocheck) {
3310             $conf = load_config($vmid);
3311             check_lock($conf) if !$skiplock;
3312             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3313                 my $opts = parse_startup($conf->{startup});
3314                 $timeout = $opts->{down} if $opts->{down};
3315             }
3316         }
3317
3318         $timeout = 60 if !defined($timeout);
3319
3320         eval {
3321             if ($shutdown) {
3322                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3323
3324             } else {
3325                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3326             }
3327         };
3328         my $err = $@;
3329
3330         if (!$err) {
3331             my $count = 0;
3332             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3333                 $count++;
3334                 sleep 1;
3335             }
3336
3337             if ($count >= $timeout) {
3338                 if ($force) {
3339                     warn "VM still running - terminating now with SIGTERM\n";
3340                     kill 15, $pid;
3341                 } else {
3342                     die "VM quit/powerdown failed - got timeout\n";
3343                 }
3344             } else {
3345                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3346                 return;
3347             }
3348         } else {
3349             if ($force) {
3350                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3351                 kill 15, $pid;
3352             } else {
3353                 die "VM quit/powerdown failed\n";
3354             }
3355         }
3356
3357         # wait again
3358         $timeout = 10;
3359
3360         my $count = 0;
3361         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3362             $count++;
3363             sleep 1;
3364         }
3365
3366         if ($count >= $timeout) {
3367             warn "VM still running - terminating now with SIGKILL\n";
3368             kill 9, $pid;
3369             sleep 1;
3370         }
3371
3372         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3373    });
3374 }
3375
3376 sub vm_suspend {
3377     my ($vmid, $skiplock) = @_;
3378
3379     lock_config($vmid, sub {
3380
3381         my $conf = load_config($vmid);
3382
3383         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3384
3385         vm_mon_cmd($vmid, "stop");
3386     });
3387 }
3388
3389 sub vm_resume {
3390     my ($vmid, $skiplock) = @_;
3391
3392     lock_config($vmid, sub {
3393
3394         my $conf = load_config($vmid);
3395
3396         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3397
3398         vm_mon_cmd($vmid, "cont");
3399     });
3400 }
3401
3402 sub vm_sendkey {
3403     my ($vmid, $skiplock, $key) = @_;
3404
3405     lock_config($vmid, sub {
3406
3407         my $conf = load_config($vmid);
3408
3409         # there is no qmp command, so we use the human monitor command
3410         vm_human_monitor_command($vmid, "sendkey $key");
3411     });
3412 }
3413
3414 sub vm_destroy {
3415     my ($storecfg, $vmid, $skiplock) = @_;
3416
3417     lock_config($vmid, sub {
3418
3419         my $conf = load_config($vmid);
3420
3421         check_lock($conf) if !$skiplock;
3422
3423         if (!check_running($vmid)) {
3424             fairsched_rmnod($vmid); # try to destroy group
3425             destroy_vm($storecfg, $vmid);
3426         } else {
3427             die "VM $vmid is running - destroy failed\n";
3428         }
3429     });
3430 }
3431
3432 # pci helpers
3433
3434 sub file_write {
3435     my ($filename, $buf) = @_;
3436
3437     my $fh = IO::File->new($filename, "w");
3438     return undef if !$fh;
3439
3440     my $res = print $fh $buf;
3441
3442     $fh->close();
3443
3444     return $res;
3445 }
3446
3447 sub pci_device_info {
3448     my ($name) = @_;
3449
3450     my $res;
3451
3452     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3453     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3454
3455     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3456     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3457
3458     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3459     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3460
3461     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3462     return undef if !defined($product) || $product !~ s/^0x//;
3463
3464     $res = {
3465         name => $name,
3466         vendor => $vendor,
3467         product => $product,
3468         domain => $domain,
3469         bus => $bus,
3470         slot => $slot,
3471         func => $func,
3472         irq => $irq,
3473         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3474     };
3475
3476     return $res;
3477 }
3478
3479 sub pci_dev_reset {
3480     my ($dev) = @_;
3481
3482     my $name = $dev->{name};
3483
3484     my $fn = "$pcisysfs/devices/$name/reset";
3485
3486     return file_write($fn, "1");
3487 }
3488
3489 sub pci_dev_bind_to_stub {
3490     my ($dev) = @_;
3491
3492     my $name = $dev->{name};
3493
3494     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3495     return 1 if -d $testdir;
3496
3497     my $data = "$dev->{vendor} $dev->{product}";
3498     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3499
3500     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3501     if (!file_write($fn, $name)) {
3502         return undef if -f $fn;
3503     }
3504
3505     $fn = "$pcisysfs/drivers/pci-stub/bind";
3506     if (! -d $testdir) {
3507         return undef if !file_write($fn, $name);
3508     }
3509
3510     return -d $testdir;
3511 }
3512
3513 sub print_pci_addr {
3514     my ($id, $bridges) = @_;
3515
3516     my $res = '';
3517     my $devices = {
3518         piix3 => { bus => 0, addr => 1 },
3519         #addr2 : first videocard
3520         balloon0 => { bus => 0, addr => 3 },
3521         watchdog => { bus => 0, addr => 4 },
3522         scsihw0 => { bus => 0, addr => 5 },
3523         scsihw1 => { bus => 0, addr => 6 },
3524         ahci0 => { bus => 0, addr => 7 },
3525         qga0 => { bus => 0, addr => 8 },
3526         spice => { bus => 0, addr => 9 },
3527         virtio0 => { bus => 0, addr => 10 },
3528         virtio1 => { bus => 0, addr => 11 },
3529         virtio2 => { bus => 0, addr => 12 },
3530         virtio3 => { bus => 0, addr => 13 },
3531         virtio4 => { bus => 0, addr => 14 },
3532         virtio5 => { bus => 0, addr => 15 },
3533         hostpci0 => { bus => 0, addr => 16 },
3534         hostpci1 => { bus => 0, addr => 17 },
3535         net0 => { bus => 0, addr => 18 },
3536         net1 => { bus => 0, addr => 19 },
3537         net2 => { bus => 0, addr => 20 },
3538         net3 => { bus => 0, addr => 21 },
3539         net4 => { bus => 0, addr => 22 },
3540         net5 => { bus => 0, addr => 23 },
3541         vga1 => { bus => 0, addr => 24 },
3542         vga2 => { bus => 0, addr => 25 },
3543         vga3 => { bus => 0, addr => 26 },
3544         #addr29 : usb-host (pve-usb.cfg)
3545         'pci.1' => { bus => 0, addr => 30 },
3546         'pci.2' => { bus => 0, addr => 31 },
3547         'net6' => { bus => 1, addr => 1 },
3548         'net7' => { bus => 1, addr => 2 },
3549         'net8' => { bus => 1, addr => 3 },
3550         'net9' => { bus => 1, addr => 4 },
3551         'net10' => { bus => 1, addr => 5 },
3552         'net11' => { bus => 1, addr => 6 },
3553         'net12' => { bus => 1, addr => 7 },
3554         'net13' => { bus => 1, addr => 8 },
3555         'net14' => { bus => 1, addr => 9 },
3556         'net15' => { bus => 1, addr => 10 },
3557         'net16' => { bus => 1, addr => 11 },
3558         'net17' => { bus => 1, addr => 12 },
3559         'net18' => { bus => 1, addr => 13 },
3560         'net19' => { bus => 1, addr => 14 },
3561         'net20' => { bus => 1, addr => 15 },
3562         'net21' => { bus => 1, addr => 16 },
3563         'net22' => { bus => 1, addr => 17 },
3564         'net23' => { bus => 1, addr => 18 },
3565         'net24' => { bus => 1, addr => 19 },
3566         'net25' => { bus => 1, addr => 20 },
3567         'net26' => { bus => 1, addr => 21 },
3568         'net27' => { bus => 1, addr => 22 },
3569         'net28' => { bus => 1, addr => 23 },
3570         'net29' => { bus => 1, addr => 24 },
3571         'net30' => { bus => 1, addr => 25 },
3572         'net31' => { bus => 1, addr => 26 },
3573         'virtio6' => { bus => 2, addr => 1 },
3574         'virtio7' => { bus => 2, addr => 2 },
3575         'virtio8' => { bus => 2, addr => 3 },
3576         'virtio9' => { bus => 2, addr => 4 },
3577         'virtio10' => { bus => 2, addr => 5 },
3578         'virtio11' => { bus => 2, addr => 6 },
3579         'virtio12' => { bus => 2, addr => 7 },
3580         'virtio13' => { bus => 2, addr => 8 },
3581         'virtio14' => { bus => 2, addr => 9 },
3582         'virtio15' => { bus => 2, addr => 10 },
3583     };
3584
3585     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3586            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3587            my $bus = $devices->{$id}->{bus};
3588            $res = ",bus=pci.$bus,addr=$addr";
3589            $bridges->{$bus} = 1 if $bridges;
3590     }
3591     return $res;
3592
3593 }
3594
3595 # vzdump restore implementaion
3596
3597 sub tar_archive_read_firstfile {
3598     my $archive = shift;
3599
3600     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3601
3602     # try to detect archive type first
3603     my $pid = open (TMP, "tar tf '$archive'|") ||
3604         die "unable to open file '$archive'\n";
3605     my $firstfile = <TMP>;
3606     kill 15, $pid;
3607     close TMP;
3608
3609     die "ERROR: archive contaions no data\n" if !$firstfile;
3610     chomp $firstfile;
3611
3612     return $firstfile;
3613 }
3614
3615 sub tar_restore_cleanup {
3616     my ($storecfg, $statfile) = @_;
3617
3618     print STDERR "starting cleanup\n";
3619
3620     if (my $fd = IO::File->new($statfile, "r")) {
3621         while (defined(my $line = <$fd>)) {
3622             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3623                 my $volid = $2;
3624                 eval {
3625                     if ($volid =~ m|^/|) {
3626                         unlink $volid || die 'unlink failed\n';
3627                     } else {
3628                         PVE::Storage::vdisk_free($storecfg, $volid);
3629                     }
3630                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3631                 };
3632                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3633             } else {
3634                 print STDERR "unable to parse line in statfile - $line";
3635             }
3636         }
3637         $fd->close();
3638     }
3639 }
3640
3641 sub restore_archive {
3642     my ($archive, $vmid, $user, $opts) = @_;
3643
3644     my $format = $opts->{format};
3645     my $comp;
3646
3647     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3648         $format = 'tar' if !$format;
3649         $comp = 'gzip';
3650     } elsif ($archive =~ m/\.tar$/) {
3651         $format = 'tar' if !$format;
3652     } elsif ($archive =~ m/.tar.lzo$/) {
3653         $format = 'tar' if !$format;
3654         $comp = 'lzop';
3655     } elsif ($archive =~ m/\.vma$/) {
3656         $format = 'vma' if !$format;
3657     } elsif ($archive =~ m/\.vma\.gz$/) {
3658         $format = 'vma' if !$format;
3659         $comp = 'gzip';
3660     } elsif ($archive =~ m/\.vma\.lzo$/) {
3661         $format = 'vma' if !$format;
3662         $comp = 'lzop';
3663     } else {
3664         $format = 'vma' if !$format; # default
3665     }
3666
3667     # try to detect archive format
3668     if ($format eq 'tar') {
3669         return restore_tar_archive($archive, $vmid, $user, $opts);
3670     } else {
3671         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3672     }
3673 }
3674
3675 sub restore_update_config_line {
3676     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3677
3678     return if $line =~ m/^\#qmdump\#/;
3679     return if $line =~ m/^\#vzdump\#/;
3680     return if $line =~ m/^lock:/;
3681     return if $line =~ m/^unused\d+:/;
3682     return if $line =~ m/^parent:/;
3683     return if $line =~ m/^template:/; # restored VM is never a template
3684
3685     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3686         # try to convert old 1.X settings
3687         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3688         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3689             my ($model, $macaddr) = split(/\=/, $devconfig);
3690             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3691             my $net = {
3692                 model => $model,
3693                 bridge => "vmbr$ind",
3694                 macaddr => $macaddr,
3695             };
3696             my $netstr = print_net($net);
3697
3698             print $outfd "net$cookie->{netcount}: $netstr\n";
3699             $cookie->{netcount}++;
3700         }
3701     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3702         my ($id, $netstr) = ($1, $2);
3703         my $net = parse_net($netstr);
3704         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3705         $netstr = print_net($net);
3706         print $outfd "$id: $netstr\n";
3707     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3708         my $virtdev = $1;
3709         my $value = $3;
3710         if ($line =~ m/backup=no/) {
3711             print $outfd "#$line";
3712         } elsif ($virtdev && $map->{$virtdev}) {
3713             my $di = parse_drive($virtdev, $value);
3714             delete $di->{format}; # format can change on restore
3715             $di->{file} = $map->{$virtdev};
3716             $value = print_drive($vmid, $di);
3717             print $outfd "$virtdev: $value\n";
3718         } else {
3719             print $outfd $line;
3720         }
3721     } else {
3722         print $outfd $line;
3723     }
3724 }
3725
3726 sub scan_volids {
3727     my ($cfg, $vmid) = @_;
3728
3729     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3730
3731     my $volid_hash = {};
3732     foreach my $storeid (keys %$info) {
3733         foreach my $item (@{$info->{$storeid}}) {
3734             next if !($item->{volid} && $item->{size});
3735             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
3736             $volid_hash->{$item->{volid}} = $item;
3737         }
3738     }
3739
3740     return $volid_hash;
3741 }
3742
3743 sub get_used_paths {
3744     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
3745
3746     my $used_path = {};
3747
3748     my $scan_config = sub {
3749         my ($cref, $snapname) = @_;
3750
3751         foreach my $key (keys %$cref) {
3752             my $value = $cref->{$key};
3753             if (valid_drivename($key)) {
3754                 next if $skip_drive && $key eq $skip_drive;
3755                 my $drive = parse_drive($key, $value);
3756                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
3757                 if ($drive->{file} =~ m!^/!) {
3758                     $used_path->{$drive->{file}}++; # = 1;
3759                 } else {
3760                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
3761                     next if !$storeid;
3762                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
3763                     next if !$scfg;
3764                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
3765                     $used_path->{$path}++; # = 1;
3766                 }
3767             }
3768         }
3769     };
3770
3771     &$scan_config($conf);
3772
3773     undef $skip_drive;
3774
3775     if ($scan_snapshots) {
3776         foreach my $snapname (keys %{$conf->{snapshots}}) {
3777             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
3778         }
3779     }
3780
3781     return $used_path;
3782 }
3783
3784 sub update_disksize {
3785     my ($vmid, $conf, $volid_hash) = @_;
3786
3787     my $changes;
3788
3789     my $used = {};
3790
3791     # Note: it is allowed to define multiple storages with same path (alias), so
3792     # we need to check both 'volid' and real 'path' (two different volid can point
3793     # to the same path).
3794
3795     my $usedpath = {};
3796
3797     # update size info
3798     foreach my $opt (keys %$conf) {
3799         if (valid_drivename($opt)) {
3800             my $drive = parse_drive($opt, $conf->{$opt});
3801             my $volid = $drive->{file};
3802             next if !$volid;
3803
3804             $used->{$volid} = 1;
3805             if ($volid_hash->{$volid} &&
3806                 (my $path = $volid_hash->{$volid}->{path})) {
3807                 $usedpath->{$path} = 1;
3808             }
3809
3810             next if drive_is_cdrom($drive);
3811             next if !$volid_hash->{$volid};
3812
3813             $drive->{size} = $volid_hash->{$volid}->{size};
3814             my $new = print_drive($vmid, $drive);
3815             if ($new ne $conf->{$opt}) {
3816                 $changes = 1;
3817                 $conf->{$opt} = $new;
3818             }
3819         }
3820     }
3821
3822     # remove 'unusedX' entry if volume is used
3823     foreach my $opt (keys %$conf) {
3824         next if $opt !~ m/^unused\d+$/;
3825         my $volid = $conf->{$opt};
3826         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
3827         if ($used->{$volid} || ($path && $usedpath->{$path})) {
3828             $changes = 1;
3829             delete $conf->{$opt};
3830         }
3831     }
3832
3833     foreach my $volid (sort keys %$volid_hash) {
3834         next if $volid =~ m/vm-$vmid-state-/;
3835         next if $used->{$volid};
3836         my $path = $volid_hash->{$volid}->{path};
3837         next if !$path; # just to be sure
3838         next if $usedpath->{$path};
3839         $changes = 1;
3840         add_unused_volume($conf, $volid);
3841         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
3842     }
3843
3844     return $changes;
3845 }
3846
3847 sub rescan {
3848     my ($vmid, $nolock) = @_;
3849
3850     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3851
3852     my $volid_hash = scan_volids($cfg, $vmid);
3853
3854     my $updatefn =  sub {
3855         my ($vmid) = @_;
3856
3857         my $conf = load_config($vmid);
3858
3859         check_lock($conf);
3860
3861         my $vm_volids = {};
3862         foreach my $volid (keys %$volid_hash) {
3863             my $info = $volid_hash->{$volid};
3864             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
3865         }
3866
3867         my $changes = update_disksize($vmid, $conf, $vm_volids);
3868
3869         update_config_nolock($vmid, $conf, 1) if $changes;
3870     };
3871
3872     if (defined($vmid)) {
3873         if ($nolock) {
3874             &$updatefn($vmid);
3875         } else {
3876             lock_config($vmid, $updatefn, $vmid);
3877         }
3878     } else {
3879         my $vmlist = config_list();
3880         foreach my $vmid (keys %$vmlist) {
3881             if ($nolock) {
3882                 &$updatefn($vmid);
3883             } else {
3884                 lock_config($vmid, $updatefn, $vmid);
3885             }
3886         }
3887     }
3888 }
3889
3890 sub restore_vma_archive {
3891     my ($archive, $vmid, $user, $opts, $comp) = @_;
3892
3893     my $input = $archive eq '-' ? "<&STDIN" : undef;
3894     my $readfrom = $archive;
3895
3896     my $uncomp = '';
3897     if ($comp) {
3898         $readfrom = '-';
3899         my $qarchive = PVE::Tools::shellquote($archive);
3900         if ($comp eq 'gzip') {
3901             $uncomp = "zcat $qarchive|";
3902         } elsif ($comp eq 'lzop') {
3903             $uncomp = "lzop -d -c $qarchive|";
3904         } else {
3905             die "unknown compression method '$comp'\n";
3906         }
3907
3908     }
3909
3910     my $tmpdir = "/var/tmp/vzdumptmp$$";
3911     rmtree $tmpdir;
3912
3913     # disable interrupts (always do cleanups)
3914     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3915         warn "got interrupt - ignored\n";
3916     };
3917
3918     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3919     POSIX::mkfifo($mapfifo, 0600);
3920     my $fifofh;
3921
3922     my $openfifo = sub {
3923         open($fifofh, '>', $mapfifo) || die $!;
3924     };
3925
3926     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3927
3928     my $oldtimeout;
3929     my $timeout = 5;
3930
3931     my $devinfo = {};
3932
3933     my $rpcenv = PVE::RPCEnvironment::get();
3934
3935     my $conffile = config_file($vmid);
3936     my $tmpfn = "$conffile.$$.tmp";
3937
3938     # Note: $oldconf is undef if VM does not exists
3939     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
3940
3941     my $print_devmap = sub {
3942         my $virtdev_hash = {};
3943
3944         my $cfgfn = "$tmpdir/qemu-server.conf";
3945
3946         # we can read the config - that is already extracted
3947         my $fh = IO::File->new($cfgfn, "r") ||
3948             "unable to read qemu-server.conf - $!\n";
3949
3950         while (defined(my $line = <$fh>)) {
3951             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3952                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3953                 die "archive does not contain data for drive '$virtdev'\n"
3954                     if !$devinfo->{$devname};
3955                 if (defined($opts->{storage})) {
3956                     $storeid = $opts->{storage} || 'local';
3957                 } elsif (!$storeid) {
3958                     $storeid = 'local';
3959                 }
3960                 $format = 'raw' if !$format;
3961                 $devinfo->{$devname}->{devname} = $devname;
3962                 $devinfo->{$devname}->{virtdev} = $virtdev;
3963                 $devinfo->{$devname}->{format} = $format;
3964                 $devinfo->{$devname}->{storeid} = $storeid;
3965
3966                 # check permission on storage
3967                 my $pool = $opts->{pool}; # todo: do we need that?
3968                 if ($user ne 'root@pam') {
3969                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3970                 }
3971
3972                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3973             }
3974         }
3975
3976         foreach my $devname (keys %$devinfo) {
3977             die "found no device mapping information for device '$devname'\n"
3978                 if !$devinfo->{$devname}->{virtdev};
3979         }
3980
3981         my $cfg = cfs_read_file('storage.cfg');
3982
3983         # create empty/temp config
3984         if ($oldconf) {
3985             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
3986             foreach_drive($oldconf, sub {
3987                 my ($ds, $drive) = @_;
3988
3989                 return if drive_is_cdrom($drive);
3990
3991                 my $volid = $drive->{file};
3992
3993                 return if !$volid || $volid =~ m|^/|;
3994
3995                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
3996                 return if !$path || !$owner || ($owner != $vmid);
3997
3998                 # Note: only delete disk we want to restore
3999                 # other volumes will become unused
4000                 if ($virtdev_hash->{$ds}) {
4001                     PVE::Storage::vdisk_free($cfg, $volid);
4002                 }
4003             });
4004         }
4005
4006         my $map = {};
4007         foreach my $virtdev (sort keys %$virtdev_hash) {
4008             my $d = $virtdev_hash->{$virtdev};
4009             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4010             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4011
4012             # test if requested format is supported
4013             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4014             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4015             $d->{format} = $defFormat if !$supported;
4016
4017             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4018                                                   $d->{format}, undef, $alloc_size);
4019             print STDERR "new volume ID is '$volid'\n";
4020             $d->{volid} = $volid;
4021             my $path = PVE::Storage::path($cfg, $volid);
4022
4023             my $write_zeros = 1;
4024             # fixme: what other storages types initialize volumes with zero?
4025             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4026                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4027                 $write_zeros = 0;
4028             }
4029
4030             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4031
4032             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4033             $map->{$virtdev} = $volid;
4034         }
4035
4036         $fh->seek(0, 0) || die "seek failed - $!\n";
4037
4038         my $outfd = new IO::File ($tmpfn, "w") ||
4039             die "unable to write config for VM $vmid\n";
4040
4041         my $cookie = { netcount => 0 };
4042         while (defined(my $line = <$fh>)) {
4043             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4044         }
4045
4046         $fh->close();
4047         $outfd->close();
4048     };
4049
4050     eval {
4051         # enable interrupts
4052         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4053             die "interrupted by signal\n";
4054         };
4055         local $SIG{ALRM} = sub { die "got timeout\n"; };
4056
4057         $oldtimeout = alarm($timeout);
4058
4059         my $parser = sub {
4060             my $line = shift;
4061
4062             print "$line\n";
4063
4064             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4065                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4066                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4067             } elsif ($line =~ m/^CTIME: /) {
4068                 &$print_devmap();
4069                 print $fifofh "done\n";
4070                 my $tmp = $oldtimeout || 0;
4071                 $oldtimeout = undef;
4072                 alarm($tmp);
4073                 close($fifofh);
4074             }
4075         };
4076
4077         print "restore vma archive: $cmd\n";
4078         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4079     };
4080     my $err = $@;
4081
4082     alarm($oldtimeout) if $oldtimeout;
4083
4084     unlink $mapfifo;
4085
4086     if ($err) {
4087         rmtree $tmpdir;
4088         unlink $tmpfn;
4089
4090         my $cfg = cfs_read_file('storage.cfg');
4091         foreach my $devname (keys %$devinfo) {
4092             my $volid = $devinfo->{$devname}->{volid};
4093             next if !$volid;
4094             eval {
4095                 if ($volid =~ m|^/|) {
4096                     unlink $volid || die 'unlink failed\n';
4097                 } else {
4098                     PVE::Storage::vdisk_free($cfg, $volid);
4099                 }
4100                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4101             };
4102             print STDERR "unable to cleanup '$volid' - $@" if $@;
4103         }
4104         die $err;
4105     }
4106
4107     rmtree $tmpdir;
4108
4109     rename($tmpfn, $conffile) ||
4110         die "unable to commit configuration file '$conffile'\n";
4111
4112     PVE::Cluster::cfs_update(); # make sure we read new file
4113
4114     eval { rescan($vmid, 1); };
4115     warn $@ if $@;
4116 }
4117
4118 sub restore_tar_archive {
4119     my ($archive, $vmid, $user, $opts) = @_;
4120
4121     if ($archive ne '-') {
4122         my $firstfile = tar_archive_read_firstfile($archive);
4123         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4124             if $firstfile ne 'qemu-server.conf';
4125     }
4126
4127     my $storecfg = cfs_read_file('storage.cfg');
4128
4129     # destroy existing data - keep empty config
4130     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4131     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4132
4133     my $tocmd = "/usr/lib/qemu-server/qmextract";
4134
4135     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4136     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4137     $tocmd .= ' --prealloc' if $opts->{prealloc};
4138     $tocmd .= ' --info' if $opts->{info};
4139
4140     # tar option "xf" does not autodetect compression when read from STDIN,
4141     # so we pipe to zcat
4142     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4143         PVE::Tools::shellquote("--to-command=$tocmd");
4144
4145     my $tmpdir = "/var/tmp/vzdumptmp$$";
4146     mkpath $tmpdir;
4147
4148     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4149     local $ENV{VZDUMP_VMID} = $vmid;
4150     local $ENV{VZDUMP_USER} = $user;
4151
4152     my $conffile = config_file($vmid);
4153     my $tmpfn = "$conffile.$$.tmp";
4154
4155     # disable interrupts (always do cleanups)
4156     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4157         print STDERR "got interrupt - ignored\n";
4158     };
4159
4160     eval {
4161         # enable interrupts
4162         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4163             die "interrupted by signal\n";
4164         };
4165
4166         if ($archive eq '-') {
4167             print "extracting archive from STDIN\n";
4168             run_command($cmd, input => "<&STDIN");
4169         } else {
4170             print "extracting archive '$archive'\n";
4171             run_command($cmd);
4172         }
4173
4174         return if $opts->{info};
4175
4176         # read new mapping
4177         my $map = {};
4178         my $statfile = "$tmpdir/qmrestore.stat";
4179         if (my $fd = IO::File->new($statfile, "r")) {
4180             while (defined (my $line = <$fd>)) {
4181                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4182                     $map->{$1} = $2 if $1;
4183                 } else {
4184                     print STDERR "unable to parse line in statfile - $line\n";
4185                 }
4186             }
4187             $fd->close();
4188         }
4189
4190         my $confsrc = "$tmpdir/qemu-server.conf";
4191
4192         my $srcfd = new IO::File($confsrc, "r") ||
4193             die "unable to open file '$confsrc'\n";
4194
4195         my $outfd = new IO::File ($tmpfn, "w") ||
4196             die "unable to write config for VM $vmid\n";
4197
4198         my $cookie = { netcount => 0 };
4199         while (defined (my $line = <$srcfd>)) {
4200             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4201         }
4202
4203         $srcfd->close();
4204         $outfd->close();
4205     };
4206     my $err = $@;
4207
4208     if ($err) {
4209
4210         unlink $tmpfn;
4211
4212         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4213
4214         die $err;
4215     }
4216
4217     rmtree $tmpdir;
4218
4219     rename $tmpfn, $conffile ||
4220         die "unable to commit configuration file '$conffile'\n";
4221
4222     PVE::Cluster::cfs_update(); # make sure we read new file
4223
4224     eval { rescan($vmid, 1); };
4225     warn $@ if $@;
4226 };
4227
4228
4229 # Internal snapshots
4230
4231 # NOTE: Snapshot create/delete involves several non-atomic
4232 # action, and can take a long time.
4233 # So we try to avoid locking the file and use 'lock' variable
4234 # inside the config file instead.
4235
4236 my $snapshot_copy_config = sub {
4237     my ($source, $dest) = @_;
4238
4239     foreach my $k (keys %$source) {
4240         next if $k eq 'snapshots';
4241         next if $k eq 'snapstate';
4242         next if $k eq 'snaptime';
4243         next if $k eq 'vmstate';
4244         next if $k eq 'lock';
4245         next if $k eq 'digest';
4246         next if $k eq 'description';
4247         next if $k =~ m/^unused\d+$/;
4248
4249         $dest->{$k} = $source->{$k};
4250     }
4251 };
4252
4253 my $snapshot_apply_config = sub {
4254     my ($conf, $snap) = @_;
4255
4256     # copy snapshot list
4257     my $newconf = {
4258         snapshots => $conf->{snapshots},
4259     };
4260
4261     # keep description and list of unused disks
4262     foreach my $k (keys %$conf) {
4263         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4264         $newconf->{$k} = $conf->{$k};
4265     }
4266
4267     &$snapshot_copy_config($snap, $newconf);
4268
4269     return $newconf;
4270 };
4271
4272 sub foreach_writable_storage {
4273     my ($conf, $func) = @_;
4274
4275     my $sidhash = {};
4276
4277     foreach my $ds (keys %$conf) {
4278         next if !valid_drivename($ds);
4279
4280         my $drive = parse_drive($ds, $conf->{$ds});
4281         next if !$drive;
4282         next if drive_is_cdrom($drive);
4283
4284         my $volid = $drive->{file};
4285
4286         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4287         $sidhash->{$sid} = $sid if $sid;
4288     }
4289
4290     foreach my $sid (sort keys %$sidhash) {
4291         &$func($sid);
4292     }
4293 }
4294
4295 my $alloc_vmstate_volid = sub {
4296     my ($storecfg, $vmid, $conf, $snapname) = @_;
4297
4298     # Note: we try to be smart when selecting a $target storage
4299
4300     my $target;
4301
4302     # search shared storage first
4303     foreach_writable_storage($conf, sub {
4304         my ($sid) = @_;
4305         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4306         return if !$scfg->{shared};
4307
4308         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4309     });
4310
4311     if (!$target) {
4312         # now search local storage
4313         foreach_writable_storage($conf, sub {
4314             my ($sid) = @_;
4315             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4316             return if $scfg->{shared};
4317
4318             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4319         });
4320     }
4321
4322     $target = 'local' if !$target;
4323
4324     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4325     # we abort live save after $conf->{memory}, so we need at max twice that space
4326     my $size = $conf->{memory}*2 + $driver_state_size;
4327
4328     my $name = "vm-$vmid-state-$snapname";
4329     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4330     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4331     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4332
4333     return $volid;
4334 };
4335
4336 my $snapshot_prepare = sub {
4337     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4338
4339     my $snap;
4340
4341     my $updatefn =  sub {
4342
4343         my $conf = load_config($vmid);
4344
4345         die "you can't take a snapshot if it's a template\n"
4346             if is_template($conf);
4347
4348         check_lock($conf);
4349
4350         $conf->{lock} = 'snapshot';
4351
4352         die "snapshot name '$snapname' already used\n"
4353             if defined($conf->{snapshots}->{$snapname});
4354
4355         my $storecfg = PVE::Storage::config();
4356         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4357
4358         $snap = $conf->{snapshots}->{$snapname} = {};
4359
4360         if ($save_vmstate && check_running($vmid)) {
4361             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4362         }
4363
4364         &$snapshot_copy_config($conf, $snap);
4365
4366         $snap->{snapstate} = "prepare";
4367         $snap->{snaptime} = time();
4368         $snap->{description} = $comment if $comment;
4369
4370         # always overwrite machine if we save vmstate. This makes sure we
4371         # can restore it later using correct machine type
4372         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
4373
4374         update_config_nolock($vmid, $conf, 1);
4375     };
4376
4377     lock_config($vmid, $updatefn);
4378
4379     return $snap;
4380 };
4381
4382 my $snapshot_commit = sub {
4383     my ($vmid, $snapname) = @_;
4384
4385     my $updatefn = sub {
4386
4387         my $conf = load_config($vmid);
4388
4389         die "missing snapshot lock\n"
4390             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4391
4392         my $snap = $conf->{snapshots}->{$snapname};
4393
4394         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4395
4396         die "wrong snapshot state\n"
4397             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4398
4399         delete $snap->{snapstate};
4400         delete $conf->{lock};
4401
4402         my $newconf = &$snapshot_apply_config($conf, $snap);
4403
4404         $newconf->{parent} = $snapname;
4405
4406         update_config_nolock($vmid, $newconf, 1);
4407     };
4408
4409     lock_config($vmid, $updatefn);
4410 };
4411
4412 sub snapshot_rollback {
4413     my ($vmid, $snapname) = @_;
4414
4415     my $snap;
4416
4417     my $prepare = 1;
4418
4419     my $storecfg = PVE::Storage::config();
4420
4421     my $updatefn = sub {
4422
4423         my $conf = load_config($vmid);
4424
4425         die "you can't rollback if vm is a template\n" if is_template($conf);
4426
4427         $snap = $conf->{snapshots}->{$snapname};
4428
4429         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4430
4431         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4432             if $snap->{snapstate};
4433
4434         if ($prepare) {
4435             check_lock($conf);
4436             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4437         }
4438
4439         die "unable to rollback vm $vmid: vm is running\n"
4440             if check_running($vmid);
4441
4442         if ($prepare) {
4443             $conf->{lock} = 'rollback';
4444         } else {
4445             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4446             delete $conf->{lock};
4447         }
4448
4449         my $forcemachine;
4450
4451         if (!$prepare) {
4452             my $has_machine_config = defined($conf->{machine});
4453
4454             # copy snapshot config to current config
4455             $conf = &$snapshot_apply_config($conf, $snap);
4456             $conf->{parent} = $snapname;
4457
4458             # Note: old code did not store 'machine', so we try to be smart
4459             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4460             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
4461             # we remove the 'machine' configuration if not explicitly specified
4462             # in the original config.
4463             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
4464         }
4465
4466         update_config_nolock($vmid, $conf, 1);
4467
4468         if (!$prepare && $snap->{vmstate}) {
4469             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4470             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4471         }
4472     };
4473
4474     lock_config($vmid, $updatefn);
4475
4476     foreach_drive($snap, sub {
4477         my ($ds, $drive) = @_;
4478
4479         return if drive_is_cdrom($drive);
4480
4481         my $volid = $drive->{file};
4482         my $device = "drive-$ds";
4483
4484         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4485     });
4486
4487     $prepare = 0;
4488     lock_config($vmid, $updatefn);
4489 }
4490
4491 my $savevm_wait = sub {
4492     my ($vmid) = @_;
4493
4494     for(;;) {
4495         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4496         if (!$stat->{status}) {
4497             die "savevm not active\n";
4498         } elsif ($stat->{status} eq 'active') {
4499             sleep(1);
4500             next;
4501         } elsif ($stat->{status} eq 'completed') {
4502             last;
4503         } else {
4504             die "query-savevm returned status '$stat->{status}'\n";
4505         }
4506     }
4507 };
4508
4509 sub snapshot_create {
4510     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4511
4512     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4513
4514     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4515
4516     my $drivehash = {};
4517
4518     my $running = check_running($vmid);
4519
4520     eval {
4521         # create internal snapshots of all drives
4522
4523         my $storecfg = PVE::Storage::config();
4524
4525         if ($running) {
4526             if ($snap->{vmstate}) {
4527                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4528                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4529                 &$savevm_wait($vmid);
4530             } else {
4531                 vm_mon_cmd($vmid, "savevm-start");
4532             }
4533         };
4534
4535         qga_freezefs($vmid) if $running && $freezefs;
4536
4537         foreach_drive($snap, sub {
4538             my ($ds, $drive) = @_;
4539
4540             return if drive_is_cdrom($drive);
4541
4542             my $volid = $drive->{file};
4543             my $device = "drive-$ds";
4544
4545             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4546             $drivehash->{$ds} = 1;
4547        });
4548     };
4549     my $err = $@;
4550
4551     eval { qga_unfreezefs($vmid) if $running && $freezefs; };
4552     warn $@ if $@;
4553
4554     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4555     warn $@ if $@;
4556
4557     if ($err) {
4558         warn "snapshot create failed: starting cleanup\n";
4559         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4560         warn $@ if $@;
4561         die $err;
4562     }
4563
4564     &$snapshot_commit($vmid, $snapname);
4565 }
4566
4567 # Note: $drivehash is only set when called from snapshot_create.
4568 sub snapshot_delete {
4569     my ($vmid, $snapname, $force, $drivehash) = @_;
4570
4571     my $prepare = 1;
4572
4573     my $snap;
4574     my $unused = [];
4575
4576     my $unlink_parent = sub {
4577         my ($confref, $new_parent) = @_;
4578
4579         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4580             if ($new_parent) {
4581                 $confref->{parent} = $new_parent;
4582             } else {
4583                 delete $confref->{parent};
4584             }
4585         }
4586     };
4587
4588     my $updatefn =  sub {
4589         my ($remove_drive) = @_;
4590
4591         my $conf = load_config($vmid);
4592
4593         if (!$drivehash) {
4594             check_lock($conf);
4595             die "you can't delete a snapshot if vm is a template\n"
4596                 if is_template($conf);
4597         }
4598
4599         $snap = $conf->{snapshots}->{$snapname};
4600
4601         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4602
4603         # remove parent refs
4604         &$unlink_parent($conf, $snap->{parent});
4605         foreach my $sn (keys %{$conf->{snapshots}}) {
4606             next if $sn eq $snapname;
4607             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4608         }
4609
4610         if ($remove_drive) {
4611             if ($remove_drive eq 'vmstate') {
4612                 delete $snap->{$remove_drive};
4613             } else {
4614                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4615                 my $volid = $drive->{file};
4616                 delete $snap->{$remove_drive};
4617                 add_unused_volume($conf, $volid);
4618             }
4619         }
4620
4621         if ($prepare) {
4622             $snap->{snapstate} = 'delete';
4623         } else {
4624             delete $conf->{snapshots}->{$snapname};
4625             delete $conf->{lock} if $drivehash;
4626             foreach my $volid (@$unused) {
4627                 add_unused_volume($conf, $volid);
4628             }
4629         }
4630
4631         update_config_nolock($vmid, $conf, 1);
4632     };
4633
4634     lock_config($vmid, $updatefn);
4635
4636     # now remove vmstate file
4637
4638     my $storecfg = PVE::Storage::config();
4639
4640     if ($snap->{vmstate}) {
4641         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4642         if (my $err = $@) {
4643             die $err if !$force;
4644             warn $err;
4645         }
4646         # save changes (remove vmstate from snapshot)
4647         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4648     };
4649
4650     # now remove all internal snapshots
4651     foreach_drive($snap, sub {
4652         my ($ds, $drive) = @_;
4653
4654         return if drive_is_cdrom($drive);
4655
4656         my $volid = $drive->{file};
4657         my $device = "drive-$ds";
4658
4659         if (!$drivehash || $drivehash->{$ds}) {
4660             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4661             if (my $err = $@) {
4662                 die $err if !$force;
4663                 warn $err;
4664             }
4665         }
4666
4667         # save changes (remove drive fron snapshot)
4668         lock_config($vmid, $updatefn, $ds) if !$force;
4669         push @$unused, $volid;
4670     });
4671
4672     # now cleanup config
4673     $prepare = 0;
4674     lock_config($vmid, $updatefn);
4675 }
4676
4677 sub has_feature {
4678     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4679
4680     my $err;
4681     foreach_drive($conf, sub {
4682         my ($ds, $drive) = @_;
4683
4684         return if drive_is_cdrom($drive);
4685         my $volid = $drive->{file};
4686         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4687     });
4688
4689     return $err ? 0 : 1;
4690 }
4691
4692 sub template_create {
4693     my ($vmid, $conf, $disk) = @_;
4694
4695     my $storecfg = PVE::Storage::config();
4696
4697     foreach_drive($conf, sub {
4698         my ($ds, $drive) = @_;
4699
4700         return if drive_is_cdrom($drive);
4701         return if $disk && $ds ne $disk;
4702
4703         my $volid = $drive->{file};
4704         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
4705
4706         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
4707         $drive->{file} = $voliddst;
4708         $conf->{$ds} = print_drive($vmid, $drive);
4709         update_config_nolock($vmid, $conf, 1);
4710     });
4711 }
4712
4713 sub is_template {
4714     my ($conf) = @_;
4715
4716     return 1 if defined $conf->{template} && $conf->{template} == 1;
4717 }
4718
4719 sub qemu_img_convert {
4720     my ($src_volid, $dst_volid, $size, $snapname) = @_;
4721
4722     my $storecfg = PVE::Storage::config();
4723     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
4724     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4725
4726     if ($src_storeid && $dst_storeid) {
4727         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
4728         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4729
4730         my $src_format = qemu_img_format($src_scfg, $src_volname);
4731         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
4732
4733         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
4734         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4735
4736         my $cmd = [];
4737         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
4738         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4739         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4740
4741         my $parser = sub {
4742             my $line = shift;
4743             if($line =~ m/\((\S+)\/100\%\)/){
4744                 my $percent = $1;
4745                 my $transferred = int($size * $percent / 100);
4746                 my $remaining = $size - $transferred;
4747
4748                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4749             }
4750
4751         };
4752
4753         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
4754         my $err = $@;
4755         die "copy failed: $err" if $err;
4756     }
4757 }
4758
4759 sub qemu_img_format {
4760     my ($scfg, $volname) = @_;
4761
4762     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4763         return $1;
4764     } elsif ($scfg->{type} eq 'iscsi') {
4765         return "host_device";
4766     } else {
4767         return "raw";
4768     }
4769 }
4770
4771 sub qemu_drive_mirror {
4772     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4773
4774     my $count = 1;
4775     my $old_len = 0;
4776     my $frozen = undef;
4777
4778     my $storecfg = PVE::Storage::config();
4779     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4780
4781     if ($dst_storeid) {
4782         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4783
4784         my $format;
4785         if ($dst_volname =~ m/\.(raw|qcow2)$/){
4786             $format = $1;
4787         }
4788
4789         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4790
4791         if ($format) {
4792             #fixme : sometime drive-mirror timeout, but works fine after.
4793             # (I have see the problem with big volume > 200GB), so we need to eval
4794             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
4795                               sync => "full", target => $dst_path, format => $format); };
4796         } else {
4797             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
4798                               sync => "full", target => $dst_path); };
4799         }
4800
4801         eval {
4802             while (1) {
4803                 my $stats = vm_mon_cmd($vmid, "query-block-jobs");
4804                 my $stat = @$stats[0];
4805                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4806                 die "error job is not mirroring" if $stat->{type} ne "mirror";
4807
4808                 my $transferred = $stat->{offset};
4809                 my $total = $stat->{len};
4810                 my $remaining = $total - $transferred;
4811                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4812
4813                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4814
4815                 last if ($stat->{len} == $stat->{offset});
4816                 if ($old_len == $stat->{offset}) {
4817                     if ($maxwait && $count > $maxwait) {
4818                     # if writes to disk occurs the disk needs to be freezed
4819                     # to be able to complete the migration
4820                         vm_suspend($vmid,1);
4821                         $count = 0;
4822                         $frozen = 1;
4823                     } else {
4824                         $count++ unless $frozen;
4825                     }
4826                 } elsif ($frozen) {
4827                     vm_resume($vmid,1);
4828                     $count = 0;
4829                 }
4830                 $old_len = $stat->{offset};
4831                 sleep 1;
4832             }
4833
4834             if ($vmiddst == $vmid) {
4835                 # switch the disk if source and destination are on the same guest
4836                 vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
4837             }
4838         };
4839         if (my $err = $@) {
4840             eval { vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
4841             die "mirroring error: $err";
4842         }
4843
4844         if ($vmiddst != $vmid) {
4845             # if we clone a disk for a new target vm, we don't switch the disk
4846             vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
4847         }
4848     }
4849 }
4850
4851 sub clone_disk {
4852     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
4853         $newvmid, $storage, $format, $full, $newvollist) = @_;
4854
4855     my $newvolid;
4856
4857     if (!$full) {
4858         print "create linked clone of drive $drivename ($drive->{file})\n";
4859         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid);
4860         push @$newvollist, $newvolid;
4861     } else {
4862         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
4863         $storeid = $storage if $storage;
4864
4865         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
4866         if (!$format) {
4867             $format = $drive->{format} || $defFormat;
4868         }
4869
4870         # test if requested format is supported - else use default
4871         my $supported = grep { $_ eq $format } @$validFormats;
4872         $format = $defFormat if !$supported;
4873
4874         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
4875
4876         print "create full clone of drive $drivename ($drive->{file})\n";
4877         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
4878         push @$newvollist, $newvolid;
4879
4880         if (!$running || $snapname) {
4881             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
4882         } else {
4883             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
4884         }
4885     }
4886
4887     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
4888
4889     my $disk = $drive;
4890     $disk->{format} = undef;
4891     $disk->{file} = $newvolid;
4892     $disk->{size} = $size;
4893
4894     return $disk;
4895 }
4896
4897 # this only works if VM is running
4898 sub get_current_qemu_machine {
4899     my ($vmid) = @_;
4900
4901     my $cmd = { execute => 'query-machines', arguments => {} };
4902     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
4903
4904     my ($current, $default);
4905     foreach my $e (@$res) {
4906         $default = $e->{name} if $e->{'is-default'};
4907         $current = $e->{name} if $e->{'is-current'};
4908     }
4909
4910     # fallback to the default machine if current is not supported by qemu
4911     return $current || $default || 'pc';
4912 }
4913
4914 sub read_x509_subject_spice {
4915     my ($filename) = @_;
4916
4917     # read x509 subject
4918     my $bio = Net::SSLeay::BIO_new_file($filename, 'r');
4919     my $x509 = Net::SSLeay::PEM_read_bio_X509($bio);
4920     Net::SSLeay::BIO_free($bio);
4921     my $nameobj = Net::SSLeay::X509_get_subject_name($x509);
4922     my $subject = Net::SSLeay::X509_NAME_oneline($nameobj);
4923     Net::SSLeay::X509_free($x509);
4924
4925     # remote-viewer wants comma as seperator (not '/')
4926     $subject =~ s!^/!!;
4927     $subject =~ s!/(\w+=)!,$1!g;
4928
4929     return $subject;
4930 }
4931 1;