PVE/QemuServer.pm

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