PVE/QemuServer.pm

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