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