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::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  26 use PVE::INotify;
  27 use PVE::ProcFSTools;
  28 use PVE::QMPClient;
  29 use Time::HiRes qw(gettimeofday);
  30
  31 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  32
  33 # Note about locking: we use flock on the config file protect
  34 # against concurent actions.
  35 # Aditionaly, we have a 'lock' setting in the config file. This
  36 # can be set to 'migrate' or 'backup'. Most actions are not
  37 # allowed when such lock is set. But you can ignore this kind of
  38 # lock with the --skiplock flag.
  39
  40 cfs_register_file('/qemu-server/',
  41                   \&parse_vm_config,
  42                   \&write_vm_config);
  43
  44 PVE::JSONSchema::register_standard_option('skiplock', {
  45     description => "Ignore locks - only root is allowed to use this option.",
  46     type => 'boolean',
  47     optional => 1,
  48 });
  49
  50 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  51     description => "Some command save/restore state from this location.",
  52     type => 'string',
  53     maxLength => 128,
  54     optional => 1,
  55 });
  56
  57 #no warnings 'redefine';
  58
  59 unless(defined(&_VZSYSCALLS_H_)) {
  60     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  61     require 'sys/syscall.ph';
  62     if(defined(&__x86_64__)) {
  63         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  64         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  65         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  66         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  67         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  68         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  69         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  70         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  71     }
  72     elsif(defined( &__i386__) ) {
  73         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  74         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  75         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  76         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  77         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  78         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  79         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  80         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  81     } else {
  82         die("no fairsched syscall for this arch");
  83     }
  84     require 'asm/ioctl.ph';
  85     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  86 }
  87
  88 sub fairsched_mknod {
  89     my ($parent, $weight, $desired) = @_;
  90
  91     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
  92 }
  93
  94 sub fairsched_rmnod {
  95     my ($id) = @_;
  96
  97     return syscall(&__NR_fairsched_rmnod, int($id));
  98 }
  99
 100 sub fairsched_mvpr {
 101     my ($pid, $newid) = @_;
 102
 103     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 104 }
 105
 106 sub fairsched_vcpus {
 107     my ($id, $vcpus) = @_;
 108
 109     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 110 }
 111
 112 sub fairsched_rate {
 113     my ($id, $op, $rate) = @_;
 114
 115     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 116 }
 117
 118 use constant FAIRSCHED_SET_RATE  => 0;
 119 use constant FAIRSCHED_DROP_RATE => 1;
 120 use constant FAIRSCHED_GET_RATE  => 2;
 121
 122 sub fairsched_cpulimit {
 123     my ($id, $limit) = @_;
 124
 125     my $cpulim1024 = int($limit * 1024 / 100);
 126     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 127
 128     return fairsched_rate($id, $op, $cpulim1024);
 129 }
 130
 131 my $nodename = PVE::INotify::nodename();
 132
 133 mkdir "/etc/pve/nodes/$nodename";
 134 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 135 mkdir $confdir;
 136
 137 my $var_run_tmpdir = "/var/run/qemu-server";
 138 mkdir $var_run_tmpdir;
 139
 140 my $lock_dir = "/var/lock/qemu-server";
 141 mkdir $lock_dir;
 142
 143 my $pcisysfs = "/sys/bus/pci";
 144
 145 my $confdesc = {
 146     onboot => {
 147         optional => 1,
 148         type => 'boolean',
 149         description => "Specifies whether a VM will be started during system bootup.",
 150         default => 0,
 151     },
 152     autostart => {
 153         optional => 1,
 154         type => 'boolean',
 155         description => "Automatic restart after crash (currently ignored).",
 156         default => 0,
 157     },
 158     hotplug => {
 159         optional => 1,
 160         type => 'boolean',
 161         description => "Activate hotplug for disk and network device",
 162         default => 0,
 163     },
 164     reboot => {
 165         optional => 1,
 166         type => 'boolean',
 167         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 168         default => 1,
 169     },
 170     lock => {
 171         optional => 1,
 172         type => 'string',
 173         description => "Lock/unlock the VM.",
 174         enum => [qw(migrate backup)],
 175     },
 176     cpulimit => {
 177         optional => 1,
 178         type => 'integer',
 179         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.",
 180         minimum => 0,
 181         default => 0,
 182     },
 183     cpuunits => {
 184         optional => 1,
 185         type => 'integer',
 186         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.",
 187         minimum => 0,
 188         maximum => 500000,
 189         default => 1000,
 190     },
 191     memory => {
 192         optional => 1,
 193         type => 'integer',
 194         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 195         minimum => 16,
 196         default => 512,
 197     },
 198     balloon => {
 199         optional => 1,
 200         type => 'integer',
 201         description => "Amount of target RAM for the VM in MB.",
 202         minimum => 16,
 203     },
 204     keyboard => {
 205         optional => 1,
 206         type => 'string',
 207         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 208         enum => PVE::Tools::kvmkeymaplist(),
 209         default => 'en-us',
 210     },
 211     name => {
 212         optional => 1,
 213         type => 'string', format => 'dns-name',
 214         description => "Set a name for the VM. Only used on the configuration web interface.",
 215     },
 216     scsihw => {
 217         optional => 1,
 218         type => 'string',
 219         description => "scsi controller model",
 220         enum => [qw(lsi virtio-scsi-pci)],
 221         default => 'lsi',
 222     },
 223     description => {
 224         optional => 1,
 225         type => 'string',
 226         description => "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
 227     },
 228     ostype => {
 229         optional => 1,
 230         type => 'string',
 231         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26)],
 232         description => <<EODESC,
 233 Used to enable special optimization/features for specific
 234 operating systems:
 235
 236 other  => unspecified OS
 237 wxp    => Microsoft Windows XP
 238 w2k    => Microsoft Windows 2000
 239 w2k3   => Microsoft Windows 2003
 240 w2k8   => Microsoft Windows 2008
 241 wvista => Microsoft Windows Vista
 242 win7   => Microsoft Windows 7
 243 l24    => Linux 2.4 Kernel
 244 l26    => Linux 2.6/3.X Kernel
 245
 246 other|l24|l26                  ... no special behaviour
 247 wxp|w2k|w2k3|w2k8|wvista|win7  ... use --localtime switch
 248 EODESC
 249     },
 250     boot => {
 251         optional => 1,
 252         type => 'string',
 253         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 254         pattern => '[acdn]{1,4}',
 255         default => 'cdn',
 256     },
 257     bootdisk => {
 258         optional => 1,
 259         type => 'string', format => 'pve-qm-bootdisk',
 260         description => "Enable booting from specified disk.",
 261         pattern => '(ide|scsi|virtio)\d+',
 262     },
 263     smp => {
 264         optional => 1,
 265         type => 'integer',
 266         description => "The number of CPUs. Please use option -sockets instead.",
 267         minimum => 1,
 268         default => 1,
 269     },
 270     sockets => {
 271         optional => 1,
 272         type => 'integer',
 273         description => "The number of CPU sockets.",
 274         minimum => 1,
 275         default => 1,
 276     },
 277     cores => {
 278         optional => 1,
 279         type => 'integer',
 280         description => "The number of cores per socket.",
 281         minimum => 1,
 282         default => 1,
 283     },
 284     acpi => {
 285         optional => 1,
 286         type => 'boolean',
 287         description => "Enable/disable ACPI.",
 288         default => 1,
 289     },
 290     kvm => {
 291         optional => 1,
 292         type => 'boolean',
 293         description => "Enable/disable KVM hardware virtualization.",
 294         default => 1,
 295     },
 296     tdf => {
 297         optional => 1,
 298         type => 'boolean',
 299         description => "Enable/disable time drift fix. This is ignored for kvm versions newer that 1.0 (not needed anymore).",
 300         default => 1,
 301     },
 302     localtime => {
 303         optional => 1,
 304         type => 'boolean',
 305         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 306     },
 307     freeze => {
 308         optional => 1,
 309         type => 'boolean',
 310         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 311     },
 312     vga => {
 313         optional => 1,
 314         type => 'string',
 315         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 win7/w2k8, and 'cirrur' for other OS types",
 316         enum => [qw(std cirrus vmware)],
 317     },
 318     watchdog => {
 319         optional => 1,
 320         type => 'string', format => 'pve-qm-watchdog',
 321         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 322         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)",
 323     },
 324     startdate => {
 325         optional => 1,
 326         type => 'string',
 327         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 328         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'.",
 329         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 330         default => 'now',
 331     },
 332     startup => {
 333         optional => 1,
 334         type => 'string', format => 'pve-qm-startup',
 335         typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 336         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.",
 337     },
 338     args => {
 339         optional => 1,
 340         type => 'string',
 341         description => <<EODESCR,
 342 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 343
 344 args: -no-reboot -no-hpet
 345 EODESCR
 346     },
 347     tablet => {
 348         optional => 1,
 349         type => 'boolean',
 350         default => 1,
 351         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.",
 352     },
 353     migrate_speed => {
 354         optional => 1,
 355         type => 'integer',
 356         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 357         minimum => 0,
 358         default => 0,
 359     },
 360     migrate_downtime => {
 361         optional => 1,
 362         type => 'integer',
 363         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 364         minimum => 0,
 365         default => 1,
 366     },
 367     cdrom => {
 368         optional => 1,
 369         type => 'string', format => 'pve-qm-drive',
 370         typetext => 'volume',
 371         description => "This is an alias for option -ide2",
 372     },
 373     cpu => {
 374         optional => 1,
 375         description => "Emulated CPU type.",
 376         type => 'string',
 377         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom cpu64-rhel6 cpu64-rhel5 Conroe Penryn Nehalem Westmere Opteron_G1 Opteron_G2 Opteron_G3 host) ],
 378         default => 'qemu64',
 379     },
 380 };
 381
 382 # what about other qemu settings ?
 383 #cpu => 'string',
 384 #machine => 'string',
 385 #fda => 'file',
 386 #fdb => 'file',
 387 #mtdblock => 'file',
 388 #sd => 'file',
 389 #pflash => 'file',
 390 #snapshot => 'bool',
 391 #bootp => 'file',
 392 ##tftp => 'dir',
 393 ##smb => 'dir',
 394 #kernel => 'file',
 395 #append => 'string',
 396 #initrd => 'file',
 397 ##soundhw => 'string',
 398
 399 while (my ($k, $v) = each %$confdesc) {
 400     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 401 }
 402
 403 my $MAX_IDE_DISKS = 4;
 404 my $MAX_SCSI_DISKS = 14;
 405 my $MAX_VIRTIO_DISKS = 16;
 406 my $MAX_SATA_DISKS = 6;
 407 my $MAX_USB_DEVICES = 5;
 408 my $MAX_NETS = 32;
 409 my $MAX_UNUSED_DISKS = 8;
 410 my $MAX_HOSTPCI_DEVICES = 2;
 411 my $MAX_SERIAL_PORTS = 4;
 412 my $MAX_PARALLEL_PORTS = 3;
 413
 414 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 415                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
 416 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 417
 418 # fixme:
 419 my $netdesc = {
 420     optional => 1,
 421     type => 'string', format => 'pve-qm-net',
 422     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
 423     description => <<EODESCR,
 424 Specify network devices.
 425
 426 MODEL is one of: $nic_model_list_txt
 427
 428 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 429 automatically generated if not specified.
 430
 431 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 432
 433 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'.
 434
 435 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 436
 437 10.0.2.2   Gateway
 438 10.0.2.3   DNS Server
 439 10.0.2.4   SMB Server
 440
 441 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 442
 443 EODESCR
 444 };
 445 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 446
 447 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 448     $confdesc->{"net$i"} = $netdesc;
 449 }
 450
 451 my $drivename_hash;
 452
 453 my $idedesc = {
 454     optional => 1,
 455     type => 'string', format => 'pve-qm-drive',
 456     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]',
 457     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
 458 };
 459 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 460
 461 my $scsidesc = {
 462     optional => 1,
 463     type => 'string', format => 'pve-qm-drive',
 464     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]',
 465     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
 466 };
 467 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 468
 469 my $satadesc = {
 470     optional => 1,
 471     type => 'string', format => 'pve-qm-drive',
 472     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]',
 473     description => "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
 474 };
 475 PVE::JSONSchema::register_standard_option("pve-qm-sata", $satadesc);
 476
 477 my $virtiodesc = {
 478     optional => 1,
 479     type => 'string', format => 'pve-qm-drive',
 480     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]',
 481     description => "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
 482 };
 483 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 484
 485 my $usbdesc = {
 486     optional => 1,
 487     type => 'string', format => 'pve-qm-usb-device',
 488     typetext => 'host=HOSTUSBDEVICE',
 489     description => <<EODESCR,
 490 Configure an USB device (n is 0 to 4). This can be used to
 491 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 492
 493 'bus-port(.port)*' (decimal numbers) or
 494 'vendor_id:product_id' (hexadeciaml numbers)
 495
 496 You can use the 'lsusb -t' command to list existing usb devices.
 497
 498 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 499
 500 EODESCR
 501 };
 502 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 503
 504 my $hostpcidesc = {
 505         optional => 1,
 506         type => 'string', format => 'pve-qm-hostpci',
 507         typetext => "HOSTPCIDEVICE",
 508         description => <<EODESCR,
 509 Map host pci devices. HOSTPCIDEVICE syntax is:
 510
 511 'bus:dev.func' (hexadecimal numbers)
 512
 513 You can us the 'lspci' command to list existing pci devices.
 514
 515 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 516
 517 Experimental: user reported problems with this option.
 518 EODESCR
 519 };
 520 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 521
 522 my $serialdesc = {
 523         optional => 1,
 524         type => 'string',
 525         pattern => '/dev/ttyS\d+',
 526         description =>  <<EODESCR,
 527 Map host serial devices (n is 0 to 3).
 528
 529 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 530
 531 Experimental: user reported problems with this option.
 532 EODESCR
 533 };
 534
 535 my $paralleldesc= {
 536         optional => 1,
 537         type => 'string',
 538         pattern => '/dev/parport\d+',
 539         description =>  <<EODESCR,
 540 Map host parallel devices (n is 0 to 2).
 541
 542 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 543
 544 Experimental: user reported problems with this option.
 545 EODESCR
 546 };
 547
 548 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 549     $confdesc->{"parallel$i"} = $paralleldesc;
 550 }
 551
 552 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 553     $confdesc->{"serial$i"} = $serialdesc;
 554 }
 555
 556 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 557     $confdesc->{"hostpci$i"} = $hostpcidesc;
 558 }
 559
 560 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 561     $drivename_hash->{"ide$i"} = 1;
 562     $confdesc->{"ide$i"} = $idedesc;
 563 }
 564
 565 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++)  {
 566     $drivename_hash->{"sata$i"} = 1;
 567     $confdesc->{"sata$i"} = $satadesc;
 568 }
 569
 570 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 571     $drivename_hash->{"scsi$i"} = 1;
 572     $confdesc->{"scsi$i"} = $scsidesc ;
 573 }
 574
 575 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 576     $drivename_hash->{"virtio$i"} = 1;
 577     $confdesc->{"virtio$i"} = $virtiodesc;
 578 }
 579
 580 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 581     $confdesc->{"usb$i"} = $usbdesc;
 582 }
 583
 584 my $unuseddesc = {
 585     optional => 1,
 586     type => 'string', format => 'pve-volume-id',
 587     description => "Reference to unused volumes.",
 588 };
 589
 590 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 591     $confdesc->{"unused$i"} = $unuseddesc;
 592 }
 593
 594 my $kvm_api_version = 0;
 595
 596 sub kvm_version {
 597
 598     return $kvm_api_version if $kvm_api_version;
 599
 600     my $fh = IO::File->new("</dev/kvm") ||
 601         return 0;
 602
 603     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 604         $kvm_api_version = $v;
 605     }
 606
 607     $fh->close();
 608
 609     return  $kvm_api_version;
 610 }
 611
 612 my $kvm_user_version;
 613
 614 sub kvm_user_version {
 615
 616     return $kvm_user_version if $kvm_user_version;
 617
 618     $kvm_user_version = 'unknown';
 619
 620     my $tmp = `kvm -help 2>/dev/null`;
 621
 622     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?) /) {
 623         $kvm_user_version = $2;
 624     }
 625
 626     return $kvm_user_version;
 627
 628 }
 629
 630 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 631
 632 sub disknames {
 633     # order is important - used to autoselect boot disk
 634     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 635             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 636             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
 637             (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
 638 }
 639
 640 sub valid_drivename {
 641     my $dev = shift;
 642
 643     return defined($drivename_hash->{$dev});
 644 }
 645
 646 sub option_exists {
 647     my $key = shift;
 648     return defined($confdesc->{$key});
 649 }
 650
 651 sub nic_models {
 652     return $nic_model_list;
 653 }
 654
 655 sub os_list_description {
 656
 657     return {
 658         other => 'Other',
 659         wxp => 'Windows XP',
 660         w2k => 'Windows 2000',
 661         w2k3 =>, 'Windows 2003',
 662         w2k8 => 'Windows 2008',
 663         wvista => 'Windows Vista',
 664         win7 => 'Windows 7',
 665         l24 => 'Linux 2.4',
 666         l26 => 'Linux 2.6',
 667     };
 668 }
 669
 670 my $cdrom_path;
 671
 672 sub get_cdrom_path {
 673
 674     return  $cdrom_path if $cdrom_path;
 675
 676     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 677     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 678     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 679 }
 680
 681 sub get_iso_path {
 682     my ($storecfg, $vmid, $cdrom) = @_;
 683
 684     if ($cdrom eq 'cdrom') {
 685         return get_cdrom_path();
 686     } elsif ($cdrom eq 'none') {
 687         return '';
 688     } elsif ($cdrom =~ m|^/|) {
 689         return $cdrom;
 690     } else {
 691         return PVE::Storage::path($storecfg, $cdrom);
 692     }
 693 }
 694
 695 # try to convert old style file names to volume IDs
 696 sub filename_to_volume_id {
 697     my ($vmid, $file, $media) = @_;
 698
 699     if (!($file eq 'none' || $file eq 'cdrom' ||
 700           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 701
 702         return undef if $file =~ m|/|;
 703
 704         if ($media && $media eq 'cdrom') {
 705             $file = "local:iso/$file";
 706         } else {
 707             $file = "local:$vmid/$file";
 708         }
 709     }
 710
 711     return $file;
 712 }
 713
 714 sub verify_media_type {
 715     my ($opt, $vtype, $media) = @_;
 716
 717     return if !$media;
 718
 719     my $etype;
 720     if ($media eq 'disk') {
 721         $etype = 'images';
 722     } elsif ($media eq 'cdrom') {
 723         $etype = 'iso';
 724     } else {
 725         die "internal error";
 726     }
 727
 728     return if ($vtype eq $etype);
 729
 730     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 731 }
 732
 733 sub cleanup_drive_path {
 734     my ($opt, $storecfg, $drive) = @_;
 735
 736     # try to convert filesystem paths to volume IDs
 737
 738     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 739         ($drive->{file} !~ m|^/dev/.+|) &&
 740         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 741         ($drive->{file} !~ m/^\d+$/)) {
 742         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 743         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 744         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 745         verify_media_type($opt, $vtype, $drive->{media});
 746         $drive->{file} = $volid;
 747     }
 748
 749     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 750 }
 751
 752 sub create_conf_nolock {
 753     my ($vmid, $settings) = @_;
 754
 755     my $filename = config_file($vmid);
 756
 757     die "configuration file '$filename' already exists\n" if -f $filename;
 758
 759     my $defaults = load_defaults();
 760
 761     $settings->{name} = "vm$vmid" if !$settings->{name};
 762     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 763
 764     my $data = '';
 765     foreach my $opt (keys %$settings) {
 766         next if !$confdesc->{$opt};
 767
 768         my $value = $settings->{$opt};
 769         next if !$value;
 770
 771         $data .= "$opt: $value\n";
 772     }
 773
 774     PVE::Tools::file_set_contents($filename, $data);
 775 }
 776
 777 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 778 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 779 #        [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
 780 #        [,aio=native|threads]
 781
 782 sub parse_drive {
 783     my ($key, $data) = @_;
 784
 785     my $res = {};
 786
 787     # $key may be undefined - used to verify JSON parameters
 788     if (!defined($key)) {
 789         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 790         $res->{index} = 0;
 791     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 792         $res->{interface} = $1;
 793         $res->{index} = $2;
 794     } else {
 795         return undef;
 796     }
 797
 798     foreach my $p (split (/,/, $data)) {
 799         next if $p =~ m/^\s*$/;
 800
 801         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|bps_rd|bps_wr|iops|iops_rd|iops_wr|size)=(.+)$/) {
 802             my ($k, $v) = ($1, $2);
 803
 804             $k = 'file' if $k eq 'volume';
 805
 806             return undef if defined $res->{$k};
 807
 808             $res->{$k} = $v;
 809         } else {
 810             if (!$res->{file} && $p !~ m/=/) {
 811                 $res->{file} = $p;
 812             } else {
 813                 return undef;
 814             }
 815         }
 816     }
 817
 818     return undef if !$res->{file};
 819
 820     return undef if $res->{cache} &&
 821         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
 822     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 823     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 824     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 825     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 826     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 827     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
 828     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
 829     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
 830     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
 831     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 832     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
 833
 834     return undef if $res->{bps_rd} && $res->{bps};
 835     return undef if $res->{bps_wr} && $res->{bps};
 836     return undef if $res->{iops_rd} && $res->{iops};
 837     return undef if $res->{iops_wr} && $res->{iops};
 838
 839     return undef if $res->{bps} && $res->{bps} !~ m/^\d+$/;
 840     return undef if $res->{bps_rd} && $res->{bps_rd} !~ m/^\d+$/;
 841     return undef if $res->{bps_wr} && $res->{bps_wr} !~ m/^\d+$/;
 842     return undef if $res->{iops} && $res->{iops} !~ m/^\d+$/;
 843     return undef if $res->{iops_rd} && $res->{iops_rd} !~ m/^\d+$/;
 844     return undef if $res->{iops_wr} && $res->{iops_wr} !~ m/^\d+$/;
 845
 846
 847     if ($res->{size}) {
 848         return undef if $res->{size} !~ m/^([1-9]\d*(\.\d+)?)([KMG])?$/;
 849         my ($size, $unit) = ($1, $3);
 850         if ($unit) {
 851             if ($unit eq 'K') {
 852                 $size = $size * 1024;
 853             } elsif ($unit eq 'M') {
 854                 $size = $size * 1024 * 1024;
 855             } elsif ($unit eq 'G') {
 856                 $size = $size * 1024 * 1024 * 1024;
 857             }
 858         }
 859         $res->{size} = int($size);
 860     }
 861
 862     if ($res->{media} && ($res->{media} eq 'cdrom')) {
 863         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
 864         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
 865         return undef if $res->{interface} eq 'virtio';
 866     }
 867
 868     # rerror does not work with scsi drives
 869     if ($res->{rerror}) {
 870         return undef if $res->{interface} eq 'scsi';
 871     }
 872
 873     return $res;
 874 }
 875
 876 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio bps bps_rd bps_wr iops iops_rd iops_wr);
 877
 878 my $format_size = sub {
 879     my ($size) = @_;
 880
 881     $size = int($size);
 882
 883     my $kb = int($size/1024);
 884     return $size if $kb*1024 != $size;
 885
 886     my $mb = int($kb/1024);
 887     return "${kb}K" if $mb*1024 != $kb;
 888
 889     my $gb = int($mb/1024);
 890     return "${mb}M" if $gb*1024 != $mb;
 891
 892     return "${gb}G";
 893 };
 894
 895 sub print_drive {
 896     my ($vmid, $drive) = @_;
 897
 898     my $opts = '';
 899     foreach my $o (@qemu_drive_options, 'backup') {
 900         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 901     }
 902
 903     if ($drive->{size}) {
 904         $opts .= ",size=" . &$format_size($drive->{size});
 905     }
 906
 907     return "$drive->{file}$opts";
 908 }
 909
 910 sub scsi_inquiry {
 911     my($fh, $noerr) = @_;
 912
 913     my $SG_IO = 0x2285;
 914     my $SG_GET_VERSION_NUM = 0x2282;
 915
 916     my $versionbuf = "\x00" x 8;
 917     my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
 918     if (!$ret) {
 919         die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
 920         return undef;
 921     }
 922     my $version = unpack("I", $versionbuf);
 923     if ($version < 30000) {
 924         die "scsi generic interface too old\n"  if !$noerr;
 925         return undef;
 926     }
 927
 928     my $buf = "\x00" x 36;
 929     my $sensebuf = "\x00" x 8;
 930     my $cmd = pack("C x3 C x11", 0x12, 36);
 931
 932     # see /usr/include/scsi/sg.h
 933     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";
 934
 935     my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
 936                       length($sensebuf), 0, length($buf), $buf,
 937                       $cmd, $sensebuf, 6000);
 938
 939     $ret = ioctl($fh, $SG_IO, $packet);
 940     if (!$ret) {
 941         die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
 942         return undef;
 943     }
 944
 945     my @res = unpack($sg_io_hdr_t, $packet);
 946     if ($res[17] || $res[18]) {
 947         die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
 948         return undef;
 949     }
 950
 951     my $res = {};
 952     ($res->{device}, $res->{removable}, $res->{venodor},
 953      $res->{product}, $res->{revision}) = unpack("C C x6 A8 A16 A4", $buf);
 954
 955     return $res;
 956 }
 957
 958 sub path_is_scsi {
 959     my ($path) = @_;
 960
 961     my $fh = IO::File->new("+<$path") || return undef;
 962     my $res = scsi_inquiry($fh, 1);
 963     close($fh);
 964
 965     return $res;
 966 }
 967
 968 sub print_drivedevice_full {
 969     my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
 970
 971     my $device = '';
 972     my $maxdev = 0;
 973
 974     if ($drive->{interface} eq 'virtio') {
 975         my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}", $bridges);
 976         $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
 977     } elsif ($drive->{interface} eq 'scsi') {
 978         $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
 979         my $controller = int($drive->{index} / $maxdev);
 980         my $unit = $drive->{index} % $maxdev;
 981         my $devicetype = 'hd';
 982         my $path = '';
 983         if (drive_is_cdrom($drive)) {
 984               $devicetype = 'cd';
 985           } else {
 986               if ($drive->{file} =~ m|^/|) {
 987                   $path = $drive->{file};
 988               } else {
 989                   $path = PVE::Storage::path($storecfg, $drive->{file});
 990               }
 991               $devicetype = 'block' if path_is_scsi($path);
 992          }
 993
 994         if (!$conf->{scsihw} || $conf->{scsihw} eq 'lsi'){
 995             $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';
 996         } else {
 997             $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}";
 998         }
 999
1000     } elsif ($drive->{interface} eq 'ide'){
1001         $maxdev = 2;
1002         my $controller = int($drive->{index} / $maxdev);
1003         my $unit = $drive->{index} % $maxdev;
1004         my $devicetype = ($drive->{media} && $drive->{media} eq 'cdrom') ? "cd" : "hd";
1005
1006         $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1007     } elsif ($drive->{interface} eq 'sata'){
1008         my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1009         my $unit = $drive->{index} % $MAX_SATA_DISKS;
1010         $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1011     } elsif ($drive->{interface} eq 'usb') {
1012         die "implement me";
1013         #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1014     } else {
1015         die "unsupported interface type";
1016     }
1017
1018     $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex};
1019
1020     return $device;
1021 }
1022
1023 sub print_drive_full {
1024     my ($storecfg, $vmid, $drive) = @_;
1025
1026     my $opts = '';
1027     foreach my $o (@qemu_drive_options) {
1028         next if $o eq 'bootindex';
1029         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1030     }
1031
1032     # use linux-aio by default (qemu default is threads)
1033     $opts .= ",aio=native" if !$drive->{aio};
1034
1035     my $path;
1036     my $volid = $drive->{file};
1037     if (drive_is_cdrom($drive)) {
1038         $path = get_iso_path($storecfg, $vmid, $volid);
1039     } else {
1040         if ($volid =~ m|^/|) {
1041             $path = $volid;
1042         } else {
1043             $path = PVE::Storage::path($storecfg, $volid);
1044         }
1045         if (!$drive->{cache} && ($path =~ m|^/dev/| || $path =~ m|\.raw$|)) {
1046             $opts .= ",cache=none";
1047         }
1048     }
1049
1050     my $pathinfo = $path ? "file=$path," : '';
1051
1052     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1053 }
1054
1055 sub print_netdevice_full {
1056     my ($vmid, $conf, $net, $netid, $bridges) = @_;
1057
1058     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
1059
1060     my $device = $net->{model};
1061     if ($net->{model} eq 'virtio') {
1062          $device = 'virtio-net-pci';
1063      };
1064
1065     # qemu > 0.15 always try to boot from network - we disable that by
1066     # not loading the pxe rom file
1067     my $extra = ($bootorder !~ m/n/) ? "romfile=," : '';
1068     my $pciaddr = print_pci_addr("$netid", $bridges);
1069     my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1070     $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
1071     return $tmpstr;
1072 }
1073
1074 sub print_netdev_full {
1075     my ($vmid, $conf, $net, $netid) = @_;
1076
1077     my $i = '';
1078     if ($netid =~ m/^net(\d+)$/) {
1079         $i = int($1);
1080     }
1081
1082     die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
1083
1084     my $ifname = "tap${vmid}i$i";
1085
1086     # kvm uses TUNSETIFF ioctl, and that limits ifname length
1087     die "interface name '$ifname' is too long (max 15 character)\n"
1088         if length($ifname) >= 16;
1089
1090     my $vhostparam = '';
1091     $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model} eq 'virtio';
1092
1093     my $vmname = $conf->{name} || "vm$vmid";
1094
1095     if ($net->{bridge}) {
1096         return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1097     } else {
1098         return "type=user,id=$netid,hostname=$vmname";
1099     }
1100 }
1101
1102 sub drive_is_cdrom {
1103     my ($drive) = @_;
1104
1105     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
1106
1107 }
1108
1109 sub parse_hostpci {
1110     my ($value) = @_;
1111
1112     return undef if !$value;
1113
1114     my $res = {};
1115
1116     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1117        $res->{pciid} = $value;
1118     } else {
1119        return undef;
1120     }
1121
1122     return $res;
1123 }
1124
1125 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1126 sub parse_net {
1127     my ($data) = @_;
1128
1129     my $res = {};
1130
1131     foreach my $kvp (split(/,/, $data)) {
1132
1133         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1134             my $model = lc($1);
1135             my $mac = uc($3) || PVE::Tools::random_ether_addr();
1136             $res->{model} = $model;
1137             $res->{macaddr} = $mac;
1138         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1139             $res->{bridge} = $1;
1140         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1141             $res->{rate} = $1;
1142         } elsif ($kvp =~ m/^tag=(\d+)$/) {
1143             $res->{tag} = $1;
1144         } else {
1145             return undef;
1146         }
1147
1148     }
1149
1150     return undef if !$res->{model};
1151
1152     return $res;
1153 }
1154
1155 sub print_net {
1156     my $net = shift;
1157
1158     my $res = "$net->{model}";
1159     $res .= "=$net->{macaddr}" if $net->{macaddr};
1160     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1161     $res .= ",rate=$net->{rate}" if $net->{rate};
1162     $res .= ",tag=$net->{tag}" if $net->{tag};
1163
1164     return $res;
1165 }
1166
1167 sub add_random_macs {
1168     my ($settings) = @_;
1169
1170     foreach my $opt (keys %$settings) {
1171         next if $opt !~ m/^net(\d+)$/;
1172         my $net = parse_net($settings->{$opt});
1173         next if !$net;
1174         $settings->{$opt} = print_net($net);
1175     }
1176 }
1177
1178 sub add_unused_volume {
1179     my ($config, $volid) = @_;
1180
1181     my $key;
1182     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1183         my $test = "unused$ind";
1184         if (my $vid = $config->{$test}) {
1185             return if $vid eq $volid; # do not add duplicates
1186         } else {
1187             $key = $test;
1188         }
1189     }
1190
1191     die "To many unused volume - please delete them first.\n" if !$key;
1192
1193     $config->{$key} = $volid;
1194
1195     return $key;
1196 }
1197
1198 # fixme: remove all thos $noerr parameters?
1199
1200 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1201 sub verify_bootdisk {
1202     my ($value, $noerr) = @_;
1203
1204     return $value if valid_drivename($value);
1205
1206     return undef if $noerr;
1207
1208     die "invalid boot disk '$value'\n";
1209 }
1210
1211 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1212 sub verify_net {
1213     my ($value, $noerr) = @_;
1214
1215     return $value if parse_net($value);
1216
1217     return undef if $noerr;
1218
1219     die "unable to parse network options\n";
1220 }
1221
1222 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1223 sub verify_drive {
1224     my ($value, $noerr) = @_;
1225
1226     return $value if parse_drive(undef, $value);
1227
1228     return undef if $noerr;
1229
1230     die "unable to parse drive options\n";
1231 }
1232
1233 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1234 sub verify_hostpci {
1235     my ($value, $noerr) = @_;
1236
1237     return $value if parse_hostpci($value);
1238
1239     return undef if $noerr;
1240
1241     die "unable to parse pci id\n";
1242 }
1243
1244 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1245 sub verify_watchdog {
1246     my ($value, $noerr) = @_;
1247
1248     return $value if parse_watchdog($value);
1249
1250     return undef if $noerr;
1251
1252     die "unable to parse watchdog options\n";
1253 }
1254
1255 sub parse_watchdog {
1256     my ($value) = @_;
1257
1258     return undef if !$value;
1259
1260     my $res = {};
1261
1262     foreach my $p (split(/,/, $value)) {
1263         next if $p =~ m/^\s*$/;
1264
1265         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1266             $res->{model} = $2;
1267         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1268             $res->{action} = $2;
1269         } else {
1270             return undef;
1271         }
1272     }
1273
1274     return $res;
1275 }
1276
1277 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1278 sub verify_startup {
1279     my ($value, $noerr) = @_;
1280
1281     return $value if parse_startup($value);
1282
1283     return undef if $noerr;
1284
1285     die "unable to parse startup options\n";
1286 }
1287
1288 sub parse_startup {
1289     my ($value) = @_;
1290
1291     return undef if !$value;
1292
1293     my $res = {};
1294
1295     foreach my $p (split(/,/, $value)) {
1296         next if $p =~ m/^\s*$/;
1297
1298         if ($p =~ m/^(order=)?(\d+)$/) {
1299             $res->{order} = $2;
1300         } elsif ($p =~ m/^up=(\d+)$/) {
1301             $res->{up} = $1;
1302         } elsif ($p =~ m/^down=(\d+)$/) {
1303             $res->{down} = $1;
1304         } else {
1305             return undef;
1306         }
1307     }
1308
1309     return $res;
1310 }
1311
1312 sub parse_usb_device {
1313     my ($value) = @_;
1314
1315     return undef if !$value;
1316
1317     my @dl = split(/,/, $value);
1318     my $found;
1319
1320     my $res = {};
1321     foreach my $v (@dl) {
1322         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1323             $found = 1;
1324             $res->{vendorid} = $2;
1325             $res->{productid} = $4;
1326         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1327             $found = 1;
1328             $res->{hostbus} = $1;
1329             $res->{hostport} = $2;
1330         } else {
1331             return undef;
1332         }
1333     }
1334     return undef if !$found;
1335
1336     return $res;
1337 }
1338
1339 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1340 sub verify_usb_device {
1341     my ($value, $noerr) = @_;
1342
1343     return $value if parse_usb_device($value);
1344
1345     return undef if $noerr;
1346
1347     die "unable to parse usb device\n";
1348 }
1349
1350 # add JSON properties for create and set function
1351 sub json_config_properties {
1352     my $prop = shift;
1353
1354     foreach my $opt (keys %$confdesc) {
1355         $prop->{$opt} = $confdesc->{$opt};
1356     }
1357
1358     return $prop;
1359 }
1360
1361 sub check_type {
1362     my ($key, $value) = @_;
1363
1364     die "unknown setting '$key'\n" if !$confdesc->{$key};
1365
1366     my $type = $confdesc->{$key}->{type};
1367
1368     if (!defined($value)) {
1369         die "got undefined value\n";
1370     }
1371
1372     if ($value =~ m/[\n\r]/) {
1373         die "property contains a line feed\n";
1374     }
1375
1376     if ($type eq 'boolean') {
1377         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1378         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1379         die "type check ('boolean') failed - got '$value'\n";
1380     } elsif ($type eq 'integer') {
1381         return int($1) if $value =~ m/^(\d+)$/;
1382         die "type check ('integer') failed - got '$value'\n";
1383     } elsif ($type eq 'string') {
1384         if (my $fmt = $confdesc->{$key}->{format}) {
1385             if ($fmt eq 'pve-qm-drive') {
1386                 # special case - we need to pass $key to parse_drive()
1387                 my $drive = parse_drive($key, $value);
1388                 return $value if $drive;
1389                 die "unable to parse drive options\n";
1390             }
1391             PVE::JSONSchema::check_format($fmt, $value);
1392             return $value;
1393         }
1394         $value =~ s/^\"(.*)\"$/$1/;
1395         return $value;
1396     } else {
1397         die "internal error"
1398     }
1399 }
1400
1401 sub lock_config_full {
1402     my ($vmid, $timeout, $code, @param) = @_;
1403
1404     my $filename = config_file_lock($vmid);
1405
1406     my $res = lock_file($filename, $timeout, $code, @param);
1407
1408     die $@ if $@;
1409
1410     return $res;
1411 }
1412
1413 sub lock_config {
1414     my ($vmid, $code, @param) = @_;
1415
1416     return lock_config_full($vmid, 10, $code, @param);
1417 }
1418
1419 sub cfs_config_path {
1420     my ($vmid, $node) = @_;
1421
1422     $node = $nodename if !$node;
1423     return "nodes/$node/qemu-server/$vmid.conf";
1424 }
1425
1426 sub check_iommu_support{
1427     #fixme : need to check IOMMU support
1428     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1429
1430     my $iommu=1;
1431     return $iommu;
1432
1433 }
1434
1435 sub config_file {
1436     my ($vmid, $node) = @_;
1437
1438     my $cfspath = cfs_config_path($vmid, $node);
1439     return "/etc/pve/$cfspath";
1440 }
1441
1442 sub config_file_lock {
1443     my ($vmid) = @_;
1444
1445     return "$lock_dir/lock-$vmid.conf";
1446 }
1447
1448 sub touch_config {
1449     my ($vmid) = @_;
1450
1451     my $conf = config_file($vmid);
1452     utime undef, undef, $conf;
1453 }
1454
1455 sub destroy_vm {
1456     my ($storecfg, $vmid, $keep_empty_config) = @_;
1457
1458     my $conffile = config_file($vmid);
1459
1460     my $conf = load_config($vmid);
1461
1462     check_lock($conf);
1463
1464     # only remove disks owned by this VM
1465     foreach_drive($conf, sub {
1466         my ($ds, $drive) = @_;
1467
1468         return if drive_is_cdrom($drive);
1469
1470         my $volid = $drive->{file};
1471         return if !$volid || $volid =~ m|^/|;
1472
1473         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1474         return if !$path || !$owner || ($owner != $vmid);
1475
1476         PVE::Storage::vdisk_free($storecfg, $volid);
1477     });
1478
1479     if ($keep_empty_config) {
1480         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1481     } else {
1482         unlink $conffile;
1483     }
1484
1485     # also remove unused disk
1486     eval {
1487         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1488
1489         eval {
1490             PVE::Storage::foreach_volid($dl, sub {
1491                 my ($volid, $sid, $volname, $d) = @_;
1492                 PVE::Storage::vdisk_free($storecfg, $volid);
1493             });
1494         };
1495         warn $@ if $@;
1496
1497     };
1498     warn $@ if $@;
1499 }
1500
1501 sub load_config {
1502     my ($vmid, $node) = @_;
1503
1504     my $cfspath = cfs_config_path($vmid, $node);
1505
1506     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1507
1508     die "no such VM ('$vmid')\n" if !defined($conf);
1509
1510     return $conf;
1511 }
1512
1513 sub parse_vm_config {
1514     my ($filename, $raw) = @_;
1515
1516     return undef if !defined($raw);
1517
1518     my $res = {
1519         digest => Digest::SHA::sha1_hex($raw),
1520     };
1521
1522     $filename =~ m|/qemu-server/(\d+)\.conf$|
1523         || die "got strange filename '$filename'";
1524
1525     my $vmid = $1;
1526
1527     my $descr = '';
1528
1529     while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
1530         my $line = $1;
1531
1532         next if $line =~ m/^\s*$/;
1533
1534         if ($line =~ m/^\#(.*)\s*$/) {
1535             $descr .= PVE::Tools::decode_text($1) . "\n";
1536             next;
1537         }
1538
1539         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1540             $descr .= PVE::Tools::decode_text($2);
1541         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1542             my $key = $1;
1543             my $value = $2;
1544             $res->{$key} = $value;
1545         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1546             my $key = $1;
1547             my $value = $2;
1548             eval { $value = check_type($key, $value); };
1549             if ($@) {
1550                 warn "vm $vmid - unable to parse value of '$key' - $@";
1551             } else {
1552                 my $fmt = $confdesc->{$key}->{format};
1553                 if ($fmt && $fmt eq 'pve-qm-drive') {
1554                     my $v = parse_drive($key, $value);
1555                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1556                         $v->{file} = $volid;
1557                         $value = print_drive($vmid, $v);
1558                     } else {
1559                         warn "vm $vmid - unable to parse value of '$key'\n";
1560                         next;
1561                     }
1562                 }
1563
1564                 if ($key eq 'cdrom') {
1565                     $res->{ide2} = $value;
1566                 } else {
1567                     $res->{$key} = $value;
1568                 }
1569             }
1570         }
1571     }
1572
1573     $res->{description} = $descr if $descr;
1574
1575     # convert old smp to sockets
1576     if ($res->{smp} && !$res->{sockets}) {
1577         $res->{sockets} = $res->{smp};
1578     }
1579     delete $res->{smp};
1580
1581     return $res;
1582 }
1583
1584 sub write_vm_config {
1585     my ($filename, $conf) = @_;
1586
1587     if ($conf->{cdrom}) {
1588         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1589         $conf->{ide2} = $conf->{cdrom};
1590         delete $conf->{cdrom};
1591     }
1592
1593     # we do not use 'smp' any longer
1594     if ($conf->{sockets}) {
1595         delete $conf->{smp};
1596     } elsif ($conf->{smp}) {
1597         $conf->{sockets} = $conf->{smp};
1598         delete $conf->{cores};
1599         delete $conf->{smp};
1600     }
1601
1602     my $new_volids = {};
1603     foreach my $key (keys %$conf) {
1604         next if $key eq 'digest' || $key eq 'description';
1605         my $value = $conf->{$key};
1606         eval { $value = check_type($key, $value); };
1607         die "unable to parse value of '$key' - $@" if $@;
1608
1609         $conf->{$key} = $value;
1610
1611         if (valid_drivename($key)) {
1612             my $drive = PVE::QemuServer::parse_drive($key, $value);
1613             $new_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1614         }
1615     }
1616
1617     # remove 'unusedX' settings if we re-add a volume
1618     foreach my $key (keys %$conf) {
1619         my $value = $conf->{$key};
1620         if ($key =~ m/^unused/ && $new_volids->{$value}) {
1621             delete $conf->{$key};
1622         }
1623     }
1624
1625     # gererate RAW data
1626     my $raw = '';
1627
1628     # add description as comment to top of file
1629     my $descr = $conf->{description} || '';
1630     foreach my $cl (split(/\n/, $descr)) {
1631         $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1632     }
1633
1634     foreach my $key (sort keys %$conf) {
1635         next if $key eq 'digest' || $key eq 'description';
1636         $raw .= "$key: $conf->{$key}\n";
1637     }
1638
1639     return $raw;
1640 }
1641
1642 sub update_config_nolock {
1643     my ($vmid, $conf, $skiplock) = @_;
1644
1645     check_lock($conf) if !$skiplock;
1646
1647     my $cfspath = cfs_config_path($vmid);
1648
1649     PVE::Cluster::cfs_write_file($cfspath, $conf);
1650 }
1651
1652 sub update_config {
1653     my ($vmid, $conf, $skiplock) = @_;
1654
1655     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1656 }
1657
1658 sub load_defaults {
1659
1660     my $res = {};
1661
1662     # we use static defaults from our JSON schema configuration
1663     foreach my $key (keys %$confdesc) {
1664         if (defined(my $default = $confdesc->{$key}->{default})) {
1665             $res->{$key} = $default;
1666         }
1667     }
1668
1669     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1670     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1671
1672     return $res;
1673 }
1674
1675 sub config_list {
1676     my $vmlist = PVE::Cluster::get_vmlist();
1677     my $res = {};
1678     return $res if !$vmlist || !$vmlist->{ids};
1679     my $ids = $vmlist->{ids};
1680
1681     foreach my $vmid (keys %$ids) {
1682         my $d = $ids->{$vmid};
1683         next if !$d->{node} || $d->{node} ne $nodename;
1684         next if !$d->{type} || $d->{type} ne 'qemu';
1685         $res->{$vmid}->{exists} = 1;
1686     }
1687     return $res;
1688 }
1689
1690 # test if VM uses local resources (to prevent migration)
1691 sub check_local_resources {
1692     my ($conf, $noerr) = @_;
1693
1694     my $loc_res = 0;
1695
1696     $loc_res = 1 if $conf->{hostusb}; # old syntax
1697     $loc_res = 1 if $conf->{hostpci}; # old syntax
1698
1699     foreach my $k (keys %$conf) {
1700         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1701     }
1702
1703     die "VM uses local resources\n" if $loc_res && !$noerr;
1704
1705     return $loc_res;
1706 }
1707
1708 # check is used storages are available on all nodes (use by migrate)
1709 sub check_storage_availability {
1710     my ($storecfg, $conf, $node) = @_;
1711
1712     foreach_drive($conf, sub {
1713         my ($ds, $drive) = @_;
1714
1715         my $volid = $drive->{file};
1716         return if !$volid;
1717
1718         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1719         return if !$sid;
1720
1721         # check if storage is available on both nodes
1722         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1723         PVE::Storage::storage_check_node($storecfg, $sid, $node);
1724    });
1725 }
1726
1727 sub check_lock {
1728     my ($conf) = @_;
1729
1730     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1731 }
1732
1733 sub check_cmdline {
1734     my ($pidfile, $pid) = @_;
1735
1736     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1737     if (defined($fh)) {
1738         my $line = <$fh>;
1739         $fh->close;
1740         return undef if !$line;
1741         my @param = split(/\0/, $line);
1742
1743         my $cmd = $param[0];
1744         return if !$cmd || ($cmd !~ m|kvm$|);
1745
1746         for (my $i = 0; $i < scalar (@param); $i++) {
1747             my $p = $param[$i];
1748             next if !$p;
1749             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1750                 my $p = $param[$i+1];
1751                 return 1 if $p && ($p eq $pidfile);
1752                 return undef;
1753             }
1754         }
1755     }
1756     return undef;
1757 }
1758
1759 sub check_running {
1760     my ($vmid, $nocheck, $node) = @_;
1761
1762     my $filename = config_file($vmid, $node);
1763
1764     die "unable to find configuration file for VM $vmid - no such machine\n"
1765         if !$nocheck && ! -f $filename;
1766
1767     my $pidfile = pidfile_name($vmid);
1768
1769     if (my $fd = IO::File->new("<$pidfile")) {
1770         my $st = stat($fd);
1771         my $line = <$fd>;
1772         close($fd);
1773
1774         my $mtime = $st->mtime;
1775         if ($mtime > time()) {
1776             warn "file '$filename' modified in future\n";
1777         }
1778
1779         if ($line =~ m/^(\d+)$/) {
1780             my $pid = $1;
1781             if (check_cmdline($pidfile, $pid)) {
1782                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1783                     return $pid;
1784                 }
1785             }
1786         }
1787     }
1788
1789     return undef;
1790 }
1791
1792 sub vzlist {
1793
1794     my $vzlist = config_list();
1795
1796     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1797
1798     while (defined(my $de = $fd->read)) {
1799         next if $de !~ m/^(\d+)\.pid$/;
1800         my $vmid = $1;
1801         next if !defined($vzlist->{$vmid});
1802         if (my $pid = check_running($vmid)) {
1803             $vzlist->{$vmid}->{pid} = $pid;
1804         }
1805     }
1806
1807     return $vzlist;
1808 }
1809
1810 sub disksize {
1811     my ($storecfg, $conf) = @_;
1812
1813     my $bootdisk = $conf->{bootdisk};
1814     return undef if !$bootdisk;
1815     return undef if !valid_drivename($bootdisk);
1816
1817     return undef if !$conf->{$bootdisk};
1818
1819     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1820     return undef if !defined($drive);
1821
1822     return undef if drive_is_cdrom($drive);
1823
1824     my $volid = $drive->{file};
1825     return undef if !$volid;
1826
1827     return $drive->{size};
1828 }
1829
1830 my $last_proc_pid_stat;
1831
1832 # get VM status information
1833 # This must be fast and should not block ($full == false)
1834 # We only query KVM using QMP if $full == true (this can be slow)
1835 sub vmstatus {
1836     my ($opt_vmid, $full) = @_;
1837
1838     my $res = {};
1839
1840     my $storecfg = PVE::Storage::config();
1841
1842     my $list = vzlist();
1843     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
1844
1845     my $cpucount = $cpuinfo->{cpus} || 1;
1846
1847     foreach my $vmid (keys %$list) {
1848         next if $opt_vmid && ($vmid ne $opt_vmid);
1849
1850         my $cfspath = cfs_config_path($vmid);
1851         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
1852
1853         my $d = {};
1854         $d->{pid} = $list->{$vmid}->{pid};
1855
1856         # fixme: better status?
1857         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
1858
1859         my $size = disksize($storecfg, $conf);
1860         if (defined($size)) {
1861             $d->{disk} = 0; # no info available
1862             $d->{maxdisk} = $size;
1863         } else {
1864             $d->{disk} = 0;
1865             $d->{maxdisk} = 0;
1866         }
1867
1868         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
1869         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
1870
1871         $d->{name} = $conf->{name} || "VM $vmid";
1872         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
1873
1874         $d->{uptime} = 0;
1875         $d->{cpu} = 0;
1876         $d->{mem} = 0;
1877
1878         $d->{netout} = 0;
1879         $d->{netin} = 0;
1880
1881         $d->{diskread} = 0;
1882         $d->{diskwrite} = 0;
1883
1884         $res->{$vmid} = $d;
1885     }
1886
1887     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
1888     foreach my $dev (keys %$netdev) {
1889         next if $dev !~ m/^tap([1-9]\d*)i/;
1890         my $vmid = $1;
1891         my $d = $res->{$vmid};
1892         next if !$d;
1893
1894         $d->{netout} += $netdev->{$dev}->{receive};
1895         $d->{netin} += $netdev->{$dev}->{transmit};
1896     }
1897
1898     my $ctime = gettimeofday;
1899
1900     foreach my $vmid (keys %$list) {
1901
1902         my $d = $res->{$vmid};
1903         my $pid = $d->{pid};
1904         next if !$pid;
1905
1906         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
1907         next if !$pstat; # not running
1908
1909         my $used = $pstat->{utime} + $pstat->{stime};
1910
1911         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
1912
1913         if ($pstat->{vsize}) {
1914             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
1915         }
1916
1917         my $old = $last_proc_pid_stat->{$pid};
1918         if (!$old) {
1919             $last_proc_pid_stat->{$pid} = {
1920                 time => $ctime,
1921                 used => $used,
1922                 cpu => 0,
1923             };
1924             next;
1925         }
1926
1927         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
1928
1929         if ($dtime > 1000) {
1930             my $dutime = $used -  $old->{used};
1931
1932             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
1933             $last_proc_pid_stat->{$pid} = {
1934                 time => $ctime,
1935                 used => $used,
1936                 cpu => $d->{cpu},
1937             };
1938         } else {
1939             $d->{cpu} = $old->{cpu};
1940         }
1941     }
1942
1943     return $res if !$full;
1944
1945     my $qmpclient = PVE::QMPClient->new();
1946
1947     my $blockstatscb = sub {
1948         my ($vmid, $resp) = @_;
1949         my $data = $resp->{'return'} || [];
1950         my $totalrdbytes = 0;
1951         my $totalwrbytes = 0;
1952         for my $blockstat (@$data) {
1953             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
1954             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
1955         }
1956         $res->{$vmid}->{diskread} = $totalrdbytes;
1957         $res->{$vmid}->{diskwrite} = $totalwrbytes;
1958     };
1959
1960     my $statuscb = sub {
1961         my ($vmid, $resp) = @_;
1962         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
1963
1964         my $status = 'unknown';
1965         if (!defined($status = $resp->{'return'}->{status})) {
1966             warn "unable to get VM status\n";
1967             return;
1968         }
1969
1970         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
1971     };
1972
1973     foreach my $vmid (keys %$list) {
1974         next if $opt_vmid && ($vmid ne $opt_vmid);
1975         next if !$res->{$vmid}->{pid}; # not running
1976         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
1977     }
1978
1979     $qmpclient->queue_execute();
1980
1981     foreach my $vmid (keys %$list) {
1982         next if $opt_vmid && ($vmid ne $opt_vmid);
1983         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
1984     }
1985
1986     return $res;
1987 }
1988
1989 sub foreach_drive {
1990     my ($conf, $func) = @_;
1991
1992     foreach my $ds (keys %$conf) {
1993         next if !valid_drivename($ds);
1994
1995         my $drive = parse_drive($ds, $conf->{$ds});
1996         next if !$drive;
1997
1998         &$func($ds, $drive);
1999     }
2000 }
2001
2002 sub config_to_command {
2003     my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
2004
2005     my $cmd = [];
2006     my $devices = [];
2007     my $pciaddr = '';
2008     my $bridges = {};
2009     my $kvmver = kvm_user_version();
2010     my $vernum = 0; # unknown
2011     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2012         $vernum = $1*1000000+$2*1000;
2013     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2014         $vernum = $1*1000000+$2*1000+$3;
2015     }
2016
2017     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2018
2019     my $have_ovz = -f '/proc/vz/vestat';
2020
2021     push @$cmd, '/usr/bin/kvm';
2022
2023     push @$cmd, '-id', $vmid;
2024
2025     my $use_virtio = 0;
2026
2027     my $qmpsocket = qmp_socket($vmid);
2028     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2029     push @$cmd, '-mon', "chardev=qmp,mode=control";
2030
2031     my $socket = vnc_socket($vmid);
2032     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2033
2034     push @$cmd, '-pidfile' , pidfile_name($vmid);
2035
2036     push @$cmd, '-daemonize';
2037
2038     push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
2039
2040     my $use_usb2 = 0;
2041     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2042         next if !$conf->{"usb$i"};
2043         $use_usb2 = 1;
2044     }
2045     # include usb device config
2046     push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2047
2048     # enable absolute mouse coordinates (needed by vnc)
2049     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
2050     if ($tablet) {
2051         if ($use_usb2) {
2052             push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
2053         } else {
2054             push @$devices, '-usbdevice', 'tablet';
2055         }
2056     }
2057
2058     # host pci devices
2059     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2060           my $d = parse_hostpci($conf->{"hostpci$i"});
2061           next if !$d;
2062           $pciaddr = print_pci_addr("hostpci$i", $bridges);
2063           push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2064     }
2065
2066     # usb devices
2067     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2068         my $d = parse_usb_device($conf->{"usb$i"});
2069         next if !$d;
2070         if ($d->{vendorid} && $d->{productid}) {
2071             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2072         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2073             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2074         }
2075     }
2076
2077     # serial devices
2078     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2079         if (my $path = $conf->{"serial$i"}) {
2080             die "no such serial device\n" if ! -c $path;
2081             push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2082             push @$devices, '-device', "isa-serial,chardev=serial$i";
2083         }
2084     }
2085
2086     # parallel devices
2087     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2088         if (my $path = $conf->{"parallel$i"}) {
2089             die "no such parallel device\n" if ! -c $path;
2090             push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2091             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2092         }
2093     }
2094
2095     my $vmname = $conf->{name} || "vm$vmid";
2096
2097     push @$cmd, '-name', $vmname;
2098
2099     my $sockets = 1;
2100     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2101     $sockets = $conf->{sockets} if  $conf->{sockets};
2102
2103     my $cores = $conf->{cores} || 1;
2104
2105     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2106
2107     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2108
2109     push @$cmd, '-nodefaults';
2110
2111     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2112
2113     my $bootindex_hash = {};
2114     my $i = 1;
2115     foreach my $o (split(//, $bootorder)) {
2116         $bootindex_hash->{$o} = $i*100;
2117         $i++;
2118     }
2119
2120     push @$cmd, '-boot', "menu=on";
2121
2122     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2123
2124     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2125
2126     my $vga = $conf->{vga};
2127     if (!$vga) {
2128         if ($conf->{ostype} && ($conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2129             $vga = 'std';
2130         } else {
2131             $vga = 'cirrus';
2132         }
2133     }
2134
2135     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2136
2137     # time drift fix
2138     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2139     # ignore - no longer supported by newer kvm
2140     # push @$cmd, '-tdf' if $tdf;
2141
2142     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2143
2144     if (my $ost = $conf->{ostype}) {
2145         # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2146
2147         if ($ost =~ m/^w/) { # windows
2148             push @$cmd, '-localtime' if !defined($conf->{localtime});
2149
2150             # use rtc-td-hack when acpi is enabled
2151             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2152                 push @$cmd, '-rtc-td-hack';
2153             }
2154         }
2155
2156         if ($ost eq 'win7' || $ost eq 'w2k8' || $ost eq 'wvista') {
2157             push @$cmd, '-no-kvm-pit-reinjection';
2158             push @$cmd, '-no-hpet';
2159         }
2160
2161         # -tdf ?
2162         # -no-acpi
2163         # -no-kvm
2164         # -win2k-hack ?
2165     }
2166
2167     if ($nokvm) {
2168         push @$cmd, '-no-kvm';
2169     } else {
2170         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2171     }
2172
2173     push @$cmd, '-localtime' if $conf->{localtime};
2174
2175     push @$cmd, '-startdate', $conf->{startdate} if $conf->{startdate};
2176
2177     push @$cmd, '-S' if $conf->{freeze};
2178
2179     # set keyboard layout
2180     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2181     push @$cmd, '-k', $kb if $kb;
2182
2183     # enable sound
2184     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2185     #push @$cmd, '-soundhw', 'es1370';
2186     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2187     $pciaddr = print_pci_addr("balloon0", $bridges);
2188     push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2189
2190     if ($conf->{watchdog}) {
2191         my $wdopts = parse_watchdog($conf->{watchdog});
2192         $pciaddr = print_pci_addr("watchdog", $bridges);
2193         my $watchdog = $wdopts->{model} || 'i6300esb';
2194         push @$devices, '-device', "$watchdog$pciaddr";
2195         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2196     }
2197
2198     my $vollist = [];
2199     my $scsicontroller = {};
2200     my $ahcicontroller = {};
2201     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2202
2203     foreach_drive($conf, sub {
2204         my ($ds, $drive) = @_;
2205
2206         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2207             push @$vollist, $drive->{file};
2208         }
2209
2210         $use_virtio = 1 if $ds =~ m/^virtio/;
2211
2212         if (drive_is_cdrom ($drive)) {
2213             if ($bootindex_hash->{d}) {
2214                 $drive->{bootindex} = $bootindex_hash->{d};
2215                 $bootindex_hash->{d} += 1;
2216             }
2217         } else {
2218             if ($bootindex_hash->{c}) {
2219                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2220                 $bootindex_hash->{c} += 1;
2221             }
2222         }
2223
2224         if ($drive->{interface} eq 'scsi') {
2225
2226             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2227             my $controller = int($drive->{index} / $maxdev);
2228             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2229             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2230             $scsicontroller->{$controller}=1;
2231         }
2232
2233         if ($drive->{interface} eq 'sata') {
2234            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2235            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2236            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2237            $ahcicontroller->{$controller}=1;
2238         }
2239
2240         push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
2241         push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2242     });
2243
2244     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2245
2246     for (my $i = 0; $i < $MAX_NETS; $i++) {
2247          next if !$conf->{"net$i"};
2248          my $d = parse_net($conf->{"net$i"});
2249          next if !$d;
2250
2251          $use_virtio = 1 if $d->{model} eq 'virtio';
2252
2253          if ($bootindex_hash->{n}) {
2254             $d->{bootindex} = $bootindex_hash->{n};
2255             $bootindex_hash->{n} += 1;
2256          }
2257
2258          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2259          push @$devices, '-netdev', $netdevfull;
2260
2261          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2262          push @$devices, '-device', $netdevicefull;
2263     }
2264
2265     #bridges
2266     while (my ($k, $v) = each %$bridges) {
2267         $pciaddr = print_pci_addr("pci.$k");
2268         unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2269     }
2270
2271
2272     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2273     # when the VM uses virtio devices.
2274     if (!$use_virtio && $have_ovz) {
2275
2276         my $cpuunits = defined($conf->{cpuunits}) ?
2277             $conf->{cpuunits} : $defaults->{cpuunits};
2278
2279         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2280
2281         # fixme: cpulimit is currently ignored
2282         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2283     }
2284
2285     # add custom args
2286     if ($conf->{args}) {
2287         my $aa = PVE::Tools::split_args($conf->{args});
2288         push @$cmd, @$aa;
2289     }
2290
2291     push @$cmd, @$devices;
2292     return wantarray ? ($cmd, $vollist) : $cmd;
2293 }
2294
2295 sub vnc_socket {
2296     my ($vmid) = @_;
2297     return "${var_run_tmpdir}/$vmid.vnc";
2298 }
2299
2300 sub qmp_socket {
2301     my ($vmid) = @_;
2302     return "${var_run_tmpdir}/$vmid.qmp";
2303 }
2304
2305 sub pidfile_name {
2306     my ($vmid) = @_;
2307     return "${var_run_tmpdir}/$vmid.pid";
2308 }
2309
2310 sub next_migrate_port {
2311
2312     for (my $p = 60000; $p < 60010; $p++) {
2313
2314         my $sock = IO::Socket::INET->new(Listen => 5,
2315                                          LocalAddr => 'localhost',
2316                                          LocalPort => $p,
2317                                          ReuseAddr => 1,
2318                                          Proto     => 0);
2319
2320         if ($sock) {
2321             close($sock);
2322             return $p;
2323         }
2324     }
2325
2326     die "unable to find free migration port";
2327 }
2328
2329 sub vm_devices_list {
2330     my ($vmid) = @_;
2331
2332     my $res = vm_mon_cmd($vmid, 'query-pci');
2333
2334     my $devices = {};
2335     foreach my $pcibus (@$res) {
2336         foreach my $device (@{$pcibus->{devices}}) {
2337             next if !$device->{'qdev_id'};
2338             $devices->{$device->{'qdev_id'}} = $device;
2339         }
2340     }
2341
2342     return $devices;
2343 }
2344
2345 sub vm_deviceplug {
2346     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2347
2348     return 1 if !check_running($vmid) || !$conf->{hotplug};
2349
2350     my $devices_list = vm_devices_list($vmid);
2351     return 1 if defined($devices_list->{$deviceid});
2352
2353     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2354
2355     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2356         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2357         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2358         qemu_deviceadd($vmid, $devicefull);
2359         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2360            qemu_drivedel($vmid, $deviceid);
2361            return undef;
2362         }
2363     }
2364
2365     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2366         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2367         my $pciaddr = print_pci_addr($deviceid);
2368         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2369         qemu_deviceadd($vmid, $devicefull);
2370         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2371     }
2372
2373     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2374         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2375         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2376         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2377         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2378         if(!qemu_deviceadd($vmid, $devicefull)) {
2379            qemu_drivedel($vmid, $deviceid);
2380            return undef;
2381         }
2382     }
2383
2384     if ($deviceid =~ m/^(net)(\d+)$/) {
2385         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2386         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2387         qemu_deviceadd($vmid, $netdevicefull);
2388         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2389            qemu_netdevdel($vmid, $deviceid);
2390            return undef;
2391         }
2392     }
2393
2394     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2395         my $bridgeid = $2;
2396         my $pciaddr = print_pci_addr($deviceid);
2397         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2398         qemu_deviceadd($vmid, $devicefull);
2399         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2400     }
2401
2402     return 1;
2403 }
2404
2405 sub vm_deviceunplug {
2406     my ($vmid, $conf, $deviceid) = @_;
2407
2408     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2409
2410     my $devices_list = vm_devices_list($vmid);
2411     return 1 if !defined($devices_list->{$deviceid});
2412
2413     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2414
2415     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2416         return undef if !qemu_drivedel($vmid, $deviceid);
2417         qemu_devicedel($vmid, $deviceid);
2418         return undef if !qemu_devicedelverify($vmid, $deviceid);
2419     }
2420
2421     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2422         return undef if !qemu_devicedel($vmid, $deviceid);
2423     }
2424
2425     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2426         return undef if !qemu_devicedel($vmid, $deviceid);
2427         return undef if !qemu_drivedel($vmid, $deviceid);
2428     }
2429
2430     if ($deviceid =~ m/^(net)(\d+)$/) {
2431         return undef if !qemu_netdevdel($vmid, $deviceid);
2432         qemu_devicedel($vmid, $deviceid);
2433         return undef if !qemu_devicedelverify($vmid, $deviceid);
2434     }
2435
2436     return 1;
2437 }
2438
2439 sub qemu_deviceadd {
2440     my ($vmid, $devicefull) = @_;
2441
2442     my $ret = vm_human_monitor_command($vmid, "device_add $devicefull");
2443     $ret =~ s/^\s+//;
2444     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2445     return 1 if $ret eq "";
2446     syslog("err", "error on hotplug device : $ret");
2447     return undef;
2448
2449 }
2450
2451 sub qemu_devicedel {
2452     my($vmid, $deviceid) = @_;
2453
2454     my $ret = vm_human_monitor_command($vmid, "device_del $deviceid");
2455     $ret =~ s/^\s+//;
2456     return 1 if $ret eq "";
2457     syslog("err", "detaching device $deviceid failed : $ret");
2458     return undef;
2459 }
2460
2461 sub qemu_driveadd {
2462     my($storecfg, $vmid, $device) = @_;
2463
2464     my $drive = print_drive_full($storecfg, $vmid, $device);
2465     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2466     # If the command succeeds qemu prints: "OK"
2467     if ($ret !~ m/OK/s) {
2468         syslog("err", "adding drive failed: $ret");
2469         return undef;
2470     }
2471     return 1;
2472 }
2473
2474 sub qemu_drivedel {
2475     my($vmid, $deviceid) = @_;
2476
2477     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2478     $ret =~ s/^\s+//;
2479     if ($ret =~ m/Device \'.*?\' not found/s) {
2480         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2481     }
2482     elsif ($ret ne "") {
2483       syslog("err", "deleting drive $deviceid failed : $ret");
2484       return undef;
2485     }
2486     return 1;
2487 }
2488
2489 sub qemu_deviceaddverify {
2490     my ($vmid,$deviceid) = @_;
2491
2492     for (my $i = 0; $i <= 5; $i++) {
2493          my $devices_list = vm_devices_list($vmid);
2494          return 1 if defined($devices_list->{$deviceid});
2495          sleep 1;
2496     }
2497     syslog("err", "error on hotplug device $deviceid");
2498     return undef;
2499 }
2500
2501
2502 sub qemu_devicedelverify {
2503     my ($vmid,$deviceid) = @_;
2504
2505     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2506     for (my $i = 0; $i <= 5; $i++) {
2507          my $devices_list = vm_devices_list($vmid);
2508          return 1 if !defined($devices_list->{$deviceid});
2509          sleep 1;
2510     }
2511     syslog("err", "error on hot-unplugging device $deviceid");
2512     return undef;
2513 }
2514
2515 sub qemu_findorcreatescsihw {
2516     my ($storecfg, $conf, $vmid, $device) = @_;
2517
2518     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2519     my $controller = int($device->{index} / $maxdev);
2520     my $scsihwid="scsihw$controller";
2521     my $devices_list = vm_devices_list($vmid);
2522
2523     if(!defined($devices_list->{$scsihwid})) {
2524        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2525     }
2526     return 1;
2527 }
2528
2529 sub qemu_bridgeadd {
2530     my ($storecfg, $conf, $vmid, $device) = @_;
2531
2532     my $bridges = {};
2533     my $bridgeid = undef;
2534     print_pci_addr($device, $bridges);
2535
2536     while (my ($k, $v) = each %$bridges) {
2537         $bridgeid = $k;
2538     }
2539     return if $bridgeid < 1;
2540     my $bridge = "pci.$bridgeid";
2541     my $devices_list = vm_devices_list($vmid);
2542
2543     if(!defined($devices_list->{$bridge})) {
2544         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2545     }
2546     return 1;
2547 }
2548
2549 sub qemu_netdevadd {
2550     my ($vmid, $conf, $device, $deviceid) = @_;
2551
2552     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2553     my $ret = vm_human_monitor_command($vmid, "netdev_add $netdev");
2554     $ret =~ s/^\s+//;
2555
2556     #if the command succeeds, no output is sent. So any non-empty string shows an error
2557     return 1 if $ret eq "";
2558     syslog("err", "adding netdev failed: $ret");
2559     return undef;
2560 }
2561
2562 sub qemu_netdevdel {
2563     my ($vmid, $deviceid) = @_;
2564
2565     my $ret = vm_human_monitor_command($vmid, "netdev_del $deviceid");
2566     $ret =~ s/^\s+//;
2567     #if the command succeeds, no output is sent. So any non-empty string shows an error
2568     return 1 if $ret eq "";
2569     syslog("err", "deleting netdev failed: $ret");
2570     return undef;
2571 }
2572
2573 sub qemu_block_set_io_throttle {
2574     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2575
2576     return if !check_running($vmid) ;
2577
2578     $bps = 0 if !$bps;
2579     $bps_rd = 0 if !$bps_rd;
2580     $bps_wr = 0 if !$bps_wr;
2581     $iops = 0 if !$iops;
2582     $iops_rd = 0 if !$iops_rd;
2583     $iops_wr = 0 if !$iops_wr;
2584
2585     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));
2586
2587 }
2588
2589 # old code, only used to shutdown old VM after update
2590 sub __read_avail {
2591     my ($fh, $timeout) = @_;
2592
2593     my $sel = new IO::Select;
2594     $sel->add($fh);
2595
2596     my $res = '';
2597     my $buf;
2598
2599     my @ready;
2600     while (scalar (@ready = $sel->can_read($timeout))) {
2601         my $count;
2602         if ($count = $fh->sysread($buf, 8192)) {
2603             if ($buf =~ /^(.*)\(qemu\) $/s) {
2604                 $res .= $1;
2605                 last;
2606             } else {
2607                 $res .= $buf;
2608             }
2609         } else {
2610             if (!defined($count)) {
2611                 die "$!\n";
2612             }
2613             last;
2614         }
2615     }
2616
2617     die "monitor read timeout\n" if !scalar(@ready);
2618
2619     return $res;
2620 }
2621
2622 # old code, only used to shutdown old VM after update
2623 sub vm_monitor_command {
2624     my ($vmid, $cmdstr, $nocheck) = @_;
2625
2626     my $res;
2627
2628     eval {
2629         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2630
2631         my $sname = "${var_run_tmpdir}/$vmid.mon";
2632
2633         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2634             die "unable to connect to VM $vmid socket - $!\n";
2635
2636         my $timeout = 3;
2637
2638         # hack: migrate sometime blocks the monitor (when migrate_downtime
2639         # is set)
2640         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2641             $timeout = 60*60; # 1 hour
2642         }
2643
2644         # read banner;
2645         my $data = __read_avail($sock, $timeout);
2646
2647         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2648             die "got unexpected qemu monitor banner\n";
2649         }
2650
2651         my $sel = new IO::Select;
2652         $sel->add($sock);
2653
2654         if (!scalar(my @ready = $sel->can_write($timeout))) {
2655             die "monitor write error - timeout";
2656         }
2657
2658         my $fullcmd = "$cmdstr\r";
2659
2660         # syslog('info', "VM $vmid monitor command: $cmdstr");
2661
2662         my $b;
2663         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2664             die "monitor write error - $!";
2665         }
2666
2667         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2668
2669         $timeout = 20;
2670
2671         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2672             $timeout = 60*60; # 1 hour
2673         } elsif ($cmdstr =~ m/^(eject|change)/) {
2674             $timeout = 60; # note: cdrom mount command is slow
2675         }
2676         if ($res = __read_avail($sock, $timeout)) {
2677
2678             my @lines = split("\r?\n", $res);
2679
2680             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2681
2682             $res = join("\n", @lines);
2683             $res .= "\n";
2684         }
2685     };
2686
2687     my $err = $@;
2688
2689     if ($err) {
2690         syslog("err", "VM $vmid monitor command failed - $err");
2691         die $err;
2692     }
2693
2694     return $res;
2695 }
2696
2697 sub qemu_block_resize {
2698     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2699
2700     my $running = PVE::QemuServer::check_running($vmid);
2701
2702     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
2703
2704     return if !$running;
2705
2706     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
2707
2708 }
2709
2710 sub vm_start {
2711     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom) = @_;
2712
2713     lock_config($vmid, sub {
2714         my $conf = load_config($vmid, $migratedfrom);
2715
2716         check_lock($conf) if !$skiplock;
2717
2718         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
2719
2720         my $migrate_uri;
2721         my $migrate_port = 0;
2722
2723         if ($statefile) {
2724             if ($statefile eq 'tcp') {
2725                 $migrate_port = next_migrate_port();
2726                 $migrate_uri = "tcp:localhost:${migrate_port}";
2727             } else {
2728                 if (-f $statefile) {
2729                     $migrate_uri = "exec:cat $statefile";
2730                 } else {
2731                     warn "state file '$statefile' does not exist - doing normal startup\n";
2732                 }
2733             }
2734         }
2735
2736         my $defaults = load_defaults();
2737
2738         # set environment variable useful inside network script
2739         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
2740
2741         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2742         # host pci devices
2743         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2744           my $d = parse_hostpci($conf->{"hostpci$i"});
2745           next if !$d;
2746           my $info = pci_device_info("0000:$d->{pciid}");
2747           die "IOMMU not present\n" if !check_iommu_support();
2748           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2749           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2750           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2751         }
2752
2753         PVE::Storage::activate_volumes($storecfg, $vollist);
2754
2755         eval  { run_command($cmd, timeout => $migrate_uri ? undef : 30); };
2756         my $err = $@;
2757         die "start failed: $err" if $err;
2758
2759         if ($statefile) {
2760
2761             if ($statefile eq 'tcp') {
2762                 print "migration listens on port $migrate_port\n";
2763             } else {
2764                 unlink $statefile;
2765                 # fixme: send resume - is that necessary ?
2766                 eval { vm_mon_cmd($vmid, "cont"); };
2767             }
2768         }
2769
2770         # always set migrate speed (overwrite kvm default of 32m)
2771         # we set a very hight default of 8192m which is basically unlimited
2772         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2773         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2774         $migrate_speed = $migrate_speed * 1048576;
2775         eval {
2776             vm_mon_cmd($vmid, "migrate_set_speed", value => $migrate_speed);
2777         };
2778
2779         my $migrate_downtime = $defaults->{migrate_downtime};
2780         $migrate_downtime = $conf->{migrate_downtime} if defined($conf->{migrate_downtime});
2781         if (defined($migrate_downtime)) {
2782             eval { vm_mon_cmd($vmid, "migrate_set_downtime", value => $migrate_downtime); };
2783         }
2784
2785         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2786
2787     });
2788 }
2789
2790 sub vm_mon_cmd {
2791     my ($vmid, $execute, %params) = @_;
2792
2793     my $cmd = { execute => $execute, arguments => \%params };
2794     vm_qmp_command($vmid, $cmd);
2795 }
2796
2797 sub vm_mon_cmd_nocheck {
2798     my ($vmid, $execute, %params) = @_;
2799
2800     my $cmd = { execute => $execute, arguments => \%params };
2801     vm_qmp_command($vmid, $cmd, 1);
2802 }
2803
2804 sub vm_qmp_command {
2805     my ($vmid, $cmd, $nocheck) = @_;
2806
2807     my $res;
2808
2809     eval {
2810         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2811         my $sname = PVE::QemuServer::qmp_socket($vmid);
2812         if (-e $sname) {
2813             my $qmpclient = PVE::QMPClient->new();
2814
2815             $res = $qmpclient->cmd($vmid, $cmd);
2816         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
2817             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2818                 if scalar(%{$cmd->{arguments}});
2819             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
2820         } else {
2821             die "unable to open monitor socket\n";
2822         }
2823     };
2824     if (my $err = $@) {
2825         syslog("err", "VM $vmid qmp command failed - $err");
2826         die $err;
2827     }
2828
2829     return $res;
2830 }
2831
2832 sub vm_human_monitor_command {
2833     my ($vmid, $cmdline) = @_;
2834
2835     my $res;
2836
2837     my $cmd = {
2838         execute => 'human-monitor-command',
2839         arguments => { 'command-line' => $cmdline},
2840     };
2841
2842     return vm_qmp_command($vmid, $cmd);
2843 }
2844
2845 sub vm_commandline {
2846     my ($storecfg, $vmid) = @_;
2847
2848     my $conf = load_config($vmid);
2849
2850     my $defaults = load_defaults();
2851
2852     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
2853
2854     return join(' ', @$cmd);
2855 }
2856
2857 sub vm_reset {
2858     my ($vmid, $skiplock) = @_;
2859
2860     lock_config($vmid, sub {
2861
2862         my $conf = load_config($vmid);
2863
2864         check_lock($conf) if !$skiplock;
2865
2866         vm_mon_cmd($vmid, "system_reset");
2867     });
2868 }
2869
2870 sub get_vm_volumes {
2871     my ($conf) = @_;
2872
2873     my $vollist = [];
2874     foreach_drive($conf, sub {
2875         my ($ds, $drive) = @_;
2876
2877         my ($sid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
2878         return if !$sid;
2879
2880         my $volid = $drive->{file};
2881         return if !$volid || $volid =~ m|^/|;
2882
2883         push @$vollist, $volid;
2884     });
2885
2886     return $vollist;
2887 }
2888
2889 sub vm_stop_cleanup {
2890     my ($storecfg, $vmid, $conf, $keepActive) = @_;
2891
2892     eval {
2893         fairsched_rmnod($vmid); # try to destroy group
2894
2895         if (!$keepActive) {
2896             my $vollist = get_vm_volumes($conf);
2897             PVE::Storage::deactivate_volumes($storecfg, $vollist);
2898         }
2899
2900         foreach my $ext (qw(mon pid vnc)) {
2901             unlink "/var/run/qemu-server/${vmid}.$ext";
2902         }
2903     };
2904     warn $@ if $@; # avoid errors - just warn
2905 }
2906
2907 # Note: use $nockeck to skip tests if VM configuration file exists.
2908 # We need that when migration VMs to other nodes (files already moved)
2909 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
2910 sub vm_stop {
2911     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
2912
2913     $force = 1 if !defined($force) && !$shutdown;
2914
2915     lock_config($vmid, sub {
2916
2917         my $pid = check_running($vmid, $nocheck);
2918         return if !$pid;
2919
2920         my $conf;
2921         if (!$nocheck) {
2922             $conf = load_config($vmid);
2923             check_lock($conf) if !$skiplock;
2924             if (!defined($timeout) && $shutdown && $conf->{startup}) {
2925                 my $opts = parse_startup($conf->{startup});
2926                 $timeout = $opts->{down} if $opts->{down};
2927             }
2928         }
2929
2930         $timeout = 60 if !defined($timeout);
2931
2932         eval {
2933             if ($shutdown) {
2934                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
2935
2936             } else {
2937                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
2938             }
2939         };
2940         my $err = $@;
2941
2942         if (!$err) {
2943             my $count = 0;
2944             while (($count < $timeout) && check_running($vmid, $nocheck)) {
2945                 $count++;
2946                 sleep 1;
2947             }
2948
2949             if ($count >= $timeout) {
2950                 if ($force) {
2951                     warn "VM still running - terminating now with SIGTERM\n";
2952                     kill 15, $pid;
2953                 } else {
2954                     die "VM quit/powerdown failed - got timeout\n";
2955                 }
2956             } else {
2957                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2958                 return;
2959             }
2960         } else {
2961             if ($force) {
2962                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
2963                 kill 15, $pid;
2964             } else {
2965                 die "VM quit/powerdown failed\n";
2966             }
2967         }
2968
2969         # wait again
2970         $timeout = 10;
2971
2972         my $count = 0;
2973         while (($count < $timeout) && check_running($vmid, $nocheck)) {
2974             $count++;
2975             sleep 1;
2976         }
2977
2978         if ($count >= $timeout) {
2979             warn "VM still running - terminating now with SIGKILL\n";
2980             kill 9, $pid;
2981             sleep 1;
2982         }
2983
2984         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
2985    });
2986 }
2987
2988 sub vm_suspend {
2989     my ($vmid, $skiplock) = @_;
2990
2991     lock_config($vmid, sub {
2992
2993         my $conf = load_config($vmid);
2994
2995         check_lock($conf) if !$skiplock;
2996
2997         vm_mon_cmd($vmid, "stop");
2998     });
2999 }
3000
3001 sub vm_resume {
3002     my ($vmid, $skiplock) = @_;
3003
3004     lock_config($vmid, sub {
3005
3006         my $conf = load_config($vmid);
3007
3008         check_lock($conf) if !$skiplock;
3009
3010         vm_mon_cmd($vmid, "cont");
3011     });
3012 }
3013
3014 sub vm_sendkey {
3015     my ($vmid, $skiplock, $key) = @_;
3016
3017     lock_config($vmid, sub {
3018
3019         my $conf = load_config($vmid);
3020
3021         # there is no qmp command, so we use the human monitor command
3022         vm_human_monitor_command($vmid, "sendkey $key");
3023     });
3024 }
3025
3026 sub vm_destroy {
3027     my ($storecfg, $vmid, $skiplock) = @_;
3028
3029     lock_config($vmid, sub {
3030
3031         my $conf = load_config($vmid);
3032
3033         check_lock($conf) if !$skiplock;
3034
3035         if (!check_running($vmid)) {
3036             fairsched_rmnod($vmid); # try to destroy group
3037             destroy_vm($storecfg, $vmid);
3038         } else {
3039             die "VM $vmid is running - destroy failed\n";
3040         }
3041     });
3042 }
3043
3044 # pci helpers
3045
3046 sub file_write {
3047     my ($filename, $buf) = @_;
3048
3049     my $fh = IO::File->new($filename, "w");
3050     return undef if !$fh;
3051
3052     my $res = print $fh $buf;
3053
3054     $fh->close();
3055
3056     return $res;
3057 }
3058
3059 sub pci_device_info {
3060     my ($name) = @_;
3061
3062     my $res;
3063
3064     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3065     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3066
3067     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3068     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3069
3070     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3071     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3072
3073     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3074     return undef if !defined($product) || $product !~ s/^0x//;
3075
3076     $res = {
3077         name => $name,
3078         vendor => $vendor,
3079         product => $product,
3080         domain => $domain,
3081         bus => $bus,
3082         slot => $slot,
3083         func => $func,
3084         irq => $irq,
3085         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3086     };
3087
3088     return $res;
3089 }
3090
3091 sub pci_dev_reset {
3092     my ($dev) = @_;
3093
3094     my $name = $dev->{name};
3095
3096     my $fn = "$pcisysfs/devices/$name/reset";
3097
3098     return file_write($fn, "1");
3099 }
3100
3101 sub pci_dev_bind_to_stub {
3102     my ($dev) = @_;
3103
3104     my $name = $dev->{name};
3105
3106     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3107     return 1 if -d $testdir;
3108
3109     my $data = "$dev->{vendor} $dev->{product}";
3110     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3111
3112     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3113     if (!file_write($fn, $name)) {
3114         return undef if -f $fn;
3115     }
3116
3117     $fn = "$pcisysfs/drivers/pci-stub/bind";
3118     if (! -d $testdir) {
3119         return undef if !file_write($fn, $name);
3120     }
3121
3122     return -d $testdir;
3123 }
3124
3125 sub print_pci_addr {
3126     my ($id, $bridges) = @_;
3127
3128     my $res = '';
3129     my $devices = {
3130         #addr1 : ide,parallel,serial (motherboard)
3131         #addr2 : first videocard
3132         balloon0 => { bus => 0, addr => 3 },
3133         watchdog => { bus => 0, addr => 4 },
3134         scsihw0 => { bus => 0, addr => 5 },
3135         scsihw1 => { bus => 0, addr => 6 },
3136         ahci0 => { bus => 0, addr => 7 },
3137         virtio0 => { bus => 0, addr => 10 },
3138         virtio1 => { bus => 0, addr => 11 },
3139         virtio2 => { bus => 0, addr => 12 },
3140         virtio3 => { bus => 0, addr => 13 },
3141         virtio4 => { bus => 0, addr => 14 },
3142         virtio5 => { bus => 0, addr => 15 },
3143         hostpci0 => { bus => 0, addr => 16 },
3144         hostpci1 => { bus => 0, addr => 17 },
3145         net0 => { bus => 0, addr => 18 },
3146         net1 => { bus => 0, addr => 19 },
3147         net2 => { bus => 0, addr => 20 },
3148         net3 => { bus => 0, addr => 21 },
3149         net4 => { bus => 0, addr => 22 },
3150         net5 => { bus => 0, addr => 23 },
3151         #addr29 : usb-host (pve-usb.cfg)
3152         'pci.1' => { bus => 0, addr => 30 },
3153         'pci.2' => { bus => 0, addr => 31 },
3154         'net6' => { bus => 1, addr => 1 },
3155         'net7' => { bus => 1, addr => 2 },
3156         'net8' => { bus => 1, addr => 3 },
3157         'net9' => { bus => 1, addr => 4 },
3158         'net10' => { bus => 1, addr => 5 },
3159         'net11' => { bus => 1, addr => 6 },
3160         'net12' => { bus => 1, addr => 7 },
3161         'net13' => { bus => 1, addr => 8 },
3162         'net14' => { bus => 1, addr => 9 },
3163         'net15' => { bus => 1, addr => 10 },
3164         'net16' => { bus => 1, addr => 11 },
3165         'net17' => { bus => 1, addr => 12 },
3166         'net18' => { bus => 1, addr => 13 },
3167         'net19' => { bus => 1, addr => 14 },
3168         'net20' => { bus => 1, addr => 15 },
3169         'net21' => { bus => 1, addr => 16 },
3170         'net22' => { bus => 1, addr => 17 },
3171         'net23' => { bus => 1, addr => 18 },
3172         'net24' => { bus => 1, addr => 19 },
3173         'net25' => { bus => 1, addr => 20 },
3174         'net26' => { bus => 1, addr => 21 },
3175         'net27' => { bus => 1, addr => 22 },
3176         'net28' => { bus => 1, addr => 23 },
3177         'net29' => { bus => 1, addr => 24 },
3178         'net30' => { bus => 1, addr => 25 },
3179         'net31' => { bus => 1, addr => 26 },
3180         'virtio6' => { bus => 2, addr => 1 },
3181         'virtio7' => { bus => 2, addr => 2 },
3182         'virtio8' => { bus => 2, addr => 3 },
3183         'virtio9' => { bus => 2, addr => 4 },
3184         'virtio10' => { bus => 2, addr => 5 },
3185         'virtio11' => { bus => 2, addr => 6 },
3186         'virtio12' => { bus => 2, addr => 7 },
3187         'virtio13' => { bus => 2, addr => 8 },
3188         'virtio14' => { bus => 2, addr => 9 },
3189         'virtio15' => { bus => 2, addr => 10 },
3190     };
3191
3192     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3193            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3194            my $bus = $devices->{$id}->{bus};
3195            $res = ",bus=pci.$bus,addr=$addr";
3196            $bridges->{$bus} = 1 if $bridges;
3197     }
3198     return $res;
3199
3200 }
3201
3202 sub vm_balloonset {
3203     my ($vmid, $value) = @_;
3204
3205     vm_mon_cmd($vmid, "balloon", value => $value);
3206 }
3207
3208 # vzdump restore implementaion
3209
3210 sub archive_read_firstfile {
3211     my $archive = shift;
3212
3213     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3214
3215     # try to detect archive type first
3216     my $pid = open (TMP, "tar tf '$archive'|") ||
3217         die "unable to open file '$archive'\n";
3218     my $firstfile = <TMP>;
3219     kill 15, $pid;
3220     close TMP;
3221
3222     die "ERROR: archive contaions no data\n" if !$firstfile;
3223     chomp $firstfile;
3224
3225     return $firstfile;
3226 }
3227
3228 sub restore_cleanup {
3229     my $statfile = shift;
3230
3231     print STDERR "starting cleanup\n";
3232
3233     if (my $fd = IO::File->new($statfile, "r")) {
3234         while (defined(my $line = <$fd>)) {
3235             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3236                 my $volid = $2;
3237                 eval {
3238                     if ($volid =~ m|^/|) {
3239                         unlink $volid || die 'unlink failed\n';
3240                     } else {
3241                         my $cfg = cfs_read_file('storage.cfg');
3242                         PVE::Storage::vdisk_free($cfg, $volid);
3243                     }
3244                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3245                 };
3246                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3247             } else {
3248                 print STDERR "unable to parse line in statfile - $line";
3249             }
3250         }
3251         $fd->close();
3252     }
3253 }
3254
3255 sub restore_archive {
3256     my ($archive, $vmid, $user, $opts) = @_;
3257
3258     if ($archive ne '-') {
3259         my $firstfile = archive_read_firstfile($archive);
3260         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3261             if $firstfile ne 'qemu-server.conf';
3262     }
3263
3264     my $tocmd = "/usr/lib/qemu-server/qmextract";
3265
3266     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3267     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3268     $tocmd .= ' --prealloc' if $opts->{prealloc};
3269     $tocmd .= ' --info' if $opts->{info};
3270
3271     # tar option "xf" does not autodetect compression when read from STDIN,
3272     # so we pipe to zcat
3273     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3274         PVE::Tools::shellquote("--to-command=$tocmd");
3275
3276     my $tmpdir = "/var/tmp/vzdumptmp$$";
3277     mkpath $tmpdir;
3278
3279     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3280     local $ENV{VZDUMP_VMID} = $vmid;
3281     local $ENV{VZDUMP_USER} = $user;
3282
3283     my $conffile = PVE::QemuServer::config_file($vmid);
3284     my $tmpfn = "$conffile.$$.tmp";
3285
3286     # disable interrupts (always do cleanups)
3287     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3288         print STDERR "got interrupt - ignored\n";
3289     };
3290
3291     eval {
3292         # enable interrupts
3293         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3294             die "interrupted by signal\n";
3295         };
3296
3297         if ($archive eq '-') {
3298             print "extracting archive from STDIN\n";
3299             run_command($cmd, input => "<&STDIN");
3300         } else {
3301             print "extracting archive '$archive'\n";
3302             run_command($cmd);
3303         }
3304
3305         return if $opts->{info};
3306
3307         # read new mapping
3308         my $map = {};
3309         my $statfile = "$tmpdir/qmrestore.stat";
3310         if (my $fd = IO::File->new($statfile, "r")) {
3311             while (defined (my $line = <$fd>)) {
3312                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3313                     $map->{$1} = $2 if $1;
3314                 } else {
3315                     print STDERR "unable to parse line in statfile - $line\n";
3316                 }
3317             }
3318             $fd->close();
3319         }
3320
3321         my $confsrc = "$tmpdir/qemu-server.conf";
3322
3323         my $srcfd = new IO::File($confsrc, "r") ||
3324             die "unable to open file '$confsrc'\n";
3325
3326         my $outfd = new IO::File ($tmpfn, "w") ||
3327             die "unable to write config for VM $vmid\n";
3328
3329         my $netcount = 0;
3330
3331         while (defined (my $line = <$srcfd>)) {
3332             next if $line =~ m/^\#vzdump\#/;
3333             next if $line =~ m/^lock:/;
3334             next if $line =~ m/^unused\d+:/;
3335
3336             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3337                 # try to convert old 1.X settings
3338                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3339                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3340                     my ($model, $macaddr) = split(/\=/, $devconfig);
3341                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3342                     my $net = {
3343                         model => $model,
3344                         bridge => "vmbr$ind",
3345                         macaddr => $macaddr,
3346                     };
3347                     my $netstr = print_net($net);
3348                     print $outfd "net${netcount}: $netstr\n";
3349                     $netcount++;
3350                 }
3351             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3352                 my ($id, $netstr) = ($1, $2);
3353                 my $net = parse_net($netstr);
3354                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3355                 $netstr = print_net($net);
3356                 print $outfd "$id: $netstr\n";
3357             } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3358                 my $virtdev = $1;
3359                 my $value = $2;
3360                 if ($line =~ m/backup=no/) {
3361                     print $outfd "#$line";
3362                 } elsif ($virtdev && $map->{$virtdev}) {
3363                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3364                     $di->{file} = $map->{$virtdev};
3365                     $value = PVE::QemuServer::print_drive($vmid, $di);
3366                     print $outfd "$virtdev: $value\n";
3367                 } else {
3368                     print $outfd $line;
3369                 }
3370             } else {
3371                 print $outfd $line;
3372             }
3373         }
3374
3375         $srcfd->close();
3376         $outfd->close();
3377     };
3378     my $err = $@;
3379
3380     if ($err) {
3381
3382         unlink $tmpfn;
3383
3384         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3385
3386         die $err;
3387     }
3388
3389     rmtree $tmpdir;
3390
3391     rename $tmpfn, $conffile ||
3392         die "unable to commit configuration file '$conffile'\n";
3393 };
3394
3395 1;