]>
git.proxmox.com Git - qemu-server.git/blob - PVE/QemuServer.pm
1 package PVE
:: QemuServer
;
20 use Storable
qw(dclone) ;
21 use PVE
:: Exception
qw(raise raise_param_exc) ;
23 use PVE
:: Tools
qw(run_command lock_file file_read_firstline) ;
24 use PVE
:: Cluster
qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file) ;
27 use Time
:: HiRes
qw(gettimeofday) ;
29 my $cpuinfo = PVE
:: ProcFSTools
:: read_cpuinfo
();
31 # Note about locking: we use flock on the config file protect
32 # against concurent actions.
33 # Aditionaly, we have a 'lock' setting in the config file. This
34 # can be set to 'migrate' or 'backup'. Most actions are not
35 # allowed when such lock is set. But you can ignore this kind of
36 # lock with the --skiplock flag.
38 cfs_register_file
( '/qemu-server/' , \
& parse_vm_config
);
40 PVE
:: JSONSchema
:: register_standard_option
( 'skiplock' , {
41 description
=> "Ignore locks - only root is allowed to use this option." ,
46 PVE
:: JSONSchema
:: register_standard_option
( 'pve-qm-stateuri' , {
47 description
=> "Some command save/restore state from this location." ,
53 #no warnings 'redefine';
55 unless ( defined (& _VZSYSCALLS_H_
)) {
56 eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined (& _VZSYSCALLS_H_
);
57 require 'sys/syscall.ph' ;
58 if ( defined (& __x86_64__
)) {
59 eval 'sub __NR_fairsched_vcpus () {499;}' unless defined (& __NR_fairsched_vcpus
);
60 eval 'sub __NR_fairsched_mknod () {504;}' unless defined (& __NR_fairsched_mknod
);
61 eval 'sub __NR_fairsched_rmnod () {505;}' unless defined (& __NR_fairsched_rmnod
);
62 eval 'sub __NR_fairsched_chwt () {506;}' unless defined (& __NR_fairsched_chwt
);
63 eval 'sub __NR_fairsched_mvpr () {507;}' unless defined (& __NR_fairsched_mvpr
);
64 eval 'sub __NR_fairsched_rate () {508;}' unless defined (& __NR_fairsched_rate
);
65 eval 'sub __NR_setluid () {501;}' unless defined (& __NR_setluid
);
66 eval 'sub __NR_setublimit () {502;}' unless defined (& __NR_setublimit
);
68 elsif ( defined ( & __i386__
) ) {
69 eval 'sub __NR_fairsched_mknod () {500;}' unless defined (& __NR_fairsched_mknod
);
70 eval 'sub __NR_fairsched_rmnod () {501;}' unless defined (& __NR_fairsched_rmnod
);
71 eval 'sub __NR_fairsched_chwt () {502;}' unless defined (& __NR_fairsched_chwt
);
72 eval 'sub __NR_fairsched_mvpr () {503;}' unless defined (& __NR_fairsched_mvpr
);
73 eval 'sub __NR_fairsched_rate () {504;}' unless defined (& __NR_fairsched_rate
);
74 eval 'sub __NR_fairsched_vcpus () {505;}' unless defined (& __NR_fairsched_vcpus
);
75 eval 'sub __NR_setluid () {511;}' unless defined (& __NR_setluid
);
76 eval 'sub __NR_setublimit () {512;}' unless defined (& __NR_setublimit
);
78 die ( "no fairsched syscall for this arch" );
80 require 'asm/ioctl.ph' ;
81 eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined (& KVM_GET_API_VERSION
);
85 my ( $parent, $weight, $desired ) = @_ ;
87 return syscall (& __NR_fairsched_mknod
, int ( $parent ), int ( $weight ), int ( $desired ));
93 return syscall (& __NR_fairsched_rmnod
, int ( $id ));
97 my ( $pid, $newid ) = @_ ;
99 return syscall (& __NR_fairsched_mvpr
, int ( $pid ), int ( $newid ));
102 sub fairsched_vcpus
{
103 my ( $id, $vcpus ) = @_ ;
105 return syscall (& __NR_fairsched_vcpus
, int ( $id ), int ( $vcpus ));
109 my ( $id, $op, $rate ) = @_ ;
111 return syscall (& __NR_fairsched_rate
, int ( $id ), int ( $op ), int ( $rate ));
114 use constant FAIRSCHED_SET_RATE
=> 0 ;
115 use constant FAIRSCHED_DROP_RATE
=> 1 ;
116 use constant FAIRSCHED_GET_RATE
=> 2 ;
118 sub fairsched_cpulimit
{
119 my ( $id, $limit ) = @_ ;
121 my $cpulim1024 = int ( $limit * 1024 / 100 );
122 my $op = $cpulim1024 ? FAIRSCHED_SET_RATE
: FAIRSCHED_DROP_RATE
;
124 return fairsched_rate
( $id, $op, $cpulim1024 );
127 my $nodename = PVE
:: INotify
:: nodename
();
129 mkdir "/etc/pve/nodes/ $nodename " ;
130 my $confdir = "/etc/pve/nodes/ $nodename/qemu -server" ;
133 my $var_run_tmpdir = "/var/run/qemu-server" ;
134 mkdir $var_run_tmpdir ;
136 my $lock_dir = "/var/lock/qemu-server" ;
139 my $pcisysfs = "/sys/bus/pci" ;
141 my $keymaphash = PVE
:: Tools
:: kvmkeymaps
();
147 description
=> "Specifies whether a VM will be started during system bootup." ,
153 description
=> "Automatic restart after crash (currently ignored)." ,
159 description
=> "Activate hotplug for disk and network device" ,
165 description
=> "Allow reboot. If set to '0' the VM exit on reboot." ,
171 description
=> "Lock/unlock the VM." ,
172 enum
=> [ qw(migrate backup) ],
177 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\n NOTE: This option is currently ignored." ,
184 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\n NOTE: You can disable fair-scheduler configuration by setting this to 0." ,
192 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device." ,
199 description
=> "Amount of target RAM for the VM in MB." ,
205 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file." ,
206 enum
=> [ keys %$keymaphash ],
212 description
=> "Set a name for the VM. Only used on the configuration web interface." ,
217 description
=> "Description for the VM. Only used on the configuration web interface." ,
222 enum
=> [ qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26) ],
223 description
=> <<EODESC,
224 Used to enable special optimization/features for specific
227 other => unspecified OS
228 wxp => Microsoft Windows XP
229 w2k => Microsoft Windows 2000
230 w2k3 => Microsoft Windows 2003
231 w2k8 => Microsoft Windows 2008
232 wvista => Microsoft Windows Vista
233 win7 => Microsoft Windows 7
234 l24 => Linux 2.4 Kernel
235 l26 => Linux 2.6/3.X Kernel
237 other|l24|l26 ... no special behaviour
238 wxp|w2k|w2k3|w2k8|wvista|win7 ... use --localtime switch
244 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n)." ,
245 pattern
=> '[acdn]{1,4}' ,
250 type
=> 'string' , format
=> 'pve-qm-bootdisk' ,
251 description
=> "Enable booting from specified disk." ,
252 pattern
=> '(ide|scsi|virtio)\d+' ,
257 description
=> "The number of CPUs. Please use option -sockets instead." ,
264 description
=> "The number of CPU sockets." ,
271 description
=> "The number of cores per socket." ,
278 description
=> "Enable/disable ACPI." ,
284 description
=> "Enable/disable KVM hardware virtualization." ,
290 description
=> "Enable/disable time drift fix." ,
296 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS." ,
301 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution)." ,
306 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" ,
307 enum
=> [ qw(std cirrus vmware) ],
311 type
=> 'string' , format
=> 'pve-qm-watchdog' ,
312 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]' ,
313 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)" ,
318 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)" ,
319 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'." ,
320 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)' ,
326 description
=> <<EODESCR,
327 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
329 args: -no-reboot -no-hpet
336 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." ,
341 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit." ,
345 migrate_downtime
=> {
348 description
=> "Set maximum tolerated downtime (in seconds) for migrations." ,
354 type
=> 'string' , format
=> 'pve-qm-drive' ,
355 typetext
=> 'volume' ,
356 description
=> "This is an alias for option -ide2" ,
360 description
=> "Emulated CPU type." ,
362 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom host) ],
367 # what about other qemu settings ?
369 #machine => 'string',
382 ##soundhw => 'string',
384 while ( my ( $k, $v ) = each %$confdesc ) {
385 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm- $k " , $v );
388 my $MAX_IDE_DISKS = 4 ;
389 my $MAX_SCSI_DISKS = 14 ;
390 my $MAX_VIRTIO_DISKS = 6 ;
391 my $MAX_USB_DEVICES = 5 ;
393 my $MAX_UNUSED_DISKS = 8 ;
394 my $MAX_HOSTPCI_DEVICES = 2 ;
395 my $MAX_SERIAL_PORTS = 4 ;
396 my $MAX_PARALLEL_PORTS = 3 ;
398 my $nic_model_list = [ 'rtl8139' , 'ne2k_pci' , 'e1000' , 'pcnet' , 'virtio' ,
399 'ne2k_isa' , 'i82551' , 'i82557b' , 'i82559er' ];
400 my $nic_model_list_txt = join ( ' ' , sort @$nic_model_list );
405 type
=> 'string' , format
=> 'pve-qm-net' ,
406 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>]" ,
407 description
=> <<EODESCR,
408 Specify network devices.
410 MODEL is one of: $nic_model_list_txt
412 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
413 automatically generated if not specified.
415 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
417 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'.
419 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
425 The DHCP server assign addresses to the guest starting from 10.0.2.15.
429 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-net" , $netdesc );
431 for ( my $i = 0 ; $i < $MAX_NETS ; $i++ ) {
432 $confdesc ->{ "net $i " } = $netdesc ;
439 type
=> 'string' , format
=> 'pve-qm-drive' ,
440 typetext
=> '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]' ,
441 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to 3)." ,
443 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-ide" , $idedesc );
447 type
=> 'string' , format
=> 'pve-qm-drive' ,
448 typetext
=> '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]' ,
449 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to 13)." ,
451 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-scsi" , $scsidesc );
455 type
=> 'string' , format
=> 'pve-qm-drive' ,
456 typetext
=> '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe] [,format=f] [,backup=yes|no] [,aio=native|threads]' ,
457 description
=> "Use volume as VIRTIO hard disk (n is 0 to 5)." ,
459 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-virtio" , $virtiodesc );
463 type
=> 'string' , format
=> 'pve-qm-usb-device' ,
464 typetext
=> 'host=HOSTUSBDEVICE' ,
465 description
=> <<EODESCR,
466 Configure an USB device (n is 0 to 4). This can be used to
467 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
469 'bus-port(.port)*' (decimal numbers) or
470 'vendor_id:product_id' (hexadeciaml numbers)
472 You can use the 'lsusb -t' command to list existing usb devices.
474 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
478 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-usb" , $usbdesc );
482 type
=> 'string' , format
=> 'pve-qm-hostpci' ,
483 typetext
=> "HOSTPCIDEVICE" ,
484 description
=> <<EODESCR,
485 Map host pci devices. HOSTPCIDEVICE syntax is:
487 'bus:dev.func' (hexadecimal numbers)
489 You can us the 'lspci' command to list existing pci devices.
491 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
493 Experimental: user reported problems with this option.
496 PVE
:: JSONSchema
:: register_standard_option
( "pve-qm-hostpci" , $hostpcidesc );
501 pattern
=> '/dev/ttyS\d+' ,
502 description
=> <<EODESCR,
503 Map host serial devices (n is 0 to 3).
505 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
507 Experimental: user reported problems with this option.
514 pattern
=> '/dev/parport\d+' ,
515 description
=> <<EODESCR,
516 Map host parallel devices (n is 0 to 2).
518 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
520 Experimental: user reported problems with this option.
524 for ( my $i = 0 ; $i < $MAX_PARALLEL_PORTS ; $i++ ) {
525 $confdesc ->{ "parallel $i " } = $paralleldesc ;
528 for ( my $i = 0 ; $i < $MAX_SERIAL_PORTS ; $i++ ) {
529 $confdesc ->{ "serial $i " } = $serialdesc ;
532 for ( my $i = 0 ; $i < $MAX_HOSTPCI_DEVICES ; $i++ ) {
533 $confdesc ->{ "hostpci $i " } = $hostpcidesc ;
536 for ( my $i = 0 ; $i < $MAX_IDE_DISKS ; $i++ ) {
537 $drivename_hash ->{ "ide $i " } = 1 ;
538 $confdesc ->{ "ide $i " } = $idedesc ;
541 for ( my $i = 0 ; $i < $MAX_SCSI_DISKS ; $i++ ) {
542 $drivename_hash ->{ "scsi $i " } = 1 ;
543 $confdesc ->{ "scsi $i " } = $scsidesc ;
546 for ( my $i = 0 ; $i < $MAX_VIRTIO_DISKS ; $i++ ) {
547 $drivename_hash ->{ "virtio $i " } = 1 ;
548 $confdesc ->{ "virtio $i " } = $virtiodesc ;
551 for ( my $i = 0 ; $i < $MAX_USB_DEVICES ; $i++ ) {
552 $confdesc ->{ "usb $i " } = $usbdesc ;
557 type
=> 'string' , format
=> 'pve-volume-id' ,
558 description
=> "Reference to unused volumes." ,
561 for ( my $i = 0 ; $i < $MAX_UNUSED_DISKS ; $i++ ) {
562 $confdesc ->{ "unused $i " } = $unuseddesc ;
565 my $kvm_api_version = 0 ;
569 return $kvm_api_version if $kvm_api_version ;
571 my $fh = IO
:: File-
> new ( "</dev/kvm" ) ||
574 if ( my $v = $fh -> ioctl ( KVM_GET_API_VERSION
(), 0 )) {
575 $kvm_api_version = $v ;
580 return $kvm_api_version ;
583 my $kvm_user_version ;
585 sub kvm_user_version
{
587 return $kvm_user_version if $kvm_user_version ;
589 $kvm_user_version = 'unknown' ;
591 my $tmp = `kvm -help 2>/dev/null` ;
593 if ( $tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?) / ) {
594 $kvm_user_version = $2 ;
597 return $kvm_user_version ;
601 my $kernel_has_vhost_net = - c
'/dev/vhost-net' ;
604 # order is important - used to autoselect boot disk
605 return (( map { "ide $_ " } ( 0 .. ( $MAX_IDE_DISKS - 1 ))),
606 ( map { "scsi $_ " } ( 0 .. ( $MAX_SCSI_DISKS - 1 ))),
607 ( map { "virtio $_ " } ( 0 .. ( $MAX_VIRTIO_DISKS - 1 ))));
610 sub valid_drivename
{
613 return defined ( $drivename_hash ->{ $dev });
618 return defined ( $confdesc ->{ $key });
622 return $nic_model_list ;
625 sub os_list_description
{
630 w2k
=> 'Windows 2000' ,
631 w2k3
=>, 'Windows 2003' ,
632 w2k8
=> 'Windows 2008' ,
633 wvista
=> 'Windows Vista' ,
640 sub disk_devive_info
{
643 die "unknown disk device format ' $dev '" if $dev !~ m/^(ide|scsi|virtio)(\d+)$/ ;
651 } elsif ( $bus eq 'scsi' ) {
655 my $controller = int ( $index / $maxdev );
656 my $unit = $index % $maxdev ;
659 return { bus
=> $bus, desc
=> uc ( $bus ) . " $controller : $unit " ,
660 controller
=> $controller, unit
=> $unit, index => $index };
664 sub qemu_drive_name
{
665 my ( $dev, $media ) = @_ ;
667 my $info = disk_devive_info
( $dev );
670 if (( $info ->{ bus
} eq 'ide' ) || ( $info ->{ bus
} eq 'scsi' )) {
671 $mediastr = ( $media eq 'cdrom' ) ?
"-cd" : "-hd" ;
672 return sprintf ( " %s%i%s%i " , $info ->{ bus
}, $info ->{ controller
},
673 $mediastr, $info ->{ unit
});
675 return sprintf ( " %s%i " , $info ->{ bus
}, $info ->{ index });
683 return $cdrom_path if $cdrom_path ;
685 return $cdrom_path = "/dev/cdrom" if - l
"/dev/cdrom" ;
686 return $cdrom_path = "/dev/cdrom1" if - l
"/dev/cdrom1" ;
687 return $cdrom_path = "/dev/cdrom2" if - l
"/dev/cdrom2" ;
691 my ( $storecfg, $vmid, $cdrom ) = @_ ;
693 if ( $cdrom eq 'cdrom' ) {
694 return get_cdrom_path
();
695 } elsif ( $cdrom eq 'none' ) {
697 } elsif ( $cdrom =~ m
|^/|) {
700 return PVE
:: Storage
:: path
( $storecfg, $cdrom );
704 # try to convert old style file names to volume IDs
705 sub filename_to_volume_id
{
706 my ( $vmid, $file, $media ) = @_ ;
708 if (!( $file eq 'none' || $file eq 'cdrom' ||
709 $file =~ m
|^ /dev/ .+| || $file =~ m/^([^:]+):(.+)$/ )) {
711 return undef if $file =~ m
|/|;
713 if ( $media && $media eq 'cdrom' ) {
714 $file = "local:iso/ $file " ;
716 $file = "local: $vmid/$file " ;
723 sub verify_media_type
{
724 my ( $opt, $vtype, $media ) = @_ ;
729 if ( $media eq 'disk' ) {
731 } elsif ( $media eq 'cdrom' ) {
734 die "internal error" ;
737 return if ( $vtype eq $etype );
739 raise_param_exc
({ $opt => "unexpected media type ( $vtype != $etype )" });
742 sub cleanup_drive_path
{
743 my ( $opt, $storecfg, $drive ) = @_ ;
745 # try to convert filesystem paths to volume IDs
747 if (( $drive ->{ file
} !~ m/^(cdrom|none)$/ ) &&
748 ( $drive ->{ file
} !~ m
|^ /dev/ .+|) &&
749 ( $drive ->{ file
} !~ m/^([^:]+):(.+)$/ ) &&
750 ( $drive ->{ file
} !~ m/^\d+$/ )) {
751 my ( $vtype, $volid ) = PVE
:: Storage
:: path_to_volume_id
( $storecfg, $drive ->{ file
});
752 raise_param_exc
({ $opt => "unable to associate path ' $drive ->{file}' to any storage" }) if ! $vtype ;
753 $drive ->{ media
} = 'cdrom' if ! $drive ->{ media
} && $vtype eq 'iso' ;
754 verify_media_type
( $opt, $vtype, $drive ->{ media
});
755 $drive ->{ file
} = $volid ;
758 $drive ->{ media
} = 'cdrom' if ! $drive ->{ media
} && $drive ->{ file
} =~ m/^(cdrom|none)$/ ;
761 sub create_conf_nolock
{
762 my ( $vmid, $settings ) = @_ ;
764 my $filename = config_file
( $vmid );
766 die "configuration file ' $filename ' already exists \n " if - f
$filename ;
768 my $defaults = load_defaults
();
770 $settings ->{ name
} = "vm $vmid " if ! $settings ->{ name
};
771 $settings ->{ memory
} = $defaults ->{ memory
} if ! $settings ->{ memory
};
774 foreach my $opt ( keys %$settings ) {
775 next if ! $confdesc ->{ $opt };
777 my $value = $settings ->{ $opt };
780 $data .= " $opt : $value\n " ;
783 PVE
:: Tools
:: file_set_contents
( $filename, $data );
786 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
787 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
788 # [,aio=native|threads]
791 my ( $key, $data ) = @_ ;
795 # $key may be undefined - used to verify JSON parameters
796 if (! defined ( $key )) {
797 $res ->{ interface
} = 'unknown' ; # should not harm when used to verify parameters
799 } elsif ( $key =~ m/^([^\d]+)(\d+)$/ ) {
800 $res ->{ interface
} = $1 ;
806 foreach my $p ( split ( /,/ , $data )) {
807 next if $p =~ m/^\s*$/ ;
809 if ( $p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio)=(.+)$/ ) {
810 my ( $k, $v ) = ( $1, $2 );
812 $k = 'file' if $k eq 'volume' ;
814 return undef if defined $res ->{ $k };
818 if (! $res ->{ file
} && $p !~ m/=/ ) {
826 return undef if ! $res ->{ file
};
828 return undef if $res ->{ cache
} &&
829 $res ->{ cache
} !~ m/^(off|none|writethrough|writeback|unsafe)$/ ;
830 return undef if $res ->{ snapshot
} && $res ->{ snapshot
} !~ m/^(on|off)$/ ;
831 return undef if $res ->{ cyls
} && $res ->{ cyls
} !~ m/^\d+$/ ;
832 return undef if $res ->{ heads
} && $res ->{ heads
} !~ m/^\d+$/ ;
833 return undef if $res ->{ secs
} && $res ->{ secs
} !~ m/^\d+$/ ;
834 return undef if $res ->{ media
} && $res ->{ media
} !~ m/^(disk|cdrom)$/ ;
835 return undef if $res ->{ trans
} && $res ->{ trans
} !~ m/^(none|lba|auto)$/ ;
836 return undef if $res ->{ format
} && $res ->{ format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/ ;
837 return undef if $res ->{ rerror
} && $res ->{ rerror
} !~ m/^(ignore|report|stop)$/ ;
838 return undef if $res ->{ werror
} && $res ->{ werror
} !~ m/^(enospc|ignore|report|stop)$/ ;
839 return undef if $res ->{ backup
} && $res ->{ backup
} !~ m/^(yes|no)$/ ;
840 return undef if $res ->{ aio
} && $res ->{ aio
} !~ m/^(native|threads)$/ ;
842 if ( $res ->{ media
} && ( $res ->{ media
} eq 'cdrom' )) {
843 return undef if $res ->{ snapshot
} || $res ->{ trans
} || $res ->{ format
};
844 return undef if $res ->{ heads
} || $res ->{ secs
} || $res ->{ cyls
};
845 return undef if $res ->{ interface
} eq 'virtio' ;
848 # rerror does not work with scsi drives
849 if ( $res ->{ rerror
}) {
850 return undef if $res ->{ interface
} eq 'scsi' ;
856 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio) ;
859 my ( $vmid, $drive ) = @_ ;
862 foreach my $o ( @qemu_drive_options, 'backup' ) {
863 $opts .= ", $o = $drive ->{ $o }" if $drive ->{ $o };
866 return " $drive ->{file} $opts " ;
869 sub print_drivedevice_full
{
870 my ( $storecfg, $vmid, $drive ) = @_ ;
875 if ( $drive ->{ interface
} eq 'virtio' ) {
876 my $pciaddr = print_pci_addr
( " $drive ->{interface} $drive ->{index}" );
877 $device = "virtio-blk-pci,drive=drive- $drive ->{interface} $drive ->{index},id= $drive ->{interface} $drive ->{index} $pciaddr " ;
878 } elsif ( $drive ->{ interface
} eq 'scsi' ) {
880 my $controller = int ( $drive ->{ index } / $maxdev );
881 my $unit = $drive ->{ index } % $maxdev ;
882 my $devicetype = 'hd' ;
884 if ( drive_is_cdrom
( $drive )) {
887 if ( $drive ->{ file
} =~ m
|^/|) {
888 $path = $drive ->{ file
};
890 $path = PVE
:: Storage
:: path
( $storecfg, $drive ->{ file
});
892 if ( $path =~ m
|^ /dev/ | ) {
893 $devicetype = 'block' ;
897 $device = "scsi- $devicetype,bus =scsi $controller .0,scsi-id= $unit,drive =drive- $drive ->{interface} $drive ->{index},id=device- $drive ->{interface} $drive ->{index}" ;
898 } elsif ( $drive ->{ interface
} eq 'ide' ){
900 my $controller = int ( $drive ->{ index } / $maxdev );
901 my $unit = $drive ->{ index } % $maxdev ;
902 my $devicetype = ( $drive ->{ media
} && $drive ->{ media
} eq 'cdrom' ) ?
"cd" : "hd" ;
904 $device = "ide- $devicetype,bus =ide. $controller,unit = $unit,drive =drive- $drive ->{interface} $drive ->{index},id=device- $drive ->{interface} $drive ->{index}" ;
905 } elsif ( $drive ->{ interface
} eq 'usb' ) {
907 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
909 die "unsupported interface type" ;
912 $device .= ",bootindex= $drive ->{bootindex}" if $drive ->{ bootindex
};
917 sub print_drive_full
{
918 my ( $storecfg, $vmid, $drive ) = @_ ;
921 foreach my $o ( @qemu_drive_options ) {
922 next if $o eq 'bootindex' ;
923 $opts .= ", $o = $drive ->{ $o }" if $drive ->{ $o };
926 # use linux-aio by default (qemu default is threads)
927 $opts .= ",aio=native" if ! $drive ->{ aio
};
930 my $volid = $drive ->{ file
};
931 if ( drive_is_cdrom
( $drive )) {
932 $path = get_iso_path
( $storecfg, $vmid, $volid );
934 if ( $volid =~ m
|^/|) {
937 $path = PVE
:: Storage
:: path
( $storecfg, $volid );
939 if (! $drive ->{ cache
} && ( $path =~ m
|^ /dev/ | || $path =~ m
| \
. raw
$|)) {
940 $opts .= ",cache=none" ;
944 my $pathinfo = $path ?
"file= $path, " : '' ;
946 return "${pathinfo}if=none,id=drive- $drive ->{interface} $drive ->{index} $opts " ;
953 return $drive && $drive ->{ media
} && ( $drive ->{ media
} eq 'cdrom' );
960 return undef if ! $value ;
964 if ( $value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/ ) {
965 $res ->{ pciid
} = $value ;
973 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
979 foreach my $kvp ( split ( /,/ , $data )) {
981 if ( $kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i ) {
983 my $mac = uc ( $3 ) || PVE
:: Tools
:: random_ether_addr
();
984 $res ->{ model
} = $model ;
985 $res ->{ macaddr
} = $mac ;
986 } elsif ( $kvp =~ m/^bridge=(\S+)$/ ) {
988 } elsif ( $kvp =~ m/^rate=(\d+(\.\d+)?)$/ ) {
996 return undef if ! $res ->{ model
};
1004 my $res = " $net ->{model}" ;
1005 $res .= "= $net ->{macaddr}" if $net ->{ macaddr
};
1006 $res .= ",bridge= $net ->{bridge}" if $net ->{ bridge
};
1007 $res .= ",rate= $net ->{rate}" if $net ->{ rate
};
1012 sub add_random_macs
{
1013 my ( $settings ) = @_ ;
1015 foreach my $opt ( keys %$settings ) {
1016 next if $opt !~ m/^net(\d+)$/ ;
1017 my $net = parse_net
( $settings ->{ $opt });
1019 $settings ->{ $opt } = print_net
( $net );
1023 sub add_unused_volume
{
1024 my ( $config, $res, $volid ) = @_ ;
1027 for ( my $ind = $MAX_UNUSED_DISKS - 1 ; $ind >= 0 ; $ind --) {
1028 my $test = "unused $ind " ;
1029 if ( my $vid = $config ->{ $test }) {
1030 return if $vid eq $volid ; # do not add duplicates
1036 die "To many unused volume - please delete them first. \n " if ! $key ;
1038 $res ->{ $key } = $volid ;
1041 # fixme: remove all thos $noerr parameters?
1043 PVE
:: JSONSchema
:: register_format
( 'pve-qm-bootdisk' , \
& verify_bootdisk
);
1044 sub verify_bootdisk
{
1045 my ( $value, $noerr ) = @_ ;
1047 return $value if valid_drivename
( $value );
1049 return undef if $noerr ;
1051 die "invalid boot disk ' $value ' \n " ;
1054 PVE
:: JSONSchema
:: register_format
( 'pve-qm-net' , \
& verify_net
);
1056 my ( $value, $noerr ) = @_ ;
1058 return $value if parse_net
( $value );
1060 return undef if $noerr ;
1062 die "unable to parse network options \n " ;
1065 PVE
:: JSONSchema
:: register_format
( 'pve-qm-drive' , \
& verify_drive
);
1067 my ( $value, $noerr ) = @_ ;
1069 return $value if parse_drive
( undef , $value );
1071 return undef if $noerr ;
1073 die "unable to parse drive options \n " ;
1076 PVE
:: JSONSchema
:: register_format
( 'pve-qm-hostpci' , \
& verify_hostpci
);
1077 sub verify_hostpci
{
1078 my ( $value, $noerr ) = @_ ;
1080 return $value if parse_hostpci
( $value );
1082 return undef if $noerr ;
1084 die "unable to parse pci id \n " ;
1087 PVE
:: JSONSchema
:: register_format
( 'pve-qm-watchdog' , \
& verify_watchdog
);
1088 sub verify_watchdog
{
1089 my ( $value, $noerr ) = @_ ;
1091 return $value if parse_watchdog
( $value );
1093 return undef if $noerr ;
1095 die "unable to parse watchdog options \n " ;
1098 sub parse_watchdog
{
1101 return undef if ! $value ;
1105 foreach my $p ( split ( /,/ , $value )) {
1106 next if $p =~ m/^\s*$/ ;
1108 if ( $p =~ m/^(model=)?(i6300esb|ib700)$/ ) {
1110 } elsif ( $p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/ ) {
1111 $res ->{ action
} = $2 ;
1120 sub parse_usb_device
{
1123 return undef if ! $value ;
1125 my @dl = split ( /,/ , $value );
1129 foreach my $v ( @dl ) {
1130 if ( $v =~ m/^host=([0-9A-Fa-f]{4}):([0-9A-Fa-f]{4})$/ ) {
1132 $res ->{ vendorid
} = $1 ;
1133 $res ->{ productid
} = $2 ;
1134 } elsif ( $v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/ ) {
1136 $res ->{ hostbus
} = $1 ;
1137 $res ->{ hostport
} = $2 ;
1142 return undef if ! $found ;
1147 PVE
:: JSONSchema
:: register_format
( 'pve-qm-usb-device' , \
& verify_usb_device
);
1148 sub verify_usb_device
{
1149 my ( $value, $noerr ) = @_ ;
1151 return $value if parse_usb_device
( $value );
1153 return undef if $noerr ;
1155 die "unable to parse usb device \n " ;
1158 # add JSON properties for create and set function
1159 sub json_config_properties
{
1162 foreach my $opt ( keys %$confdesc ) {
1163 $prop ->{ $opt } = $confdesc ->{ $opt };
1170 my ( $key, $value ) = @_ ;
1172 die "unknown setting ' $key ' \n " if ! $confdesc ->{ $key };
1174 my $type = $confdesc ->{ $key }->{ type
};
1176 if (! defined ( $value )) {
1177 die "got undefined value \n " ;
1180 if ( $value =~ m/[\n\r]/ ) {
1181 die "property contains a line feed \n " ;
1184 if ( $type eq 'boolean' ) {
1185 return 1 if ( $value eq '1' ) || ( $value =~ m/^(on|yes|true)$/i );
1186 return 0 if ( $value eq '0' ) || ( $value =~ m/^(off|no|false)$/i );
1187 die "type check ('boolean') failed - got ' $value ' \n " ;
1188 } elsif ( $type eq 'integer' ) {
1189 return int ( $1 ) if $value =~ m/^(\d+)$/ ;
1190 die "type check ('integer') failed - got ' $value ' \n " ;
1191 } elsif ( $type eq 'string' ) {
1192 if ( my $fmt = $confdesc ->{ $key }->{ format
}) {
1193 if ( $fmt eq 'pve-qm-drive' ) {
1194 # special case - we need to pass $key to parse_drive()
1195 my $drive = parse_drive
( $key, $value );
1196 return $value if $drive ;
1197 die "unable to parse drive options \n " ;
1199 PVE
:: JSONSchema
:: check_format
( $fmt, $value );
1202 $value =~ s/^\"(.*)\"$/$1/ ;
1205 die "internal error"
1210 my ( $vmid, $code, @param ) = @_ ;
1212 my $filename = config_file_lock
( $vmid );
1214 my $res = lock_file
( $filename, 10 , $code, @param );
1221 sub cfs_config_path
{
1222 my ( $vmid, $node ) = @_ ;
1224 $node = $nodename if ! $node ;
1225 return "nodes/ $node/qemu -server/ $vmid .conf" ;
1228 sub check_iommu_support
{
1229 #fixme : need to check IOMMU support
1230 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1238 my ( $vmid, $node ) = @_ ;
1240 my $cfspath = cfs_config_path
( $vmid, $node );
1241 return "/etc/pve/ $cfspath " ;
1244 sub config_file_lock
{
1247 return " $lock_dir/lock - $vmid .conf" ;
1253 my $conf = config_file
( $vmid );
1254 utime undef , undef , $conf ;
1258 my ( $storecfg, $vmid, $settings, $conf, $default_storage ) = @_ ;
1263 foreach_drive
( $settings, sub {
1264 my ( $ds, $disk ) = @_ ;
1266 return if drive_is_cdrom
( $disk );
1268 my $file = $disk ->{ file
};
1270 if ( $file =~ m/^(([^:\s]+):)?(\d+(\.\d+)?)$/ ) {
1271 my $storeid = $2 || $default_storage ;
1273 my $defformat = PVE
:: Storage
:: storage_default_format
( $storecfg, $storeid );
1274 my $fmt = $disk ->{ format
} || $defformat ;
1275 syslog
( 'info' , "VM $vmid creating new disk - size is $size GB" );
1277 my $volid = PVE
:: Storage
:: vdisk_alloc
( $storecfg, $storeid, $vmid,
1278 $fmt, undef , $size*1024*1024 );
1280 $disk ->{ file
} = $volid ;
1281 delete $disk ->{ format
}; # no longer needed
1282 push @$vollist, $volid ;
1283 $settings ->{ $ds } = PVE
:: QemuServer
:: print_drive
( $vmid, $disk );
1286 if ( $disk ->{ file
} =~ m
|^ /dev/ .+|) {
1287 $path = $disk ->{ file
};
1289 $path = PVE
:: Storage
:: path
( $storecfg, $disk ->{ file
});
1291 if (!(- f
$path || - b
$path )) {
1292 die "image ' $path ' does not exists \n " ;
1295 PVE
:: QemuServer
:: vm_deviceadd
( $storecfg, $conf, $vmid, $ds, $disk ) if defined ( $conf );
1302 syslog
( 'err' , "VM $vmid creating disks failed" );
1303 foreach my $volid ( @$vollist ) {
1304 eval { PVE
:: Storage
:: vdisk_free
( $storecfg, $volid ); };
1314 my ( $storecfg, $vmid, $keep_empty_config ) = @_ ;
1316 my $conffile = config_file
( $vmid );
1318 my $conf = load_config
( $vmid );
1322 # only remove disks owned by this VM
1323 foreach_drive
( $conf, sub {
1324 my ( $ds, $drive ) = @_ ;
1326 return if drive_is_cdrom
( $drive );
1328 my $volid = $drive ->{ file
};
1329 return if ! $volid || $volid =~ m
|^/|;
1331 my ( $path, $owner ) = PVE
:: Storage
:: path
( $storecfg, $volid );
1332 return if ! $path || ! $owner || ( $owner != $vmid );
1334 PVE
:: Storage
:: vdisk_free
( $storecfg, $volid );
1337 if ( $keep_empty_config ) {
1338 PVE
:: Tools
:: file_set_contents
( $conffile, "memory: 128 \n " );
1343 # also remove unused disk
1345 my $dl = PVE
:: Storage
:: vdisk_list
( $storecfg, undef , $vmid );
1348 PVE
:: Storage
:: foreach_volid
( $dl, sub {
1349 my ( $volid, $sid, $volname, $d ) = @_ ;
1350 PVE
:: Storage
:: vdisk_free
( $storecfg, $volid );
1360 sub load_diskinfo_old
{
1361 my ( $storecfg, $vmid, $conf ) = @_ ;
1367 foreach_drive
( $conf, sub {
1372 return if drive_is_cdrom
( $di );
1374 if ( $di ->{ file
} =~ m
|^ /dev/ .+|) {
1375 $info ->{ $di ->{ file
}}->{ size
} = PVE
:: Storage
:: file_size_info
( $di ->{ file
});
1377 push @$vollist, $di ->{ file
};
1382 my $dl = PVE
:: Storage
:: vdisk_list
( $storecfg, undef , $vmid, $vollist );
1384 PVE
:: Storage
:: foreach_volid
( $dl, sub {
1385 my ( $volid, $sid, $volname, $d ) = @_ ;
1386 $info ->{ $volid } = $d ;
1391 foreach my $ds ( keys %$res ) {
1392 my $di = $res ->{ $ds };
1394 $res ->{ $ds }->{ disksize
} = $info ->{ $di ->{ file
}} ?
1395 $info ->{ $di ->{ file
}}->{ size
} / ( 1024 * 1024 ) : 0 ;
1404 my $cfspath = cfs_config_path
( $vmid );
1406 my $conf = PVE
:: Cluster
:: cfs_read_file
( $cfspath );
1408 die "no such VM (' $vmid ') \n " if ! defined ( $conf );
1413 sub parse_vm_config
{
1414 my ( $filename, $raw ) = @_ ;
1416 return undef if ! defined ( $raw );
1419 digest
=> Digest
:: SHA1
:: sha1_hex
( $raw ),
1422 $filename =~ m
| /qemu-server/ ( \d
+) \
. conf
$|
1423 || die "got strange filename ' $filename '" ;
1427 while ( $raw && $raw =~ s/^(.*?)(\n|$)// ) {
1430 next if $line =~ m/^\#/ ;
1432 next if $line =~ m/^\s*$/ ;
1434 if ( $line =~ m/^(description):\s*(.*\S)\s*$/ ) {
1436 my $value = PVE
:: Tools
:: decode_text
( $2 );
1437 $res ->{ $key } = $value ;
1438 } elsif ( $line =~ m/^(args):\s*(.*\S)\s*$/ ) {
1441 $res ->{ $key } = $value ;
1442 } elsif ( $line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/ ) {
1445 eval { $value = check_type
( $key, $value ); };
1447 warn "vm $vmid - unable to parse value of ' $key ' - $@ " ;
1449 my $fmt = $confdesc ->{ $key }->{ format
};
1450 if ( $fmt && $fmt eq 'pve-qm-drive' ) {
1451 my $v = parse_drive
( $key, $value );
1452 if ( my $volid = filename_to_volume_id
( $vmid, $v ->{ file
}, $v ->{ media
})) {
1453 $v ->{ file
} = $volid ;
1454 $value = print_drive
( $vmid, $v );
1456 warn "vm $vmid - unable to parse value of ' $key ' \n " ;
1461 if ( $key eq 'cdrom' ) {
1462 $res ->{ ide2
} = $value ;
1464 $res ->{ $key } = $value ;
1470 # convert old smp to sockets
1471 if ( $res ->{ smp
} && ! $res ->{ sockets
}) {
1472 $res ->{ sockets
} = $res ->{ smp
};
1480 my ( $vmid, $settings, $unset, $skiplock ) = @_ ;
1482 lock_config
( $vmid, & change_config_nolock
, $settings, $unset, $skiplock );
1485 sub change_config_nolock
{
1486 my ( $vmid, $settings, $unset, $skiplock ) = @_ ;
1490 $unset ->{ ide2
} = $unset ->{ cdrom
} if $unset ->{ cdrom
};
1492 check_lock
( $settings ) if ! $skiplock ;
1494 # we do not use 'smp' any longer
1495 if ( $settings ->{ sockets
}) {
1497 } elsif ( $settings ->{ smp
}) {
1498 $settings ->{ sockets
} = $settings ->{ smp
};
1502 my $new_volids = {};
1504 foreach my $key ( keys %$settings ) {
1505 next if $key eq 'digest' ;
1506 my $value = $settings ->{ $key };
1507 if ( $key eq 'description' ) {
1508 $value = PVE
:: Tools
:: encode_text
( $value );
1510 eval { $value = check_type
( $key, $value ); };
1511 die "unable to parse value of ' $key ' - $@ " if $@ ;
1512 if ( $key eq 'cdrom' ) {
1513 $res ->{ ide2
} = $value ;
1515 $res ->{ $key } = $value ;
1517 if ( valid_drivename
( $key )) {
1518 my $drive = PVE
:: QemuServer
:: parse_drive
( $key, $value );
1519 $new_volids ->{ $drive ->{ file
}} = 1 if $drive && $drive ->{ file
};
1523 my $filename = config_file
( $vmid );
1524 my $tmpfn = " $filename . $$ .tmp" ;
1526 my $fh = new IO
:: File
( $filename, "r" ) ||
1527 die "unable to read config for VM $vmid\n " ;
1529 my $werror = "unable to write config for VM $vmid\n " ;
1531 my $out = new IO
:: File
( $tmpfn, "w" ) || die $werror ;
1537 while ( my $line = < $fh >) {
1539 if (( $line =~ m/^\#/ ) || ( $line =~ m/^\s*$/ )) {
1540 die $werror unless print $out $line ;
1544 if ( $line =~ m/^([a-z][a-z_]*\d*):\s*(.*\S)\s*$/ ) {
1548 # remove 'unusedX' settings if we re-add a volume
1549 next if $key =~ m/^unused/ && $new_volids ->{ $value };
1551 # convert 'smp' to 'sockets'
1552 $key = 'sockets' if $key eq 'smp' ;
1554 next if $done ->{ $key };
1557 if ( defined ( $res ->{ $key })) {
1558 $value = $res ->{ $key };
1559 delete $res ->{ $key };
1561 if (! defined ( $unset ->{ $key })) {
1562 die $werror unless print $out " $key : $value\n " ;
1568 die "unable to parse config file: $line\n " ;
1571 foreach my $key ( keys %$res ) {
1573 if (! defined ( $unset ->{ $key })) {
1574 die $werror unless print $out " $key : $res ->{ $key } \n " ;
1589 if (! $out -> close ()) {
1590 $err = "close failed - $!\n " ;
1595 if (! rename ( $tmpfn, $filename )) {
1596 $err = "rename failed - $!\n " ;
1606 # we use static defaults from our JSON schema configuration
1607 foreach my $key ( keys %$confdesc ) {
1608 if ( defined ( my $default = $confdesc ->{ $key }->{ default })) {
1609 $res ->{ $key } = $default ;
1613 my $conf = PVE
:: Cluster
:: cfs_read_file
( 'datacenter.cfg' );
1614 $res ->{ keyboard
} = $conf ->{ keyboard
} if $conf ->{ keyboard
};
1620 my $vmlist = PVE
:: Cluster
:: get_vmlist
();
1622 return $res if ! $vmlist || ! $vmlist ->{ ids
};
1623 my $ids = $vmlist ->{ ids
};
1625 foreach my $vmid ( keys %$ids ) {
1626 my $d = $ids ->{ $vmid };
1627 next if ! $d ->{ node
} || $d ->{ node
} ne $nodename ;
1628 next if ! $d ->{ type
} || $d ->{ type
} ne 'qemu' ;
1629 $res ->{ $vmid }->{ exists } = 1 ;
1634 # test if VM uses local resources (to prevent migration)
1635 sub check_local_resources
{
1636 my ( $conf, $noerr ) = @_ ;
1640 $loc_res = 1 if $conf ->{ hostusb
}; # old syntax
1641 $loc_res = 1 if $conf ->{ hostpci
}; # old syntax
1643 foreach my $k ( keys %$conf ) {
1644 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/ ;
1647 die "VM uses local resources \n " if $loc_res && ! $noerr ;
1655 die "VM is locked ( $conf ->{lock}) \n " if $conf ->{ lock };
1659 my ( $pidfile, $pid ) = @_ ;
1661 my $fh = IO
:: File-
> new ( "/proc/ $pid/cmdline " , "r" );
1665 return undef if ! $line ;
1666 my @param = split ( /\0/ , $line );
1668 my $cmd = $param [ 0 ];
1669 return if ! $cmd || ( $cmd !~ m
| kvm
$|);
1671 for ( my $i = 0 ; $i < scalar ( @param ); $i++ ) {
1674 if (( $p eq '-pidfile' ) || ( $p eq '--pidfile' )) {
1675 my $p = $param [ $i+1 ];
1676 return 1 if $p && ( $p eq $pidfile );
1685 my ( $vmid, $nocheck ) = @_ ;
1687 my $filename = config_file
( $vmid );
1689 die "unable to find configuration file for VM $vmid - no such machine \n "
1690 if ! $nocheck && ! - f
$filename ;
1692 my $pidfile = pidfile_name
( $vmid );
1694 if ( my $fd = IO
:: File-
> new ( "< $pidfile " )) {
1699 my $mtime = $st -> mtime ;
1700 if ( $mtime > time ()) {
1701 warn "file ' $filename ' modified in future \n " ;
1704 if ( $line =~ m/^(\d+)$/ ) {
1706 if ( check_cmdline
( $pidfile, $pid )) {
1707 if ( my $pinfo = PVE
:: ProcFSTools
:: check_process_running
( $pid )) {
1719 my $vzlist = config_list
();
1721 my $fd = IO
:: Dir-
> new ( $var_run_tmpdir ) || return $vzlist ;
1723 while ( defined ( my $de = $fd -> read )) {
1724 next if $de !~ m/^(\d+)\.pid$/ ;
1726 next if ! defined ( $vzlist ->{ $vmid });
1727 if ( my $pid = check_running
( $vmid )) {
1728 $vzlist ->{ $vmid }->{ pid
} = $pid ;
1735 my $storage_timeout_hash = {};
1738 my ( $storecfg, $conf ) = @_ ;
1740 my $bootdisk = $conf ->{ bootdisk
};
1741 return undef if ! $bootdisk ;
1742 return undef if ! valid_drivename
( $bootdisk );
1744 return undef if ! $conf ->{ $bootdisk };
1746 my $drive = parse_drive
( $bootdisk, $conf ->{ $bootdisk });
1747 return undef if ! defined ( $drive );
1749 return undef if drive_is_cdrom
( $drive );
1751 my $volid = $drive ->{ file
};
1752 return undef if ! $volid ;
1758 if ( $volid =~ m
|^/|) {
1759 $path = $timeoutid = $volid ;
1761 $storeid = $timeoutid = PVE
:: Storage
:: parse_volume_id
( $volid );
1762 $path = PVE
:: Storage
:: path
( $storecfg, $volid );
1765 my $last_timeout = $storage_timeout_hash ->{ $timeoutid };
1766 if ( $last_timeout ) {
1767 if (( time () - $last_timeout ) < 30 ) {
1768 # skip storage with errors
1771 delete $storage_timeout_hash ->{ $timeoutid };
1774 my ( $size, $format, $used );
1776 ( $size, $format, $used ) = PVE
:: Storage
:: file_size_info
( $path, 1 );
1778 if (! defined ( $format )) {
1780 $storage_timeout_hash ->{ $timeoutid } = time ();
1784 return wantarray ?
( $size, $used ) : $size ;
1787 my $last_proc_pid_stat ;
1790 my ( $opt_vmid ) = @_ ;
1794 my $storecfg = PVE
:: Storage
:: config
();
1796 my $list = vzlist
();
1797 my ( $uptime ) = PVE
:: ProcFSTools
:: read_proc_uptime
( 1 );
1799 my $cpucount = $cpuinfo ->{ cpus
} || 1 ;
1801 foreach my $vmid ( keys %$list ) {
1802 next if $opt_vmid && ( $vmid ne $opt_vmid );
1804 my $cfspath = cfs_config_path
( $vmid );
1805 my $conf = PVE
:: Cluster
:: cfs_read_file
( $cfspath ) || {};
1808 $d ->{ pid
} = $list ->{ $vmid }->{ pid
};
1810 # fixme: better status?
1811 $d ->{ status
} = $list ->{ $vmid }->{ pid
} ?
'running' : 'stopped' ;
1813 my ( $size, $used ) = disksize
( $storecfg, $conf );
1814 if ( defined ( $size ) && defined ( $used )) {
1816 $d ->{ maxdisk
} = $size ;
1822 $d ->{ cpus
} = ( $conf ->{ sockets
} || 1 ) * ( $conf ->{ cores
} || 1 );
1823 $d ->{ cpus
} = $cpucount if $d ->{ cpus
} > $cpucount ;
1825 $d ->{ name
} = $conf ->{ name
} || "VM $vmid " ;
1826 $d ->{ maxmem
} = $conf ->{ memory
} ?
$conf ->{ memory
}*( 1024 * 1024 ) : 0 ;
1836 $d ->{ diskwrite
} = 0 ;
1841 my $netdev = PVE
:: ProcFSTools
:: read_proc_net_dev
();
1842 foreach my $dev ( keys %$netdev ) {
1843 next if $dev !~ m/^tap([1-9]\d*)i/ ;
1845 my $d = $res ->{ $vmid };
1848 $d ->{ netout
} += $netdev ->{ $dev }->{ receive
};
1849 $d ->{ netin
} += $netdev ->{ $dev }->{ transmit
};
1852 my $ctime = gettimeofday
;
1854 foreach my $vmid ( keys %$list ) {
1856 my $d = $res ->{ $vmid };
1857 my $pid = $d ->{ pid
};
1860 if ( my $fh = IO
:: File-
> new ( "/proc/ $pid/io " , "r" )) {
1862 while ( defined ( my $line = < $fh >)) {
1863 if ( $line =~ m/^([rw]char):\s+(\d+)$/ ) {
1868 $d ->{ diskread
} = $data ->{ rchar
} || 0 ;
1869 $d ->{ diskwrite
} = $data ->{ wchar
} || 0 ;
1872 my $pstat = PVE
:: ProcFSTools
:: read_proc_pid_stat
( $pid );
1873 next if ! $pstat ; # not running
1875 my $used = $pstat ->{ utime } + $pstat ->{ stime
};
1877 $d ->{ uptime
} = int (( $uptime - $pstat ->{ starttime
})/ $cpuinfo ->{ user_hz
});
1879 if ( $pstat ->{ vsize
}) {
1880 $d ->{ mem
} = int (( $pstat ->{ rss
}/ $pstat ->{ vsize
})* $d ->{ maxmem
});
1883 my $old = $last_proc_pid_stat ->{ $pid };
1885 $last_proc_pid_stat ->{ $pid } = {
1893 my $dtime = ( $ctime - $old ->{ time }) * $cpucount * $cpuinfo ->{ user_hz
};
1895 if ( $dtime > 1000 ) {
1896 my $dutime = $used - $old ->{ used
};
1898 $d ->{ cpu
} = (( $dutime/$dtime )* $cpucount ) / $d ->{ cpus
};
1899 $last_proc_pid_stat ->{ $pid } = {
1905 $d ->{ cpu
} = $old ->{ cpu
};
1913 my ( $conf, $func ) = @_ ;
1915 foreach my $ds ( keys %$conf ) {
1916 next if ! valid_drivename
( $ds );
1918 my $drive = parse_drive
( $ds, $conf ->{ $ds });
1921 & $func ( $ds, $drive );
1925 sub config_to_command
{
1926 my ( $storecfg, $vmid, $conf, $defaults, $migrate_uri ) = @_ ;
1930 my $kvmver = kvm_user_version
();
1931 my $vernum = 0 ; # unknown
1932 if ( $kvmver =~ m/^(\d+)\.(\d+)$/ ) {
1933 $vernum = $1*1000000+$2*1000 ;
1934 } elsif ( $kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/ ) {
1935 $vernum = $1*1000000+$2*1000+$3 ;
1938 die "detected old qemu-kvm binary ( $kvmver ) \n " if $vernum < 15000 ;
1940 my $have_ovz = - f
'/proc/vz/vestat' ;
1942 push @$cmd, '/usr/bin/kvm' ;
1944 push @$cmd, '-id' , $vmid ;
1948 my $socket = monitor_socket
( $vmid );
1949 push @$cmd, '-chardev' , "socket,id=monitor,path= $socket,server,nowait " ;
1950 push @$cmd, '-mon' , "chardev=monitor,mode=readline" ;
1952 $socket = vnc_socket
( $vmid );
1953 push @$cmd, '-vnc' , "unix: $socket,x509,password " ;
1955 push @$cmd, '-pidfile' , pidfile_name
( $vmid );
1957 push @$cmd, '-daemonize' ;
1959 push @$cmd, '-incoming' , $migrate_uri if $migrate_uri ;
1962 for ( my $i = 0 ; $i < $MAX_USB_DEVICES ; $i++ ) {
1963 next if ! $conf ->{ "usb $i " };
1966 # include usb device config
1967 push @$cmd, '-readconfig' , '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2 ;
1969 # enable absolute mouse coordinates (needed by vnc)
1970 my $tablet = defined ( $conf ->{ tablet
}) ?
$conf ->{ tablet
} : $defaults ->{ tablet
};
1973 push @$cmd, '-device' , 'usb-tablet,bus=ehci.0,port=6' ;
1975 push @$cmd, '-usbdevice' , 'tablet' ;
1980 for ( my $i = 0 ; $i < $MAX_HOSTPCI_DEVICES ; $i++ ) {
1981 my $d = parse_hostpci
( $conf ->{ "hostpci $i " });
1983 $pciaddr = print_pci_addr
( "hostpci $i " );
1984 push @$cmd, '-device' , "pci-assign,host= $d ->{pciid},id=hostpci $i$pciaddr " ;
1988 for ( my $i = 0 ; $i < $MAX_USB_DEVICES ; $i++ ) {
1989 my $d = parse_usb_device
( $conf ->{ "usb $i " });
1991 if ( $d ->{ vendorid
} && $d ->{ productid
}) {
1992 push @$cmd, '-device' , "usb-host,vendorid= $d ->{vendorid},productid= $d ->{productid}" ;
1993 } elsif ( defined ( $d ->{ hostbus
}) && defined ( $d ->{ hostport
})) {
1994 push @$cmd, '-device' , "usb-host,hostbus= $d ->{hostbus},hostport= $d ->{hostport}" ;
1999 for ( my $i = 0 ; $i < $MAX_SERIAL_PORTS ; $i++ ) {
2000 if ( my $path = $conf ->{ "serial $i " }) {
2001 die "no such serial device \n " if ! - c
$path ;
2002 push @$cmd, '-chardev' , "tty,id=serial $i,path = $path " ;
2003 push @$cmd, '-device' , "isa-serial,chardev=serial $i " ;
2008 for ( my $i = 0 ; $i < $MAX_PARALLEL_PORTS ; $i++ ) {
2009 if ( my $path = $conf ->{ "parallel $i " }) {
2010 die "no such parallel device \n " if ! - c
$path ;
2011 push @$cmd, '-chardev' , "parport,id=parallel $i,path = $path " ;
2012 push @$cmd, '-device' , "isa-parallel,chardev=parallel $i " ;
2016 my $vmname = $conf ->{ name
} || "vm $vmid " ;
2018 push @$cmd, '-name' , $vmname ;
2021 $sockets = $conf ->{ smp
} if $conf ->{ smp
}; # old style - no longer iused
2022 $sockets = $conf ->{ sockets
} if $conf ->{ sockets
};
2024 my $cores = $conf ->{ cores
} || 1 ;
2026 push @$cmd, '-smp' , "sockets= $sockets,cores = $cores " ;
2028 push @$cmd, '-cpu' , $conf ->{ cpu
} if $conf ->{ cpu
};
2030 push @$cmd, '-nodefaults' ;
2032 my $bootorder = $conf ->{ boot
} || $confdesc ->{ boot
}->{ default };
2034 my $bootindex_hash = {};
2036 foreach my $o ( split ( // , $bootorder )) {
2037 $bootindex_hash ->{ $o } = $i*100 ;
2041 push @$cmd, '-boot' , "menu=on" ;
2043 push @$cmd, '-no-acpi' if defined ( $conf ->{ acpi
}) && $conf ->{ acpi
} == 0 ;
2045 push @$cmd, '-no-reboot' if defined ( $conf ->{ reboot
}) && $conf ->{ reboot
} == 0 ;
2047 my $vga = $conf ->{ vga
};
2049 if ( $conf ->{ ostype
} && ( $conf ->{ ostype
} eq 'win7' || $conf ->{ ostype
} eq 'w2k8' )) {
2056 push @$cmd, '-vga' , $vga if $vga ; # for kvm 77 and later
2059 my $tdf = defined ( $conf ->{ tdf
}) ?
$conf ->{ tdf
} : $defaults ->{ tdf
};
2060 push @$cmd, '-tdf' if $tdf ;
2062 my $nokvm = defined ( $conf ->{ kvm
}) && $conf ->{ kvm
} == 0 ?
1 : 0 ;
2064 if ( my $ost = $conf ->{ ostype
}) {
2065 # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2067 if ( $ost =~ m/^w/ ) { # windows
2068 push @$cmd, '-localtime' if ! defined ( $conf ->{ localtime });
2070 # use rtc-td-hack when acpi is enabled
2071 if (!( defined ( $conf ->{ acpi
}) && $conf ->{ acpi
} == 0 )) {
2072 push @$cmd, '-rtc-td-hack' ;
2083 push @$cmd, '-no-kvm' ;
2085 die "No accelerator found! \n " if ! $cpuinfo ->{ hvm
};
2088 push @$cmd, '-localtime' if $conf ->{ localtime };
2090 push @$cmd, '-startdate' , $conf ->{ startdate
} if $conf ->{ startdate
};
2092 push @$cmd, '-S' if $conf ->{ freeze
};
2094 # set keyboard layout
2095 my $kb = $conf ->{ keyboard
} || $defaults ->{ keyboard
};
2096 push @$cmd, '-k' , $kb if $kb ;
2099 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2100 #push @$cmd, '-soundhw', 'es1370';
2101 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2102 $pciaddr = print_pci_addr
( "balloon0" );
2103 push @$cmd, '-device' , "virtio-balloon-pci,id=balloon0 $pciaddr " if $conf ->{ balloon
};
2105 if ( $conf ->{ watchdog
}) {
2106 my $wdopts = parse_watchdog
( $conf ->{ watchdog
});
2107 $pciaddr = print_pci_addr
( "watchdog" );
2108 my $watchdog = $wdopts ->{ model
} || 'i6300esb' ;
2109 push @$cmd, '-device' , " $watchdog$pciaddr " ;
2110 push @$cmd, '-watchdog-action' , $wdopts ->{ action
} if $wdopts ->{ action
};
2114 my $scsicontroller = {};
2116 foreach_drive
( $conf, sub {
2117 my ( $ds, $drive ) = @_ ;
2119 if ( PVE
:: Storage
:: parse_volume_id
( $drive ->{ file
}, 1 )) {
2120 push @$vollist, $drive ->{ file
};
2123 $use_virtio = 1 if $ds =~ m/^virtio/ ;
2125 if ( drive_is_cdrom
( $drive )) {
2126 if ( $bootindex_hash ->{ d
}) {
2127 $drive ->{ bootindex
} = $bootindex_hash ->{ d
};
2128 $bootindex_hash ->{ d
} += 1 ;
2131 if ( $bootindex_hash ->{ c
}) {
2132 $drive ->{ bootindex
} = $bootindex_hash ->{ c
} if $conf ->{ bootdisk
} && ( $conf ->{ bootdisk
} eq $ds );
2133 $bootindex_hash ->{ c
} += 1 ;
2137 if ( $drive ->{ interface
} eq 'scsi' ) {
2139 my $controller = int ( $drive ->{ index } / $maxdev );
2140 $pciaddr = print_pci_addr
( "scsi $controller " );
2141 push @$cmd, '-device' , "lsi,id=scsi $controller$pciaddr " if ! $scsicontroller ->{ $controller };
2142 $scsicontroller ->{ $controller }= 1 ;
2145 push @$cmd, '-drive' , print_drive_full
( $storecfg, $vmid, $drive );
2146 push @$cmd, '-device' , print_drivedevice_full
( $storecfg,$vmid, $drive );
2149 push @$cmd, '-m' , $conf ->{ memory
} || $defaults ->{ memory
};
2153 foreach my $k ( sort keys %$conf ) {
2154 next if $k !~ m/^net(\d+)$/ ;
2157 die "got strange net id ' $i ' \n " if $i >= ${ MAX_NETS
};
2159 if ( $conf ->{ "net $i " } && ( my $net = parse_net
( $conf ->{ "net $i " }))) {
2163 my $ifname = "tap${vmid}i $i " ;
2165 # kvm uses TUNSETIFF ioctl, and that limits ifname length
2166 die "interface name ' $ifname ' is too long (max 15 character) \n "
2167 if length ( $ifname ) >= 16 ;
2169 my $device = $net ->{ model
};
2170 my $vhostparam = '' ;
2171 if ( $net ->{ model
} eq 'virtio' ) {
2173 $device = 'virtio-net-pci' ;
2174 $vhostparam = ',vhost=on' if $kernel_has_vhost_net ;
2177 if ( $net ->{ bridge
}) {
2178 push @$cmd, '-netdev' , "type=tap,id=${k},ifname=${ifname},script=/var/lib/qemu-server/pve-bridge $vhostparam " ;
2180 push @$cmd, '-netdev' , "type=user,id=${k},hostname= $vmname " ;
2183 # qemu > 0.15 always try to boot from network - we disable that by
2184 # not loading the pxe rom file
2185 my $extra = ( $bootorder !~ m/n/ ) ?
"romfile=," : '' ;
2186 $pciaddr = print_pci_addr
( "${k}" );
2187 my $tmpstr = " $device,$ {extra}mac= $net ->{macaddr},netdev=${k} $pciaddr " ;
2188 if ( my $bootindex = $bootindex_hash ->{ n
}) {
2189 $tmpstr .= ",bootindex= $bootindex " ;
2190 $bootindex_hash ->{ n
} += 1 ;
2192 push @$cmd, '-device' , $tmpstr ;
2196 push @$cmd, '-net' , 'none' if ! $foundnet ;
2198 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2199 # when the VM uses virtio devices.
2200 if (! $use_virtio && $have_ovz ) {
2202 my $cpuunits = defined ( $conf ->{ cpuunits
}) ?
2203 $conf ->{ cpuunits
} : $defaults ->{ cpuunits
};
2205 push @$cmd, '-cpuunits' , $cpuunits if $cpuunits ;
2207 # fixme: cpulimit is currently ignored
2208 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2212 if ( $conf ->{ args
}) {
2213 my $aa = PVE
:: Tools
:: split_args
( $conf ->{ args
});
2217 return wantarray ?
( $cmd, $vollist ) : $cmd ;
2222 return "${var_run_tmpdir}/ $vmid .vnc" ;
2225 sub monitor_socket
{
2227 return "${var_run_tmpdir}/ $vmid .mon" ;
2232 return "${var_run_tmpdir}/ $vmid .pid" ;
2235 sub next_migrate_port
{
2237 for ( my $p = 60000 ; $p < 60010 ; $p++ ) {
2239 my $sock = IO
:: Socket
:: INET-
> new ( Listen
=> 5 ,
2240 LocalAddr
=> 'localhost' ,
2251 die "unable to find free migration port" ;
2254 sub vm_devices_list
{
2257 my $res = vm_monitor_command
( $vmid, "info pci" );
2259 my @lines = split ( " \n " , $res );
2265 foreach my $line ( @lines ) {
2267 if ( $line =~ m/^Bus (\d+), device (\d+), function (\d+):$/ ) {
2271 if ( $line =~ m/^id "([a-z][a-z_\-]*\d*)"$/ ) {
2273 $devices ->{ $id }->{ bus
}= $bus ;
2274 $devices ->{ $id }->{ addr
}= $addr ;
2282 my ( $storecfg, $conf, $vmid, $deviceid, $device ) = @_ ;
2283 return if ! check_running
( $vmid ) || ! $conf ->{ hotplug
} || $conf ->{ $deviceid };
2285 if ( $deviceid =~ m/^(virtio)(\d+)$/ ) {
2287 my $drive = print_drive_full
( $storecfg, $vmid, $device );
2288 my $ret = vm_monitor_command
( $vmid, "drive_add auto $drive " );
2289 # If the command succeeds qemu prints: "OK"
2290 if ( $ret !~ m/OK/s ) {
2291 die "adding drive failed: $ret " ;
2294 my $devicefull = print_drivedevice_full
( $storecfg, $vmid, $device );
2295 $ret = vm_monitor_command
( $vmid, "device_add $devicefull " );
2297 # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2298 die 'error on hotplug device : $ret ' if $ret ne "" ;
2301 for ( my $i = 0 ; $i <= 5 ; $i++ ) {
2302 my $devices_list = vm_devices_list
( $vmid );
2303 return if defined ( $devices_list ->{ $deviceid });
2307 die "error on hotplug device $deviceid " ;
2311 my ( $vmid, $conf, $deviceid ) = @_ ;
2313 return if ! check_running
( $vmid ) || ! $conf ->{ hotplug
};
2315 die "can't unplug bootdisk" if $conf ->{ bootdisk
} eq $deviceid ;
2317 if ( $deviceid =~ m/^(virtio)(\d+)$/ ){
2319 my $ret = vm_monitor_command
( $vmid, "drive_del drive- $deviceid " );
2321 if ( $ret =~ m/Device \'.*?\' not found/s ) {
2322 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2324 elsif ( $ret ne "" ) {
2325 die "deleting drive $deviceid failed : $ret " ;
2328 $ret = vm_monitor_command
( $vmid, "device_del $deviceid " );
2330 die 'detaching device $deviceid failed : $ret ' if $ret ne "" ;
2334 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2335 for ( my $i = 0 ; $i <= 5 ; $i++ ) {
2336 my $devices_list = vm_devices_list
( $vmid );
2337 return if ! defined ( $devices_list ->{ $deviceid });
2340 die "error on hot-plugging device $deviceid " ;
2346 my ( $storecfg, $vmid, $statefile, $skiplock ) = @_ ;
2348 lock_config
( $vmid, sub {
2349 my $conf = load_config
( $vmid );
2351 check_lock
( $conf ) if ! $skiplock ;
2353 die "VM $vmid already running \n " if check_running
( $vmid );
2356 my $migrate_port = 0 ;
2359 if ( $statefile eq 'tcp' ) {
2360 $migrate_port = next_migrate_port
();
2361 $migrate_uri = "tcp:localhost:${migrate_port}" ;
2363 if (- f
$statefile ) {
2364 $migrate_uri = "exec:cat $statefile " ;
2366 warn "state file ' $statefile ' does not exist - doing normal startup \n " ;
2371 my $defaults = load_defaults
();
2373 my ( $cmd, $vollist ) = config_to_command
( $storecfg, $vmid, $conf, $defaults, $migrate_uri );
2375 for ( my $i = 0 ; $i < $MAX_HOSTPCI_DEVICES ; $i++ ) {
2376 my $d = parse_hostpci
( $conf ->{ "hostpci $i " });
2378 my $info = pci_device_info
( "0000: $d ->{pciid}" );
2379 die "IOMMU not present \n " if ! check_iommu_support
();
2380 die "no pci device info for device ' $d ->{pciid}' \n " if ! $info ;
2381 die "can't unbind pci device ' $d ->{pciid}' \n " if ! pci_dev_bind_to_stub
( $info );
2382 die "can't reset pci device ' $d ->{pciid}' \n " if ! pci_dev_reset
( $info );
2385 PVE
:: Storage
:: activate_volumes
( $storecfg, $vollist );
2387 eval { run_command
( $cmd, timeout
=> $migrate_uri ?
undef : 30 ); };
2389 die "start failed: $err " if $err ;
2393 if ( $statefile eq 'tcp' ) {
2394 print "migration listens on port $migrate_port\n " ;
2397 # fixme: send resume - is that necessary ?
2398 eval { vm_monitor_command
( $vmid, "cont" ); };
2402 # always set migrate speed (overwrite kvm default of 32m)
2403 # we set a very hight default of 8192m which is basically unlimited
2404 my $migrate_speed = $defaults ->{ migrate_speed
} || 8192 ;
2405 $migrate_speed = $conf ->{ migrate_speed
} || $migrate_speed ;
2407 my $cmd = "migrate_set_speed ${migrate_speed}m" ;
2408 vm_monitor_command
( $vmid, $cmd );
2411 if ( my $migrate_downtime =
2412 $conf ->{ migrate_downtime
} || $defaults ->{ migrate_downtime
}) {
2413 my $cmd = "migrate_set_downtime ${migrate_downtime}" ;
2414 eval { vm_monitor_command
( $vmid, $cmd ); };
2417 vm_balloonset
( $vmid, $conf ->{ balloon
}) if $conf ->{ balloon
};
2422 my ( $fh, $timeout ) = @_ ;
2424 my $sel = new IO
:: Select
;
2431 while ( scalar ( @ready = $sel -> can_read ( $timeout ))) {
2433 if ( $count = $fh -> sysread ( $buf, 8192 )) {
2434 if ( $buf =~ /^(.*)\(qemu\) $/s ) {
2441 if (! defined ( $count )) {
2448 die "monitor read timeout \n " if ! scalar ( @ready );
2453 sub vm_monitor_command
{
2454 my ( $vmid, $cmdstr, $nocheck ) = @_ ;
2459 die "VM $vmid not running \n " if ! check_running
( $vmid, $nocheck );
2461 my $sname = monitor_socket
( $vmid );
2463 my $sock = IO
:: Socket
:: UNIX-
> new ( Peer
=> $sname ) ||
2464 die "unable to connect to VM $vmid socket - $!\n " ;
2468 # hack: migrate sometime blocks the monitor (when migrate_downtime
2470 if ( $cmdstr =~ m/^(info\s+migrate|migrate\s)/ ) {
2471 $timeout = 60 * 60 ; # 1 hour
2475 my $data = __read_avail
( $sock, $timeout );
2477 if ( $data !~ m/^QEMU\s+(\S+)\s+monitor\s/ ) {
2478 die "got unexpected qemu monitor banner \n " ;
2481 my $sel = new IO
:: Select
;
2484 if (! scalar ( my @ready = $sel -> can_write ( $timeout ))) {
2485 die "monitor write error - timeout" ;
2488 my $fullcmd = " $cmdstr\r " ;
2491 if (!( $b = $sock -> syswrite ( $fullcmd )) || ( $b != length ( $fullcmd ))) {
2492 die "monitor write error - $! " ;
2495 return if ( $cmdstr eq 'q' ) || ( $cmdstr eq 'quit' );
2499 if ( $cmdstr =~ m/^(info\s+migrate|migrate\s)/ ) {
2500 $timeout = 60 * 60 ; # 1 hour
2501 } elsif ( $cmdstr =~ m/^(eject|change)/ ) {
2502 $timeout = 60 ; # note: cdrom mount command is slow
2504 if ( $res = __read_avail
( $sock, $timeout )) {
2506 my @lines = split ( " \r ? \n " , $res );
2508 shift @lines if $lines [ 0 ] !~ m/^unknown command/ ; # skip echo
2510 $res = join ( " \n " , @lines );
2518 syslog
( "err" , "VM $vmid monitor command failed - $err " );
2525 sub vm_commandline
{
2526 my ( $storecfg, $vmid ) = @_ ;
2528 my $conf = load_config
( $vmid );
2530 my $defaults = load_defaults
();
2532 my $cmd = config_to_command
( $storecfg, $vmid, $conf, $defaults );
2534 return join ( ' ' , @$cmd );
2538 my ( $vmid, $skiplock ) = @_ ;
2540 lock_config
( $vmid, sub {
2542 my $conf = load_config
( $vmid );
2544 check_lock
( $conf ) if ! $skiplock ;
2546 vm_monitor_command
( $vmid, "system_reset" );
2550 sub get_vm_volumes
{
2554 foreach_drive
( $conf, sub {
2555 my ( $ds, $drive ) = @_ ;
2557 my ( $sid, $volname ) = PVE
:: Storage
:: parse_volume_id
( $drive ->{ file
}, 1 );
2560 my $volid = $drive ->{ file
};
2561 return if ! $volid || $volid =~ m
|^/|;
2563 push @$vollist, $volid ;
2569 sub vm_stop_cleanup
{
2570 my ( $storecfg, $vmid, $conf ) = @_ ;
2572 fairsched_rmnod
( $vmid ); # try to destroy group
2574 my $vollist = get_vm_volumes
( $conf );
2575 PVE
:: Storage
:: deactivate_volumes
( $storecfg, $vollist );
2578 # Note: use $nockeck to skip tests if VM configuration file exists.
2579 # We need that when migration VMs to other nodes (files already moved)
2581 my ( $storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force ) = @_ ;
2583 $timeout = 60 if ! defined ( $timeout );
2585 $force = 1 if ! defined ( $force ) && ! $shutdown ;
2587 lock_config
( $vmid, sub {
2589 my $pid = check_running
( $vmid, $nocheck );
2594 $conf = load_config
( $vmid );
2595 check_lock
( $conf ) if ! $skiplock ;
2600 vm_monitor_command
( $vmid, "system_powerdown" , $nocheck );
2602 vm_monitor_command
( $vmid, "quit" , $nocheck );
2609 while (( $count < $timeout ) && check_running
( $vmid, $nocheck )) {
2614 if ( $count >= $timeout ) {
2616 warn "VM still running - terminating now with SIGTERM \n " ;
2619 die "VM quit/powerdown failed - got timeout \n " ;
2622 vm_stop_cleanup
( $storecfg, $vmid, $conf ) if $conf ;
2627 warn "VM quit/powerdown failed - terminating now with SIGTERM \n " ;
2630 die "VM quit/powerdown failed \n " ;
2638 while (( $count < $timeout ) && check_running
( $vmid, $nocheck )) {
2643 if ( $count >= $timeout ) {
2644 warn "VM still running - terminating now with SIGKILL \n " ;
2649 vm_stop_cleanup
( $storecfg, $vmid, $conf ) if $conf ;
2654 my ( $vmid, $skiplock ) = @_ ;
2656 lock_config
( $vmid, sub {
2658 my $conf = load_config
( $vmid );
2660 check_lock
( $conf ) if ! $skiplock ;
2662 vm_monitor_command
( $vmid, "stop" );
2667 my ( $vmid, $skiplock ) = @_ ;
2669 lock_config
( $vmid, sub {
2671 my $conf = load_config
( $vmid );
2673 check_lock
( $conf ) if ! $skiplock ;
2675 vm_monitor_command
( $vmid, "cont" );
2680 my ( $vmid, $skiplock, $key ) = @_ ;
2682 lock_config
( $vmid, sub {
2684 my $conf = load_config
( $vmid );
2686 vm_monitor_command
( $vmid, "sendkey $key " );
2691 my ( $storecfg, $vmid, $skiplock ) = @_ ;
2693 lock_config
( $vmid, sub {
2695 my $conf = load_config
( $vmid );
2697 check_lock
( $conf ) if ! $skiplock ;
2699 if (! check_running
( $vmid )) {
2700 fairsched_rmnod
( $vmid ); # try to destroy group
2701 destroy_vm
( $storecfg, $vmid );
2703 die "VM $vmid is running - destroy failed \n " ;
2709 my ( $storecfg, $timeout ) = @_ ;
2711 $timeout = 3 * 60 if ! $timeout ;
2713 my $cleanuphash = {};
2715 my $vzlist = vzlist
();
2717 foreach my $vmid ( keys %$vzlist ) {
2718 next if ! $vzlist ->{ $vmid }->{ pid
};
2720 $cleanuphash ->{ $vmid } = 1 ;
2725 my $msg = "Stopping Qemu Server - sending shutdown requests to all VMs \n " ;
2726 syslog
( 'info' , $msg );
2729 foreach my $vmid ( keys %$vzlist ) {
2730 next if ! $vzlist ->{ $vmid }->{ pid
};
2731 eval { vm_monitor_command
( $vmid, "system_powerdown" ); };
2736 my $maxtries = int (( $timeout + $wt - 1 )/ $wt );
2738 while (( $try < $maxtries ) && $count ) {
2744 foreach my $vmid ( keys %$vzlist ) {
2745 next if ! $vzlist ->{ $vmid }->{ pid
};
2753 foreach my $vmid ( keys %$vzlist ) {
2754 next if ! $vzlist ->{ $vmid }->{ pid
};
2756 warn "VM $vmid still running - sending stop now \n " ;
2757 eval { vm_monitor_command
( $vmid, "quit" ); };
2762 $maxtries = int (( $timeout + $wt - 1 )/ $wt );
2764 while (( $try < $maxtries ) && $count ) {
2770 foreach my $vmid ( keys %$vzlist ) {
2771 next if ! $vzlist ->{ $vmid }->{ pid
};
2779 foreach my $vmid ( keys %$vzlist ) {
2780 next if ! $vzlist ->{ $vmid }->{ pid
};
2782 warn "VM $vmid still running - terminating now with SIGTERM \n " ;
2783 kill 15 , $vzlist ->{ $vmid }->{ pid
};
2788 # this is called by system shotdown scripts, so remaining
2789 # processes gets killed anyways (no need to send kill -9 here)
2793 foreach my $vmid ( keys %$cleanuphash ) {
2794 next if $vzlist ->{ $vmid }->{ pid
};
2796 my $conf = load_config
( $vmid );
2797 vm_stop_cleanup
( $storecfg, $vmid, $conf );
2802 $msg = "Qemu Server stopped \n " ;
2803 syslog
( 'info' , $msg );
2810 my ( $filename, $buf ) = @_ ;
2812 my $fh = IO
:: File-
> new ( $filename, "w" );
2813 return undef if ! $fh ;
2815 my $res = print $fh $buf ;
2822 sub pci_device_info
{
2827 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/ ;
2828 my ( $domain, $bus, $slot, $func ) = ( $1, $2, $3, $4 );
2830 my $irq = file_read_firstline
( " $pcisysfs/devices/$name/irq " );
2831 return undef if ! defined ( $irq ) || $irq !~ m/^\d+$/ ;
2833 my $vendor = file_read_firstline
( " $pcisysfs/devices/$name/vendor " );
2834 return undef if ! defined ( $vendor ) || $vendor !~ s/^0x// ;
2836 my $product = file_read_firstline
( " $pcisysfs/devices/$name/device " );
2837 return undef if ! defined ( $product ) || $product !~ s/^0x// ;
2842 product
=> $product,
2848 has_fl_reset
=> - f
" $pcisysfs/devices/$name/reset " || 0 ,
2857 my $name = $dev ->{ name
};
2859 my $fn = " $pcisysfs/devices/$name/reset " ;
2861 return file_write
( $fn, "1" );
2864 sub pci_dev_bind_to_stub
{
2867 my $name = $dev ->{ name
};
2869 my $testdir = " $pcisysfs/drivers/pci -stub/ $name " ;
2870 return 1 if - d
$testdir ;
2872 my $data = " $dev ->{vendor} $dev ->{product}" ;
2873 return undef if ! file_write
( " $pcisysfs/drivers/pci -stub/new_id" , $data );
2875 my $fn = " $pcisysfs/devices/$name/driver/unbind " ;
2876 if (! file_write
( $fn, $name )) {
2877 return undef if - f
$fn ;
2880 $fn = " $pcisysfs/drivers/pci -stub/bind" ;
2881 if (! - d
$testdir ) {
2882 return undef if ! file_write
( $fn, $name );
2888 sub print_pci_addr
{
2893 #addr1 : ide,parallel,serial (motherboard)
2894 #addr2 : first videocard
2895 balloon0
=> { bus
=> 0 , addr
=> 3 },
2896 watchdog
=> { bus
=> 0 , addr
=> 4 },
2897 scsi0
=> { bus
=> 0 , addr
=> 5 },
2898 scsi1
=> { bus
=> 0 , addr
=> 6 },
2899 virtio0
=> { bus
=> 0 , addr
=> 10 },
2900 virtio1
=> { bus
=> 0 , addr
=> 11 },
2901 virtio2
=> { bus
=> 0 , addr
=> 12 },
2902 virtio3
=> { bus
=> 0 , addr
=> 13 },
2903 virtio4
=> { bus
=> 0 , addr
=> 14 },
2904 virtio5
=> { bus
=> 0 , addr
=> 15 },
2905 hostpci0
=> { bus
=> 0 , addr
=> 16 },
2906 hostpci1
=> { bus
=> 0 , addr
=> 17 },
2907 net0
=> { bus
=> 0 , addr
=> 18 },
2908 net1
=> { bus
=> 0 , addr
=> 19 },
2909 net2
=> { bus
=> 0 , addr
=> 20 },
2910 net3
=> { bus
=> 0 , addr
=> 21 },
2911 net4
=> { bus
=> 0 , addr
=> 22 },
2912 net5
=> { bus
=> 0 , addr
=> 23 },
2913 #addr29 : usb-host (pve-usb.cfg)
2916 if ( defined ( $devices ->{ $id }->{ bus
}) && defined ( $devices ->{ $id }->{ addr
})) {
2917 my $addr = sprintf ( "0x %x " , $devices ->{ $id }->{ addr
});
2918 $res = ",bus=pci. $devices ->{ $id }->{bus},addr= $addr " ;
2925 my ( $vmid, $value ) = @_ ;
2927 vm_monitor_command
( $vmid, "balloon $value " );
2930 # vzdump restore implementaion
2932 sub archive_read_firstfile
{
2933 my $archive = shift ;
2935 die "ERROR: file ' $archive ' does not exist \n " if ! - f
$archive ;
2937 # try to detect archive type first
2938 my $pid = open ( TMP
, "tar tf ' $archive '|" ) ||
2939 die "unable to open file ' $archive ' \n " ;
2940 my $firstfile = < TMP
>;
2944 die "ERROR: archive contaions no data \n " if ! $firstfile ;
2950 sub restore_cleanup
{
2951 my $statfile = shift ;
2953 print STDERR
"starting cleanup \n " ;
2955 if ( my $fd = IO
:: File-
> new ( $statfile, "r" )) {
2956 while ( defined ( my $line = < $fd >)) {
2957 if ( $line =~ m/vzdump:([^\s:]*):(\S+)$/ ) {
2960 if ( $volid =~ m
|^/|) {
2961 unlink $volid || die 'unlink failed \n ' ;
2963 my $cfg = cfs_read_file
( 'storage.cfg' );
2964 PVE
:: Storage
:: vdisk_free
( $cfg, $volid );
2966 print STDERR
"temporary volume ' $volid ' sucessfuly removed \n " ;
2968 print STDERR
"unable to cleanup ' $volid ' - $@ " if $@ ;
2970 print STDERR
"unable to parse line in statfile - $line " ;
2977 sub restore_archive
{
2978 my ( $archive, $vmid, $opts ) = @_ ;
2980 if ( $archive ne '-' ) {
2981 my $firstfile = archive_read_firstfile
( $archive );
2982 die "ERROR: file ' $archive ' dos not lock like a QemuServer vzdump backup \n "
2983 if $firstfile ne 'qemu-server.conf' ;
2986 my $tocmd = "/usr/lib/qemu-server/qmextract" ;
2988 $tocmd .= " --storage " . PVE
:: Tools
:: shellquote
( $opts ->{ storage
}) if $opts ->{ storage
};
2989 $tocmd .= ' --prealloc' if $opts ->{ prealloc
};
2990 $tocmd .= ' --info' if $opts ->{ info
};
2992 # tar option "xf" does not autodetect compression when read fron STDIN,
2993 # so we pipe to zcat
2994 my $cmd = "zcat -f|tar xf " . PVE
:: Tools
:: shellquote
( $archive ) . " " .
2995 PVE
:: Tools
:: shellquote
( "--to-command= $tocmd " );
2997 my $tmpdir = "/var/tmp/vzdumptmp $$ " ;
3000 local $ENV { VZDUMP_TMPDIR
} = $tmpdir ;
3001 local $ENV { VZDUMP_VMID
} = $vmid ;
3003 my $conffile = PVE
:: QemuServer
:: config_file
( $vmid );
3004 my $tmpfn = " $conffile . $$ .tmp" ;
3006 # disable interrupts (always do cleanups)
3007 local $SIG { INT
} = $SIG { TERM
} = $SIG { QUIT
} = $SIG { HUP
} = sub {
3008 print STDERR
"got interrupt - ignored \n " ;
3013 local $SIG { INT
} = $SIG { TERM
} = $SIG { QUIT
} = $SIG { HUP
} = $SIG { PIPE
} = sub {
3014 die "interrupted by signal \n " ;
3017 if ( $archive eq '-' ) {
3018 print "extracting archive from STDIN \n " ;
3019 run_command
( $cmd, input
=> "<&STDIN" );
3021 print "extracting archive ' $archive ' \n " ;
3025 return if $opts ->{ info
};
3029 my $statfile = " $tmpdir/qmrestore .stat" ;
3030 if ( my $fd = IO
:: File-
> new ( $statfile, "r" )) {
3031 while ( defined ( my $line = < $fd >)) {
3032 if ( $line =~ m/vzdump:([^\s:]*):(\S+)$/ ) {
3033 $map ->{ $1 } = $2 if $1 ;
3035 print STDERR
"unable to parse line in statfile - $line\n " ;
3041 my $confsrc = " $tmpdir/qemu -server.conf" ;
3043 my $srcfd = new IO
:: File
( $confsrc, "r" ) ||
3044 die "unable to open file ' $confsrc ' \n " ;
3046 my $outfd = new IO
:: File
( $tmpfn, "w" ) ||
3047 die "unable to write config for VM $vmid\n " ;
3051 while ( defined ( my $line = < $srcfd >)) {
3052 next if $line =~ m/^\#vzdump\#/ ;
3053 next if $line =~ m/^lock:/ ;
3054 next if $line =~ m/^unused\d+:/ ;
3056 if (( $line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/ )) {
3057 # try to convert old 1.X settings
3058 my ( $id, $ind, $ethcfg ) = ( $1, $2, $3 );
3059 foreach my $devconfig ( PVE
:: Tools
:: split_list
( $ethcfg )) {
3060 my ( $model, $macaddr ) = split ( /\=/ , $devconfig );
3061 $macaddr = PVE
:: Tools
:: random_ether_addr
() if ! $macaddr || $opts ->{ unique
};
3064 bridge
=> "vmbr $ind " ,
3065 macaddr
=> $macaddr,
3067 my $netstr = print_net
( $net );
3068 print $outfd "net${netcount}: $netstr\n " ;
3071 } elsif (( $line =~ m/^(net\d+):\s*(\S+)\s*$/ ) && ( $opts ->{ unique
})) {
3072 my ( $id, $netstr ) = ( $1, $2 );
3073 my $net = parse_net
( $netstr );
3074 $net ->{ macaddr
} = PVE
:: Tools
:: random_ether_addr
() if $net ->{ macaddr
};
3075 $netstr = print_net
( $net );
3076 print $outfd " $id : $netstr\n " ;
3077 } elsif ( $line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/ ) {
3080 if ( $line =~ m/backup=no/ ) {
3081 print $outfd "# $line " ;
3082 } elsif ( $virtdev && $map ->{ $virtdev }) {
3083 my $di = PVE
:: QemuServer
:: parse_drive
( $virtdev, $value );
3084 $di ->{ file
} = $map ->{ $virtdev };
3085 $value = PVE
:: QemuServer
:: print_drive
( $vmid, $di );
3086 print $outfd " $virtdev : $value\n " ;
3104 restore_cleanup
( " $tmpdir/qmrestore .stat" ) if ! $opts ->{ info
};
3111 rename $tmpfn, $conffile ||
3112 die "unable to commit configuration file ' $conffile ' \n " ;