PVE/QemuServer.pm

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