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