PVE/QemuServer.pm

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