mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-10-31 19:32:31 +00:00 
			
		
		
		
	git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@16536 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			3016 lines
		
	
	
		
			109 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			3016 lines
		
	
	
		
			109 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| #!/usr/bin/env perl
 | |
| # IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
 | |
| package xCAT_plugin::kvm;
 | |
| BEGIN
 | |
| {
 | |
|   $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
 | |
| }
 | |
| use lib "$::XCATROOT/lib/perl";
 | |
| use xCAT::GlobalDef;
 | |
| use xCAT::NodeRange;
 | |
| use xCAT::VMCommon;
 | |
| use xCAT_monitoring::monitorctrl;
 | |
| 
 | |
| use xCAT::Table;
 | |
| use xCAT::Usage;
 | |
| use XML::LibXML; #now that we are in the business of modifying xml data, need something capable of preserving more of the XML structure
 | |
| #TODO: convert all uses of XML::Simple to LibXML?  Using both seems wasteful in a way..
 | |
| use XML::Simple qw(XMLout);
 | |
| use Thread qw(yield);
 | |
| use xCAT::Utils qw/genpassword/;
 | |
| use File::Basename qw/fileparse/;
 | |
| use File::Path qw/mkpath/;
 | |
| use IO::Socket;
 | |
| use IO::Select;
 | |
| use xCAT::TableUtils;
 | |
| use xCAT::ServiceNodeUtils;
 | |
| use strict;
 | |
| #use warnings;
 | |
| my $use_xhrm=0; #xCAT Hypervisor Resource Manager, to satisfy networking and storage prerequisites, default to not using it for the moment
 | |
| my $imgfmt='raw'; #use raw format by default
 | |
| my $clonemethod='qemu-img'; #use qemu-img command
 | |
| my %vm_comm_pids;
 | |
| my %offlinehyps;
 | |
| my %hypstats;
 | |
| my %offlinevms;
 | |
| my $parser;
 | |
| my @destblacklist;
 | |
| my $updatetable; #when a function is performing per-node operations, it can queue up a table update by populating parts of this hash
 | |
| my $confdata; #a reference to serve as a common pointer betweer VMCommon functions and this plugin
 | |
| my $libvirtsupport;
 | |
| $libvirtsupport = eval { 
 | |
|     require Sys::Virt; 
 | |
|     if (Sys::Virt->VERSION =~ /^0\.[10]\./) {
 | |
|         die;
 | |
|     }
 | |
|     1;
 | |
| };
 | |
| 
 | |
| use XML::Simple;
 | |
| $XML::Simple::PREFERRED_PARSER='XML::Parser';
 | |
| use Data::Dumper;
 | |
| use POSIX "WNOHANG";
 | |
| use Storable qw(freeze thaw store_fd fd_retrieve);
 | |
| use IO::Select;
 | |
| use IO::Handle;
 | |
| use Time::HiRes qw(gettimeofday sleep);
 | |
| use xCAT::DBobjUtils;
 | |
| use Getopt::Long;
 | |
| use xCAT::SvrUtils;
 | |
| 
 | |
| my %runningstates;
 | |
| my $vmmaxp=64;
 | |
| my $mactab;
 | |
| my %usedmacs;
 | |
| my $status_noop="XXXno-opXXX";
 | |
| my $callback;
 | |
| my $requester; #used to track the user
 | |
| 
 | |
| sub handled_commands {
 | |
|   #unless ($libvirtsupport) {
 | |
|   #    return {};
 | |
|   #}
 | |
|   return {
 | |
|     rpower => 'nodehm:power,mgt',
 | |
|     mkvm => 'nodehm:power,mgt',
 | |
|     clonevm => 'nodehm:power,mgt',
 | |
|     chvm => 'nodehm:power,mgt',
 | |
|     rmvm => 'nodehm:power,mgt',
 | |
|     rinv => 'nodehm:power,mgt',
 | |
|     rmigrate => 'nodehm:mgt',
 | |
|     getcons => 'nodehm:mgt',
 | |
|     #rvitals => 'nodehm:mgt',
 | |
|     #rinv => 'nodehm:mgt',
 | |
|     getrvidparms => 'nodehm:mgt',
 | |
|     lsvm => 'hypervisor:type',
 | |
|     rbeacon => 'nodehm:mgt',
 | |
|     revacuate => 'hypervisor:type',
 | |
|     vmstatenotify => 'hypervisor:type',
 | |
|     #rspreset => 'nodehm:mgt',
 | |
|     #rspconfig => 'nodehm:mgt',
 | |
|     #rbootseq => 'nodehm:mgt',
 | |
|     #reventlog => 'nodehm:mgt',
 | |
|   };
 | |
| }
 | |
| 
 | |
| my $hypconn;
 | |
| my $hyp;
 | |
| my $doreq;
 | |
| my %hyphash;
 | |
| my $node;
 | |
| my $vmtab;
 | |
| 
 | |
| 
 | |
| sub get_path_for_pool {
 | |
|     my $poolobj =shift;
 | |
|     my $poolxml = $poolobj->get_xml_description();
 | |
|     my $pooldom = $parser->parse_string($poolxml);
 | |
|     my @paths = $pooldom->findnodes("/pool/target/path/text()");
 | |
|     if (scalar @paths != 1) {
 | |
|         return undef;
 | |
|     }
 | |
|     return $paths[0]->data;
 | |
| }
 | |
| sub build_pool_xml {
 | |
|     my $url = shift;
 | |
|     my $pooldesc;
 | |
|     my $name=$url;
 | |
|     $name=~ s!nfs://!nfs_!;
 | |
|     $name=~ s!dir://!dir_!;
 | |
|     $name=~ s!lvm://!lvm_!;
 | |
|     $name =~ s/\//_/g; #though libvirt considers / kosher, sometimes it wants to create a local xml file using name for filename...
 | |
|     if ($url =~ /^dir:/) { #directory style..
 | |
| 	my $path=$url;
 | |
| 	$path =~ s/dir:\/\///g;
 | |
| 	return "<pool type=\"dir\"><name>$name</name><target><path>$path</path></target></pool>";
 | |
|     } elsif ($url =~ /^lvm:\/\//) { #lvm specified
 | |
|     	my $path = $url;
 | |
| 	$path =~ s/^lvm:\/\///;
 | |
| 	$path =~ s/:(.*)\z//;
 | |
| 	my $volumes = $1;
 | |
| 	my $mount = "/dev/$path";
 | |
| 	my $xml = '<pool type="logical"><name>'.$path.'</name><target><path>'.$mount.'</path></target>';
 | |
| 	if ($volumes) {
 | |
| 		$xml .= "<source>";
 | |
| 		my @vols = split /,/,$volumes;
 | |
| 		foreach (@vols) {
 | |
| 			$xml .= '<device path="'.$_.'"/>';
 | |
| 		}
 | |
| 		$xml .= "</source>";
 | |
| 	}
 | |
| 	$xml .= "</pool>";
 | |
| 	return $xml;
 | |
|     }
 | |
|     my $mounthost = shift;
 | |
|     unless ($mounthost) { $mounthost = $hyp; }
 | |
|     my $pool;
 | |
|     my $host = $url;
 | |
|     $host =~ s/.*:\/\///;
 | |
|     $host =~ s/(\/.*)//;
 | |
|     my $srcpath = $1;
 | |
|     my $uuid = xCAT::Utils::genUUID(url=>$url);
 | |
| #first, we make a pool desc that won't have slashes in them
 | |
|     $pooldesc = '<pool type="netfs">';
 | |
|     $pooldesc .= '<name>'.$name.'</name>';
 | |
|     $pooldesc .= '<uuid>'.$uuid.'</uuid>>';
 | |
|     $pooldesc .= '<source>';
 | |
|     $pooldesc .= '<host name="'.$host.'"/>';
 | |
|     $pooldesc .= '<dir path="'.$srcpath.'"/>';
 | |
|     $pooldesc .= '</source>';
 | |
|     $pooldesc .= '<target><path>/var/lib/xcat/pools/'.$uuid.'</path></target></pool>';
 | |
|     #turns out we can 'define', then 'build', then 'create' on the poolobj instead of 'create', to get mkdir -p like function
 | |
|     #system("ssh $mounthost mkdir -p /var/lib/xcat/pools/$uuid"); #ok, so not *technically* just building XML, but here is the cheapest
 | |
|                                                             #place to know uuid...  And yes, we must be allowed to ssh in
 | |
|                                                             #libvirt just isn't capable enough for this sort of usage
 | |
|     return $pooldesc;
 | |
| }
 | |
| 
 | |
| 
 | |
| 
 | |
| sub get_storage_pool_by_url {
 | |
|     my $url = shift;
 | |
|     my $virtconn = shift;
 | |
|     my $mounthost = shift;
 | |
|     unless ($virtconn) { $virtconn = $hypconn; }
 | |
|     my @currpools = $virtconn->list_storage_pools();
 | |
|     push @currpools,$virtconn->list_defined_storage_pools();
 | |
|     my $poolobj;
 | |
|     my $pool;
 | |
|     my $islvm=0;
 | |
|     foreach my $poolo (@currpools) {
 | |
|         $poolobj = $poolo;
 | |
|         $pool = $parser->parse_string($poolobj->get_xml_description()); #XMLin($poolobj->get_xml_description());
 | |
|         if ($url =~ /^nfs:\/\/([^\/]*)(\/.*)$/) { #check the essence of the pool rather than the name
 | |
|             my $host=$1;
 | |
|             my $path=$2;
 | |
|             unless ($pool->findnodes("/pool")->[0]->getAttribute("type") eq "netfs") {
 | |
|                 $pool=undef;
 | |
|                 next;
 | |
|             }
 | |
|             #ok, it is netfs, now check source..
 | |
|             my $checkhost = $pool->findnodes("/pool/source/host")->[0]->getAttribute("name");
 | |
|             my $checkpath = $pool->findnodes("/pool/source/dir")->[0]->getAttribute("path");
 | |
|             if ($checkhost eq $host and $checkpath eq $path) { #TODO: check name resolution to see if they match really even if not strictly the same
 | |
|                 last;
 | |
|             }
 | |
|         } elsif ($url =~ /^dir:\/\/(.*)\z/) {  #a directory, simple enough
 | |
| 	    my $path = $1;
 | |
|             unless ($path =~ /^\//) {
 | |
| 		$path = '/'.$path;
 | |
| 	    }
 | |
| 	    $path =~ s/\/\z//; #delete trailing / if table specifies, a perfectly understable 'mistake'
 | |
| 	    my $checkpath = $pool->findnodes("/pool/target/path/text()")->[0]->data;
 | |
| 	    if ($checkpath eq $path) {
 | |
| 		last;
 | |
|             }
 | |
| 	} elsif ($url =~ /^lvm:\/\/([^:]*)/) { #lvm volume group....
 | |
| 	    my $vgname = $1;
 | |
| 	    my $checkname = $pool->findnodes("/pool/name/text()")->[0]->data;
 | |
| 	    if ($checkname eq $vgname) {
 | |
| 		$islvm=1;
 | |
| 	    	last;
 | |
| 	    }
 | |
|         } elsif ($pool->findnodes('/pool/name/text()')->[0]->data eq $url) { #$pool->{name} eq $url) {
 | |
|             last;
 | |
|         }
 | |
|         $pool = undef;
 | |
|     }
 | |
|     if ($pool) { 
 | |
|         my $inf=$poolobj->get_info();
 | |
|         if ($inf->{state} == 0) { #Sys::Virt::StoragePool::STATE_INACTIVE) { #if pool is currently inactive, bring it up
 | |
|             unless ($islvm) { $poolobj->build(); } #if lvm and defined, it's almost certainly been built
 | |
|             $poolobj->create();
 | |
|         }
 | |
| 	eval { #we *try* to do this, but various things may interfere.
 | |
| 		#this is basically to make sure the list of contents is up to date
 | |
|         	$poolobj->refresh();
 | |
| 	};
 | |
|         return $poolobj; 
 | |
|     }
 | |
|     $poolobj = $virtconn->define_storage_pool(build_pool_xml($url,$mounthost));
 | |
|     eval { $poolobj->build(); };
 | |
|     if ($@) { 
 | |
|     	my $error = $@;
 | |
| 	unless ($error =~ /vgcreate.*exit status 3/ or $error =~ /pvcreate.*exit status 5/) { 
 | |
| 		die $@;
 | |
| 	}
 | |
|     }
 | |
|     $poolobj->create();
 | |
|     eval { #wrap in eval, not likely to fail here, but calling it at all may be superfluous anyway
 | |
|     	$poolobj->refresh();
 | |
|     };
 | |
|     return $poolobj;
 | |
| }
 | |
| 
 | |
| sub get_multiple_paths_by_url {
 | |
|     my %args =@_;
 | |
|     my $url = $args{url};
 | |
|     my $node = $args{node};
 | |
|     my $poolobj = get_storage_pool_by_url($url);
 | |
|     unless ($poolobj) { die "Cound not get storage pool for $url"; }
 | |
|     eval { #refresh() can 'die' if cloning in progress, accept stale data then
 | |
|     	$poolobj->refresh(); #if volumes change on nfs storage, libvirt is too dumb to notice
 | |
|     };
 | |
|     my @volobjs = $poolobj->list_volumes();
 | |
|     my %paths;
 | |
|     foreach (@volobjs) {
 | |
|         if ($_->get_name() =~ /^$node\.([^\.]*)\.([^\.]*)$/) {
 | |
|             $paths{$_->get_path()} = {device=>$1,format=>$2};
 | |
|         } elsif ($_->get_name() =~ /^$node\.([^\.]*)$/) {
 | |
|              $paths{$_->get_path()} = {device=>$1,format=>'raw'}; 
 | |
|              #this requires any current user of qcow2 to migrate, unfortunate to escape
 | |
|              #a vulnerability where raw user could write malicious qcow2 to header
 | |
|              #and use that to get at files on the hypervisor os with escalated privilege
 | |
|         }
 | |
|     }
 | |
|     return \%paths;
 | |
| }
 | |
| sub get_filepath_by_url { #at the end of the day, the libvirt storage api gives the following capability:
 | |
|                           #mount, limited ls, and qemu-img
 | |
|                           #it does not frontend mkdir, and does not abstract away any nitty-gritty detail, you must know:
 | |
|                           #the real mountpoint, and the real full path to storage
 | |
|                           #in addition to this, subdirectories are not allowed, and certain extra metadata must be created
 | |
|                           #not a big fan compared to ssh and run the commands myself, but it's the most straightforward path
 | |
|                           #to avoid ssh for users who dislike that style access
 | |
|     my %args = @_;
 | |
|     my $url = $args{url};
 | |
|     my $dev = $args{dev};
 | |
|     my $create = $args{create};
 | |
|     my $force = $args{force};
 | |
|     my $format = $args{format};
 | |
|     if ($url =~ /^lvm:/) {
 | |
| 	$format = 'raw';
 | |
|     }
 | |
|     unless ($format) {
 | |
|         $format = 'qcow2';
 | |
|     }
 | |
|     #print "url=$url, dev=$dev,create=$create, force=$force, format=$format\n";
 | |
|     #ok, now that we have the pool, we need the storage volume from the pool for the node/dev
 | |
|     my $poolobj = get_storage_pool_by_url($url);
 | |
|     unless ($poolobj) { die "Could not get storage pool for $url"; }
 | |
|     eval { #make a refresh attempt non-fatal to fail, since cloning can block it
 | |
|     	$poolobj->refresh(); #if volumes change on nfs storage, libvirt is too dumb to notice
 | |
|     };
 | |
|     my @volobjs = $poolobj->list_volumes();
 | |
|     my $desiredname = $node.'.'.$dev.'.'.$format;
 | |
|     #print "desiredname=$desiredname, volobjs=@volobjs\n";
 | |
|     foreach (@volobjs) {
 | |
|         if ($_->get_name() eq $desiredname) {
 | |
|             if ($create) {
 | |
|                 if ($force) { #must destroy the storage
 | |
|                     $_->delete();
 | |
|                 } else {
 | |
|                     die "Path already exists";
 | |
|                 }
 | |
|             } else {
 | |
|                 return $_->get_path();
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     if ($create) { 
 | |
|         if ($create =~ /^clone=(.*)$/) {
 | |
|             my $src = $1;
 | |
|             my $fmt='raw';
 | |
|             if ($src =~ /\.qcow2$/) {
 | |
|                 $fmt='qcow2';
 | |
|             }
 | |
|             my $vol = $poolobj->create_volume("<volume><name>".$desiredname."</name><target><format type='$format'/></target><capacity>100</capacity><backingStore><path>$src</path><format type='$fmt'/></backingStore></volume>");
 | |
|             #ok, this is simply hinting, not the real deal, so to speak
 | |
|             #  1)  sys::virt complains if capacity isn't defined.  We say '100', knowing full well it will be promptly ignored down the code.  This is aggravating
 | |
|             #      and warrants recheck with the RHEL6 stack
 | |
|             #  2) create_volume with backingStore is how we do the clone from master (i.e. a thin clone, a la qemu-img create)
 | |
|             #     note how backing store is full path, allowing cross-pool clones
 | |
|             #  3) clone_volume is the way to invoke qemu-img convert (i.e. to 'promote' and flatten a vm image to a standalone duplicate volume
 | |
|             #     incidentally, promote to master will be relatively expensive compared to the converse operation, as expected
 | |
|             #     will have to verify as it is investigated whether this can successfully cross pools (hope so)
 | |
|             #  4) qemu-img was so much more transparent and easy to figure out than this
 | |
|             #  additionally, when mastering a powered down node, we should rebase the node to be a cow clone of the master it just spawned
 | |
|         } else {
 | |
| 	    my $vol;
 | |
| 	    if ($format eq 'raw') { #skip allocation specification for now
 | |
| 	       #currently, LV can have reduced allocation, but *cannot* grow.....
 | |
|                $vol = $poolobj->create_volume("<volume><name>".$desiredname."</name><target><format type='$format'/></target><capacity>".getUnits($create,"G",1)."</capacity></volume>");
 | |
| 	    } else {
 | |
|             	$vol = $poolobj->create_volume("<volume><name>".$desiredname."</name><target><format type='$format'/></target><capacity>".getUnits($create,"G",1)."</capacity><allocation>0</allocation></volume>");
 | |
| 	    }
 | |
|             if ($vol) { return $vol->get_path(); }
 | |
|         }
 | |
|     } else {
 | |
|         return undef;
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub nodesockopen {
 | |
|    my $node = shift;
 | |
|    my $port = shift;
 | |
|    unless ($node) { return 0; }
 | |
|    my $socket;
 | |
|    my $addr = gethostbyname($node);
 | |
|    my $sin = sockaddr_in($port,$addr);
 | |
|    my $proto = getprotobyname('tcp');
 | |
|    socket($socket,PF_INET,SOCK_STREAM,$proto) || return 0;
 | |
|    connect($socket,$sin) || return 0;
 | |
|    return 1;
 | |
| }
 | |
| 
 | |
| 
 | |
|         
 | |
| sub waitforack {
 | |
|     my $sock = shift;
 | |
|     my $select = new IO::Select;
 | |
|     $select->add($sock);
 | |
|     my $str;
 | |
|     if ($select->can_read(60)) { # Continue after 10 seconds, even if not acked...
 | |
|         if ($str = <$sock>) {
 | |
|         } else {
 | |
|            $select->remove($sock); #Block until parent acks data
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub reconfigvm {
 | |
|     $node=shift;
 | |
|     my $xml = shift;
 | |
|     my $domdesc = $parser->parse_string($xml);
 | |
|     my @bootdevs = $domdesc->findnodes("/domain/os/boot");
 | |
|     my $curroffset = $domdesc->findnodes("/domain/clock")->[0]->getAttribute("offset");
 | |
|     my $newoffset;
 | |
|     my $needfixin=0;
 | |
|     if (defined ($confdata->{vm}->{$node}->[0]->{clockoffset})) {
 | |
|         #If user requested a specific behavior, give it
 | |
| 	$newoffset = $confdata->{vm}->{$node}->[0]->{clockoffset};
 | |
|     } else {
 | |
|         #Otherwise, only do local time for things that look MS
 | |
|         if (defined ($confdata->{nodetype}->{$node}->[0]->{os}) and $confdata->{nodetype}->{$node}->[0]->{os} =~ /win.*/) {
 | |
| 	    $newoffset = 'localtime';
 | |
|         } else { #For everyone else, utc is preferred generally
 | |
| 	    $newoffset = 'utc';
 | |
|         }
 | |
|     }
 | |
|     if ($curroffset ne $newoffset) {
 | |
| 	$needfixin=1;
 | |
| 	$domdesc->findnodes("/domain/clock")->[0]->setAttribute("offset",$newoffset);
 | |
|     }
 | |
|     my @oldbootdevs;
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{memory}) {
 | |
| 	$needfixin=1;
 | |
| 	$domdesc->findnodes("/domain/memory/text()")->[0]->setData(getUnits($confdata->{vm}->{$node}->[0]->{memory},"M",1024));
 | |
| 	foreach ($domdesc->findnodes("/domain/currentMemory/text()")) {
 | |
| 		$_->setData(getUnits($confdata->{vm}->{$node}->[0]->{memory},"M",1024));
 | |
| 	}
 | |
|     }
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{cpus}) {
 | |
| 	$needfixin=1;
 | |
| 	$domdesc->findnodes("/domain/vcpu/text()")->[0]->setData($confdata->{vm}->{$node}->[0]->{cpus});
 | |
|     }
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{bootorder}) {
 | |
|         my @expectedorder = split(/[:,]/,$confdata->{vm}->{$node}->[0]->{bootorder});
 | |
|         foreach (@expectedorder) { #this loop will check for changes and fix 'n' and 'net'
 | |
|             my $currdev = shift @bootdevs;
 | |
|             if ("net" eq $_ or "n" eq $_) {
 | |
|                 $_ = "network";
 | |
|             }
 | |
|             unless ($currdev and $currdev->getAttribute("dev") eq $_) {
 | |
|                 $needfixin=1;
 | |
|             }
 | |
|             if ($currdev) {
 | |
|                 push @oldbootdevs,$currdev;
 | |
|             }
 | |
|         }
 | |
|         if (scalar(@bootdevs)) {
 | |
|             $needfixin=1;
 | |
|             push @oldbootdevs,@bootdevs;
 | |
|         }
 | |
|         unless ($needfixin) { return 0; }
 | |
|         #ok, we need to remove all 'boot' nodes from current xml, and put in new ones in the order we like
 | |
|         foreach (@oldbootdevs) {
 | |
|             $_->parentNode->removeChild($_);
 | |
|         }
 | |
|         #now to add what we want...
 | |
|         my $osnode = $domdesc->findnodes("/domain/os")->[0];
 | |
|         foreach (@expectedorder) {
 | |
|             my $fragment = $parser->parse_balanced_chunk('<boot dev="'.$_.'"/>');
 | |
|             $osnode->appendChild($fragment);
 | |
|         }
 | |
|     }
 | |
|     if ($needfixin) {
 | |
|         return $domdesc->toString();
 | |
|     } else { return 0; }
 | |
| }
 | |
| 
 | |
| sub build_oshash {
 | |
|     my %rethash;
 | |
|     $rethash{type}->{content}='hvm';
 | |
|     $rethash{bios}->{useserial}='yes';
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{bootorder}) {
 | |
|         my $bootorder = $confdata->{vm}->{$node}->[0]->{bootorder};
 | |
|         my @bootdevs = split(/[:,]/,$bootorder);
 | |
|         my $bootnum = 0;
 | |
|         foreach (@bootdevs) {
 | |
|             if ("net" eq $_ or "n" eq $_) {
 | |
|                 $rethash{boot}->[$bootnum]->{dev}="network";
 | |
|             } else {
 | |
|                 $rethash{boot}->[$bootnum]->{dev}=$_;
 | |
|             }
 | |
|             $bootnum++;
 | |
|         }
 | |
|     } else {
 | |
|         $rethash{boot}->[0]->{dev}='network';
 | |
|         $rethash{boot}->[1]->{dev}='hd';
 | |
|     }
 | |
|     return \%rethash;
 | |
| }
 | |
| 
 | |
| sub build_diskstruct {
 | |
|     print "build_diskstruct called\n";
 | |
|     my $cdloc=shift;
 | |
|     my @returns=();
 | |
|     my $currdev;
 | |
|     my @suffixes=('a','b','d'..'zzz');
 | |
|     my $suffidx=0;
 | |
|     if ($cdloc) {
 | |
|         my $cdhash;
 | |
|         $cdhash->{device}='cdrom';
 | |
|         if ($cdloc =~ /^\/dev/) {
 | |
|             $cdhash->{type}='block';
 | |
|         } else {
 | |
|             $cdhash->{type}='file';
 | |
|         }
 | |
|         $cdhash->{source}->{file}=$cdloc;
 | |
|         $cdhash->{readonly};
 | |
|         $cdhash->{target}->{dev}='hdc';
 | |
|         push @returns,$cdhash;
 | |
|     } else { #give the VM an empty optical drive, to allow chvm live attach/remove
 | |
|       my $cdhash;
 | |
|       $cdhash->{device}='cdrom';
 | |
|       $cdhash->{type}='file';
 | |
|       $cdhash->{readonly};
 | |
|       $cdhash->{target}->{dev}='hdc';
 | |
|       push @returns,$cdhash;
 | |
|     }
 | |
| 
 | |
| 
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{storage}) {
 | |
|         my $disklocs=$confdata->{vm}->{$node}->[0]->{storage};
 | |
|         my @locations=split /\|/,$disklocs; 
 | |
|         foreach my $disk (@locations) {
 | |
|             #Setting default values of a virtual disk backed by a file at hd*.
 | |
|             my $diskhash;
 | |
|             $disk =~ s/=(.*)//;
 | |
|             my $model = $1;
 | |
|             unless ($model) {
 | |
|                 #if not defined, model will stay undefined like above
 | |
|                 $model = $confdata->{vm}->{$node}->[0]->{storagemodel};
 | |
|                 unless ($model) { $model = 'ide'; } #if still not defined, ide
 | |
|             }
 | |
|             my $prefix='hd';
 | |
|             if ($model eq 'virtio') {
 | |
|                 $prefix='vd';
 | |
|             } elsif ($model eq 'scsi') {
 | |
|                 $prefix='sd';
 | |
|             }
 | |
|             $diskhash->{type} = 'file';
 | |
|             $diskhash->{device} = 'disk';
 | |
|             $diskhash->{target}->{dev} = $prefix.$suffixes[$suffidx];
 | |
|             $diskhash->{target}->{bus} = $model;
 | |
| 
 | |
|             my @disk_parts = split(/,/, $disk);
 | |
|             #Find host file and determine if it is a file or a block device.
 | |
|             if (substr($disk_parts[0], 0, 4) eq 'phy:') {
 | |
|                 $diskhash->{type}='block';
 | |
|                 $diskhash->{source}->{dev} = substr($disk_parts[0], 4);
 | |
|             } elsif ($disk_parts[0] =~ m/^nfs:\/\/(.*)$/ or $disk_parts[0] =~ m/^dir:\/\/(.*)$/ or $disk_parts[0] =~ m/^lvm:\/\/(.*)$/) {
 | |
|                 my %disks = %{get_multiple_paths_by_url(url=>$disk_parts[0],node=>$node)};
 | |
|                 unless (keys %disks) {
 | |
|                     die "Unable to find any persistent disks at ".$disk_parts[0];
 | |
|                 }
 | |
|                 foreach (keys %disks) {
 | |
|                     my $tdiskhash;
 | |
|                     $tdiskhash->{type};
 | |
|                     $tdiskhash->{device}='disk';
 | |
|                     $tdiskhash->{driver}->{name}='qemu';
 | |
|                     $tdiskhash->{driver}->{type}=$disks{$_}->{format};
 | |
|                     $tdiskhash->{driver}->{cache}="none"; #in this scenario, making a brand new vm, there is not much the hypervisor cache can do for us that the 
 | |
| 								#guest cannot do for itself
 | |
|                     $tdiskhash->{source}->{file}=$_;
 | |
|                     $tdiskhash->{target}->{dev} = $disks{$_}->{device};
 | |
|                     if ($disks{$_} =~ /^vd/) {
 | |
|                         $tdiskhash->{target}->{bus} = 'virtio';
 | |
|                     } elsif ($disks{$_} =~ /^hd/) {
 | |
|                         $tdiskhash->{target}->{bus} = 'ide';
 | |
|                     } elsif ($disks{$_} =~ /^sd/) {
 | |
|                         $tdiskhash->{target}->{bus} = 'scsi';
 | |
|                     }
 | |
|                     push @returns,$tdiskhash;
 | |
| 
 | |
|                 }
 | |
|                 next; #nfs:// skips the other stuff
 | |
|                 #$diskhash->{source}->{file} = get_filepath_by_url(url=>$disk_parts[0],dev=>$diskhash->{target}->{dev}); #"/var/lib/xcat/vmnt/nfs_".$1."/$node/".$diskhash->{target}->{dev};
 | |
|             } else { #currently, this would be a bare file to slap in as a disk
 | |
|                 $diskhash->{source}->{file} = $disk_parts[0];
 | |
|             }
 | |
| 
 | |
|             #See if there are any other options. If not, increment suffidx because the already determined device node was used.
 | |
|             #evidently, we support specificying explicitly how to target the system..
 | |
|             if (@disk_parts gt 1) {
 | |
|                 my @disk_opts = split(/:/, $disk_parts[1]);
 | |
|                 if ($disk_opts[0] ne '') {
 | |
|                     $diskhash->{target}->{dev} = $disk_opts[0];
 | |
|                 } else {
 | |
|                     $suffidx++;
 | |
|                 }
 | |
|                 if ($disk_opts[1] eq 'cdrom') {
 | |
|                     $diskhash->{device}='cdrom';
 | |
|                 }
 | |
|             } else {
 | |
|                 $suffidx++;
 | |
|             }
 | |
| 
 | |
|             push @returns,$diskhash;
 | |
|         }
 | |
|     }
 | |
|     return \@returns;
 | |
| }
 | |
| sub getNodeUUID {
 | |
|     my $node = shift;
 | |
|     my $uuid;
 | |
|     if ($confdata->{vpd}->{$node}->[0] and $confdata->{vpd}->{$node}->[0]->{uuid}) {
 | |
| 	$uuid = $confdata->{vpd}->{$node}->[0]->{uuid};
 | |
| 	$uuid =~ s/^(..)(..)(..)(..)-(..)(..)-(..)(..)/$4$3$2$1-$6$5-$8$7/;
 | |
|         return $uuid;
 | |
|     }
 | |
|     if ($confdata->{mac}->{$node}->[0]->{mac}) { #a uuidv1 is possible, generate that for absolute uniqueness guarantee
 | |
|         my $mac = $confdata->{mac}->{$node}->[0]->{mac};
 | |
|         $mac =~ s/\|.*//;
 | |
|         $mac =~ s/!.*//;
 | |
|         $updatetable->{vpd}->{$node}={uuid=>xCAT::Utils::genUUID(mac=>$mac)};
 | |
|     } else {
 | |
|         $updatetable->{vpd}->{$node}={uuid=>xCAT::Utils::genUUID()};
 | |
|     }
 | |
|     $uuid = $updatetable->{vpd}->{$node}->{uuid};
 | |
|     $uuid =~ s/^(..)(..)(..)(..)-(..)(..)-(..)(..)/$4$3$2$1-$6$5-$8$7/;
 | |
|     return $uuid;
 | |
| 
 | |
| }
 | |
| sub build_nicstruct {
 | |
|     my $rethash;
 | |
|     my $node = shift;
 | |
|     my @nics=();
 | |
|     if ($confdata->{vm}->{$node}->[0]->{nics}) {
 | |
|         @nics = split /,/,$confdata->{vm}->{$node}->[0]->{nics};
 | |
|     }
 | |
|     my @macs=xCAT::VMCommon::getMacAddresses($confdata,$node,scalar @nics);
 | |
|     my @rethashes;
 | |
|     foreach (@macs) {
 | |
|         my $rethash;
 | |
|         my $nic = shift @nics;
 | |
|         my $type = 'e1000'; #better default fake nic than rtl8139, relevant to most
 | |
|         unless ($nic) {
 | |
|             last; #Don't want to have multiple vnics tied to the same switch
 | |
|         }
 | |
|         $nic =~ s/.*://; #the detail of how the bridge was built is of no
 | |
|                         #interest to this segment of code
 | |
|         if ($confdata->{vm}->{$node}->[0]->{nicmodel}) {
 | |
|             $type = $confdata->{vm}->{$node}->[0]->{nicmodel};
 | |
|         }
 | |
|         if ($nic =~ /=/) {
 | |
|             ($nic,$type) = split /=/,$nic,2;
 | |
|         }
 | |
|         $rethash->{type}='bridge';
 | |
|         $rethash->{mac}->{address}=$_;
 | |
|         $rethash->{source}->{bridge}=$nic;
 | |
|         $rethash->{model}->{type}=$type;
 | |
|         push @rethashes,$rethash;
 | |
|     }
 | |
|     return \@rethashes;
 | |
| }
 | |
| sub getUnits {
 | |
|     my $amount = shift;
 | |
|     my $defunit = shift;
 | |
|     my $divisor=shift;
 | |
|     unless ($divisor) {
 | |
|         $divisor = 1;
 | |
|     }
 | |
|     if ($amount =~ /(\D)$/) { #If unitless, add unit
 | |
|         $defunit=$1;
 | |
|         chop $amount;
 | |
|     }
 | |
|     if ($defunit =~ /k/i) {
 | |
|         return $amount*1024/$divisor;
 | |
|     } elsif ($defunit =~ /m/i) {
 | |
|         return $amount*1048576/$divisor;
 | |
|     } elsif ($defunit =~ /g/i) {
 | |
|         return $amount*1073741824/$divisor;
 | |
|     } 
 | |
| }
 | |
| 
 | |
| sub build_xmldesc {
 | |
|     my $node = shift;
 | |
|     my %args=@_;
 | |
|     my $cdloc=$args{cd};
 | |
|     my %xtree=();
 | |
|     $xtree{type}='kvm';
 | |
|     $xtree{name}->{content}=$node;
 | |
|     $xtree{uuid}->{content}=getNodeUUID($node);
 | |
|     $xtree{os} = build_oshash();
 | |
|     if ($args{memory}) {
 | |
|         $xtree{memory}->{content}=getUnits($args{memory},"M",1024);
 | |
|         if ($confdata->{vm}->{$node}->[0]->{memory}) {
 | |
|             $updatetable->{vm}->{$node}->{memory}=$args{memory};
 | |
|         }
 | |
|     } elsif (defined $confdata->{vm}->{$node}->[0]->{memory}) {
 | |
|         $xtree{memory}->{content}=getUnits($confdata->{vm}->{$node}->[0]->{memory},"M",1024);
 | |
|     } else {
 | |
|         $xtree{memory}->{content}=524288;
 | |
|     }
 | |
|     if ($args{cpus}) {
 | |
|         $xtree{vcpu}->{content}=$args{cpus};
 | |
|         if ($confdata->{vm}->{$node}->[0]->{cpus}) {
 | |
|             $updatetable->{vm}->{$node}->{cpus}=$args{cpus};
 | |
|         }
 | |
|     } elsif (defined $confdata->{vm}->{$node}->[0]->{cpus}) {
 | |
|         $xtree{vcpu}->{content}=$confdata->{vm}->{$node}->[0]->{cpus};
 | |
|     } else {
 | |
|         $xtree{vcpu}->{content}=1;
 | |
|     }
 | |
|     if (defined ($confdata->{vm}->{$node}->[0]->{clockoffset})) {
 | |
|         #If user requested a specific behavior, give it
 | |
|         $xtree{clock}->{offset}=$confdata->{vm}->{$node}->[0]->{clockoffset};
 | |
|     } else {
 | |
|         #Otherwise, only do local time for things that look MS
 | |
|         if (defined ($confdata->{nodetype}->{$node}->[0]->{os}) and $confdata->{nodetype}->{$node}->[0]->{os} =~ /win.*/) {
 | |
|             $xtree{clock}->{offset}='localtime';
 | |
|         } else { #For everyone else, utc is preferred generally
 | |
|             $xtree{clock}->{offset}='utc';
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     $xtree{features}->{pae}={};
 | |
|     $xtree{features}->{acpi}={};
 | |
|     $xtree{features}->{apic}={};
 | |
|     $xtree{features}->{content}="\n";
 | |
|     $xtree{devices}->{disk}=build_diskstruct($cdloc);
 | |
|     $xtree{devices}->{interface}=build_nicstruct($node);
 | |
|     #use content to force xml simple to not make model the 'name' of video
 | |
|     if (defined ($confdata->{vm}->{$node}->[0]->{vidmodel})) {
 | |
|       my $model = $confdata->{vm}->{$node}->[0]->{vidmodel};
 | |
|       my $vram = '8192';
 | |
|       if ($model eq 'qxl') { 
 | |
|         $xtree{devices}->{channel}->{type}='spicevmc';
 | |
|         $xtree{devices}->{channel}->{target}->{type}='virtio';
 | |
|         $xtree{devices}->{channel}->{target}->{name}='com.redhat.spice.0';
 | |
|         $vram = 65536; } #surprise, spice blows up with less vram than this after version 0.6 and up
 | |
|       $xtree{devices}->{video}= [ { 'content'=>'','model'=> {type=>$model,vram=>$vram}}];
 | |
|     } else {
 | |
|       $xtree{devices}->{video}= [ { 'content'=>'','model'=> {type=>'vga',vram=>8192}}];
 | |
|     }
 | |
|     $xtree{devices}->{input}->{type}='tablet';
 | |
|     $xtree{devices}->{input}->{bus}='usb';
 | |
|     if (defined ($confdata->{vm}->{$node}->[0]->{vidproto})) {
 | |
|        $xtree{devices}->{graphics}->{type}=$confdata->{vm}->{$node}->[0]->{vidproto};
 | |
|     } else {
 | |
|        $xtree{devices}->{graphics}->{type}='vnc';
 | |
|     }
 | |
|     $xtree{devices}->{graphics}->{autoport}='yes';
 | |
|     $xtree{devices}->{graphics}->{listen}='0.0.0.0';
 | |
|     if ($confdata->{vm}->{$node}->[0]->{vidpassword}) {
 | |
|     	$xtree{devices}->{graphics}->{password}=$confdata->{vm}->{$node}->[0]->{vidpassword};
 | |
|     } else {
 | |
| 	    $xtree{devices}->{graphics}->{password}=genpassword(20);
 | |
|     }
 | |
|     $xtree{devices}->{sound}->{model}='ac97';
 | |
|   
 | |
|     $xtree{devices}->{console}->{type}='pty';
 | |
|     $xtree{devices}->{console}->{target}->{port}='1';
 | |
|     return XMLout(\%xtree,RootName=>"domain");
 | |
| }
 | |
| 
 | |
| sub refresh_vm {
 | |
|     my $dom = shift;
 | |
| 
 | |
|     my $newxml=$dom->get_xml_description();
 | |
|     $updatetable->{kvm_nodedata}->{$node}->{xml}=$newxml;
 | |
|     $newxml = XMLin($newxml);
 | |
|     my $vidport=$newxml->{devices}->{graphics}->{port};
 | |
|     my $vidproto=$newxml->{devices}->{graphics}->{type};
 | |
|     my $stty=$newxml->{devices}->{console}->{tty};
 | |
|     #$updatetable->{vm}->{$node}={vncport=>$vncport,textconsole=>$stty};
 | |
|     #$vmtab->setNodeAttribs($node,{vncport=>$vncport,textconsole=>$stty});
 | |
|     return {vidport=>$vidport,textconsole=>$stty,vidproto=>$vidproto};
 | |
| }
 | |
| 
 | |
| sub getcons {
 | |
|     my $node = shift();
 | |
|     my $type = shift();
 | |
|     my $dom;
 | |
|     eval {
 | |
|      $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     unless ($dom) {
 | |
|         return 1,"Unable to query running VM";
 | |
|     }
 | |
|     my $consdata=refresh_vm($dom);
 | |
|     my $hyper=$confdata->{vm}->{$node}->[0]->{host};
 | |
| 
 | |
|     if ($type eq "text") {
 | |
|         my $serialspeed;
 | |
|         if ($confdata->{nodehm}) {
 | |
|             $serialspeed=$confdata->{nodehm}->{$node}->[0]->{serialspeed};
 | |
|         }
 | |
|         my $sconsparms = {node=>[{name=>[$node]}]};
 | |
|         $sconsparms->{node}->[0]->{sshhost}=[$hyper];
 | |
|         $sconsparms->{node}->[0]->{psuedotty}=[$consdata->{textconsole}];
 | |
|         $sconsparms->{node}->[0]->{baudrate}=[$serialspeed];
 | |
|         return (0,$sconsparms);
 | |
|     } elsif ($type eq "vid") {
 | |
| 	$consdata->{server}=$hyper;
 | |
|       my $domxml = $dom->get_xml_description();
 | |
|       my $parseddom = $parser->parse_string($domxml);
 | |
|       my ($graphicsnode) = $parseddom->findnodes("//graphics");
 | |
|       my $tpasswd; 
 | |
|       if ($confdata->{vm}->{$node}->[0]->{vidpassword}) {
 | |
| 	$tpasswd=$confdata->{vm}->{$node}->[0]->{vidpassword};
 | |
|       	$graphicsnode->removeAttribute("passwdValidTo");
 | |
|       } else {
 | |
|       $tpasswd=genpassword(16);
 | |
|       my $validto=POSIX::strftime("%Y-%m-%dT%H:%M:%S",gmtime(time()+60));
 | |
|       $graphicsnode->setAttribute("passwdValidTo",$validto);
 | |
|      }
 | |
|       $graphicsnode->setAttribute("passwd",$tpasswd);
 | |
|       $dom->update_device($graphicsnode->toString());
 | |
| 	#$dom->update_device("<graphics type='".$consdata->{vidproto}."' passwd='$tpasswd' passwdValidTo='$validto' autoport='yes'/>");
 | |
| 	$consdata->{password}=$tpasswd;
 | |
| 	return $consdata;
 | |
|         #return (0,{$consdata->{vidproto}.'@'.$hyper.":".$consdata->{vidport}); #$consdata->{vncport});
 | |
|     }
 | |
| }
 | |
| sub getrvidparms {
 | |
|     my $node=shift;
 | |
|     my $location = getcons($node,"vid");
 | |
|     unless (ref $location) {
 | |
|        return (1,"Error: Unable to determine rvid destination for $node (appears VM is off)");
 | |
|     }
 | |
|         my @output = (
 | |
|       "method: kvm"
 | |
|       );
 | |
|     foreach (keys %$location) {
 | |
|       push @output,$_.":".$location->{$_};
 | |
|     }
 | |
|     return 0,@output;
 | |
| }
 | |
| 
 | |
| my %cached_noderanges;
 | |
| sub pick_target {
 | |
|     my $node = shift;
 | |
|     my $addmemory = shift;
 | |
|     my $target;
 | |
|     my $mostfreememory=undef;
 | |
|     my $currentfreememory;
 | |
|     my $candidates= $confdata->{vm}->{$node}->[0]->{migrationdest};
 | |
|     my $currhyp=$confdata->{vm}->{$node}->[0]->{host};
 | |
| #caching strategy is implicit on whether $addmemory is passed.
 | |
|     unless ($candidates) {
 | |
|         return undef;
 | |
|     }
 | |
|     my @fosterhyps; #noderange is relatively expensive, and generally we only will have a few distinct noderange descriptions to contend with in a mass adoption, so cache eache one for reuse across pick_target() calls
 | |
|     if (defined $cached_noderanges{$candidates}) {
 | |
| 	@fosterhyps = @{$cached_noderanges{$candidates}};
 | |
|     } else {
 | |
| 	@fosterhyps = noderange($candidates);
 | |
|         $cached_noderanges{$candidates} = \@fosterhyps;
 | |
|     }
 | |
|     foreach (@fosterhyps) {
 | |
|         my $targconn;
 | |
|         my $cand=$_;
 | |
|         if ($_ eq $currhyp) { next; } #skip current node
 | |
|         if ($offlinehyps{$_}) { next }; #skip already offlined nodes
 | |
|         if (grep { "$_" eq $cand } @destblacklist) { next; } #skip blacklisted destinations
 | |
|         if ($addmemory and defined $hypstats{$_}->{freememory}) { #only used cache results when addmemory suggests caching can make sense
 | |
|             $currentfreememory=$hypstats{$_}->{freememory}
 | |
|         } else {
 | |
|             if (not nodesockopen($_,22)) { $offlinehyps{$_}=1; next; } #skip unusable destinations
 | |
|                 eval {  #Sys::Virt has bugs that cause it to die out in weird ways some times, contain it here
 | |
|                     $targconn = Sys::Virt->new(uri=>"qemu+ssh://root@".$_."/system?no_tty=1&netcat=nc");
 | |
|                 };
 | |
|                 unless ($targconn) {
 | |
|                     eval {  #Sys::Virt has bugs that cause it to die out in weird ways some times, contain it here
 | |
|                         $targconn = Sys::Virt->new(uri=>"qemu+ssh://root@".$_."/system?no_tty=1");
 | |
|                     };
 | |
|                 }
 | |
|             unless ($targconn) { next; } #skip unreachable destinations
 | |
|             $currentfreememory=$targconn->get_node_info()->{memory};
 | |
|             foreach ($targconn->list_domains()) {
 | |
|                 if ($_->get_name() eq 'Domain-0') { next; } #Dom0 memory usage is elastic, we are interested in HVM DomU memory, which is inelastic
 | |
|     
 | |
|                 $currentfreememory -= $_->get_info()->{memory};
 | |
|             }
 | |
|             $hypstats{$cand}->{freememory}=$currentfreememory;
 | |
|         }
 | |
|         if ($addmemory and $addmemory->{$_}) {
 | |
|             $currentfreememory -= $addmemory->{$_};
 | |
|         }
 | |
|         if (not defined ($mostfreememory)) {
 | |
|             $mostfreememory=$currentfreememory;
 | |
|             $target=$_;
 | |
|         } elsif ($currentfreememory > $mostfreememory) {
 | |
|             $mostfreememory=$currentfreememory;
 | |
|             $target=$_;
 | |
|         }
 | |
|     }
 | |
|     return $target;
 | |
| }
 | |
| 
 | |
| 
 | |
| sub migrate {
 | |
|     $node = shift();
 | |
|     my @args=@_;
 | |
|     my $targ;
 | |
|     foreach (@args) {
 | |
| 	if (/^-/) { next; }
 | |
| 	$targ = $_;
 | |
|     }
 | |
|     if ($offlinevms{$node}) {
 | |
|         return power("on");
 | |
|     }
 | |
| #TODO: currently, we completely serialize migration events.  Some IO fabrics can facilitate concurrent migrations
 | |
| #One trivial example is an ethernet port aggregation where a single conversation may likely be unable to utilize all the links
 | |
| #because traffic is balanced by a mac address hashing algorithim, but talking to several hypervisors would have
 | |
| #distinct peers that can be balanced more effectively.
 | |
| #The downside is that migration is sufficiently slow that a lot can change in the intervening time on a target hypervisor, but
 | |
| #this should not be an issue if:
 | |
| #xCAT is the only path a configuration is using to make changes in the virtualization stack
 | |
| #xCAT implements a global semaphore mechanism that this plugin can use to assure migration targets do not change by our own hand..
 | |
| #failing that.. flock.
 | |
|     unless ($targ) {
 | |
|         $targ = pick_target($node);
 | |
|     }
 | |
|     unless ($targ) {
 | |
|         return (1,"Unable to identify a suitable target host for guest $node");
 | |
|     }
 | |
|     if ($use_xhrm) {
 | |
|         xhrm_satisfy($node,$targ);
 | |
|     }
 | |
|     my $prevhyp;
 | |
|     my $target = "qemu+ssh://root@".$targ."/system?no_tty=1";
 | |
|     my $currhyp="qemu+ssh://root@";
 | |
|     if ($confdata->{vm}->{$node}->[0]->{host}) {
 | |
|         $prevhyp=$confdata->{vm}->{$node}->[0]->{host};
 | |
|         $currhyp.=$prevhyp;
 | |
|     } else {
 | |
|         return (1,"Unable to find current location of $node");
 | |
|     }
 | |
|     $currhyp.="/system?no_tty=1";
 | |
|     if ($currhyp eq $target) {
 | |
|         return (0,"Guest is already on host $targ");
 | |
|     }
 | |
|     my $srchypconn;
 | |
|     my $desthypconn;
 | |
|     unless ($offlinehyps{$prevhyp} or nodesockopen($prevhyp,22)) {
 | |
|         $offlinehyps{$prevhyp}=1;
 | |
|     }
 | |
|     my $srcnetcatadd="&netcat=nc";
 | |
|     unless ($offlinehyps{$prevhyp}) {
 | |
|         eval {#Contain Sys::Virt bugs
 | |
|             $srchypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$prevhyp."/system?no_tty=1$srcnetcatadd");
 | |
|         };
 | |
|         unless ($srchypconn) {
 | |
|             $srcnetcatadd="";
 | |
|             eval {#Contain Sys::Virt bugs
 | |
|                 $srchypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$prevhyp."/system?no_tty=1");
 | |
|             };
 | |
|         }
 | |
|     }
 | |
|     unless ($srchypconn) {
 | |
|         if (grep { $_ eq '-f' } @args) {
 | |
|       		unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>1); }
 | |
| 	        $vmtab->setNodeAttribs($node,{host=>$targ});
 | |
| 	        return (0,"migrated to $targ");
 | |
|         } else {
 | |
| 	        return (1,"Unable to reach $prevhyp to perform operation of $node, use nodech to change vm.host if certain of no split-brain possibility exists (or use -f on rmigrate)");
 | |
| 	}
 | |
|     }
 | |
|     unless ($offlinehyps{$targ} or nodesockopen($targ,22)) {
 | |
|         $offlinehyps{$targ}=1;
 | |
|     }
 | |
|     my $destnetcatadd="&netcat=nc";
 | |
|     unless ($offlinehyps{$targ}) {
 | |
|         eval {#Contain Sys::Virt bugs
 | |
|             $desthypconn= Sys::Virt->new(uri=>$target.$destnetcatadd);
 | |
|         };
 | |
|         unless ($desthypconn) {
 | |
|             $destnetcatadd="";
 | |
|             eval {#Contain Sys::Virt bugs
 | |
|                 $desthypconn= Sys::Virt->new(uri=>$target);
 | |
|             };
 | |
|         }
 | |
|     }
 | |
|     unless ($desthypconn) {
 | |
|         return (1,"Unable to reach $targ to perform operation of $node, destination unusable.");
 | |
|     }
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{storage} and $confdata->{vm}->{$node}->[0]->{storage} =~ /^nfs:/) {
 | |
|         #first, assure master is in place
 | |
|         if ($confdata->{vm}->{$node}->[0]->{master}) {
 | |
|             my $vmmastertab=xCAT::Table->new('vmmaster',-create=>0);
 | |
|             my $masterent;
 | |
|             if ($vmmastertab) {
 | |
|                $masterent=$vmmastertab->getAttribs({name=>$confdata->{vm}->{$node}->[0]->{master}},['storage']);
 | |
|             }
 | |
|             if ($masterent and $masterent->{storage}) {
 | |
|                  foreach (split /,/,$masterent->{storage}) {
 | |
|                      s/=.*//;
 | |
|                      get_storage_pool_by_url($_,$desthypconn,$targ);
 | |
|                  }
 | |
|             }
 | |
|         }
 | |
|         my $urls =  $confdata->{vm}->{$node}->[0]->{storage} and $confdata->{vm}->{$node}->[0]->{storage};
 | |
|         foreach (split /,/,$urls) {
 | |
|             s/=.*//;
 | |
|             get_storage_pool_by_url($_,$desthypconn,$targ);
 | |
|         }
 | |
|     }
 | |
|     my $sock = IO::Socket::INET->new(Proto=>'udp');
 | |
|     my $ipa=inet_aton($node);
 | |
|     my $pa;
 | |
|     if ($ipa) {
 | |
|         $pa=sockaddr_in(7,$ipa); #UDP echo service, not needed to be actually
 | |
|     }
 | |
|     #serviced, we just want to trigger MAC move in the switch forwarding dbs
 | |
|     my $nomadomain;
 | |
|     eval { 
 | |
|         $nomadomain = $srchypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     unless ($nomadomain) {
 | |
|       	unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>1); }
 | |
|         $vmtab->setNodeAttribs($node,{host=>$targ});
 | |
|         return (0,"migrated to $targ");
 | |
|         #return (1,"Unable to find $node on $prevhyp, vm.host may be incorrect or a split-brain condition, such as libvirt forgetting a guest due to restart or bug.");
 | |
| 	
 | |
|     }
 | |
|     my $newdom;
 | |
|     my $errstr;
 | |
|     eval {
 | |
|         $newdom=$nomadomain->migrate($desthypconn,&Sys::Virt::Domain::MIGRATE_LIVE,undef,undef,0);
 | |
|     };
 | |
|     if ($@) { $errstr = $@; }
 | |
| #TODO: If it looks like it failed to migrate, ensure the guest exists only in one place
 | |
|     if ($errstr) { 
 | |
|         return (1,"Failed migration of $node from $prevhyp to $targ: $errstr");
 | |
|     }
 | |
|     unless ($newdom) {
 | |
|         return (1,"Failed migration from $prevhyp to $targ");
 | |
|     }
 | |
|     if ($ipa) {
 | |
|         system("arp -d $node"); #Make ethernet fabric take note of change
 | |
|         send($sock,"dummy",0,$pa);  #UDP packet to force forwarding table update in switches, ideally a garp happened, but just in case...
 | |
|     }
 | |
|     #BTW, this should all be moot since the underlying kvm seems good about gratuitous traffic, but it shouldn't hurt anything
 | |
|     refresh_vm($newdom);
 | |
|     #The migration seems tohave suceeded, but to be sure...
 | |
|     close($sock);
 | |
|     if ($desthypconn->get_domain_by_name($node)) {
 | |
|         #$updatetable->{vm}->{$node}->{host} = $targ;
 | |
|       	unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>1); }
 | |
|         $vmtab->setNodeAttribs($node,{host=>$targ});
 | |
|         return (0,"migrated to $targ");
 | |
|     } else { #This *should* not be possible
 | |
|         return (1,"Failed migration from $prevhyp to $targ, despite normal looking run...");
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| sub getpowstate {
 | |
|     my $dom = shift;
 | |
|     my $vmstat;
 | |
|     if ($dom) {
 | |
|         $vmstat = $dom->get_info;
 | |
|     }
 | |
|     if ($vmstat and $runningstates{$vmstat->{state}}) {
 | |
|         return "on";
 | |
|     } else {
 | |
|         return "off";
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub xhrm_satisfy {
 | |
|     my $node = shift;
 | |
|     my $hyp = shift;
 | |
|     my $rc=0;
 | |
|     my @nics=();
 | |
|     my @storage=();
 | |
|     if ($confdata->{vm}->{$node}->[0]->{nics}) {
 | |
|         @nics = split /,/,$confdata->{vm}->{$node}->[0]->{nics};
 | |
|     }
 | |
|         
 | |
|     $rc |=system("scp $::XCATROOT/share/xcat/scripts/xHRM $hyp:/usr/bin");
 | |
| 
 | |
|     foreach (@nics) {
 | |
|         s/=.*//; #this code cares not about the model of virtual nic
 | |
|         my $nic=$_;
 | |
| 	my $vlanip;
 | |
| 	my $netmask;
 | |
| 	my $subnet;
 | |
|         my $vlan;
 | |
|         my $interface;
 | |
| 	if ($nic =~ /^vl([\d]+)$/) {
 | |
| 	    $vlan=$1;
 | |
| 	    my $nwtab=xCAT::Table->new("networks", -create =>0);
 | |
| 	    if ($nwtab) {
 | |
| 		my $sent = $nwtab->getAttribs({vlanid=>"$vlan"},'net','mask');
 | |
| 		if ($sent and ($sent->{net})) {
 | |
| 		    $subnet=$sent->{net};
 | |
| 		    $netmask=$sent->{mask};
 | |
| 		} 
 | |
| 		if (($subnet) && ($netmask)) {
 | |
| 		    my $hoststab = xCAT::Table->new("hosts", -create => 0);
 | |
| 		    if ($hoststab) {
 | |
| 			my $tmp = $hoststab->getNodeAttribs($hyp, ['otherinterfaces']);
 | |
| 			if (defined($tmp) && ($tmp) && $tmp->{otherinterfaces})
 | |
| 			{
 | |
| 			    my $otherinterfaces = $tmp->{otherinterfaces};
 | |
| 			    my @itf_pairs=split(/,/, $otherinterfaces);
 | |
| 			    foreach (@itf_pairs) {
 | |
| 				my ($name,$vip)=split(/:/, $_);
 | |
| 				if(xCAT::NetworkUtils->ishostinsubnet($vip, $netmask, $subnet)) {
 | |
| 				    $vlanip=$vip;
 | |
| 				    last;
 | |
| 				}
 | |
| 			    }
 | |
| 			}
 | |
| 		    }
 | |
| 		}
 | |
| 	    }
 | |
| 	}
 | |
| 
 | |
|         #get the nic that vlan tagged 
 | |
|         my $swtab = xCAT::Table->new("switch", -create => 0);
 | |
|         if ($swtab) {
 | |
| 	    my $tmp_switch = $swtab->getNodesAttribs([$hyp], ['vlan','interface']);
 | |
| 	    if (defined($tmp_switch) && (exists($tmp_switch->{$hyp}))) { 
 | |
| 	        my $tmp_node_array=$tmp_switch->{$hyp};
 | |
| 	        foreach my $tmp (@$tmp_node_array) {
 | |
| 		    if (exists($tmp->{vlan})) {
 | |
| 		        my $vlans = $tmp->{vlan};
 | |
| 		        foreach my $vlan_tmp (split(',',$vlans)) {
 | |
| 			    if ($vlan_tmp == $vlan) {
 | |
| 		                if (exists($tmp->{interface})) {
 | |
| 			            $interface=$tmp->{interface};
 | |
| 		                }
 | |
|                                 last;
 | |
|                             }
 | |
| 		        }
 | |
| 		    }
 | |
| 	        }
 | |
| 	    }
 | |
|         }
 | |
|         
 | |
|         if (($interface) || ($interface =~ /primary/)) {
 | |
|             $interface =~ s/primary(:)?//g;
 | |
|         }
 | |
| 	#print "interface=$interface nic=$nic vlanip=$vlanip netmask=$netmask\n";
 | |
|         if ($interface) {
 | |
| 	    $rc |=system("ssh $hyp xHRM bridgeprereq $interface:$nic $vlanip $netmask");
 | |
|         } else {
 | |
|             $rc |=system("ssh $hyp xHRM bridgeprereq $nic $vlanip $netmask");
 | |
|         }
 | |
| 
 | |
|         #TODO: surprise! there is relatively undocumented libvirt capability for this...
 | |
|         #./tests/interfaceschemadata/ will have to do in lieu of documentation..
 | |
|         #note that RHEL6 is where that party starts
 | |
|         #of course, they don't have a clean 'migrate from normal interface to bridge' capability
 | |
|         #consequently, would have to have some init script at least pre-bridge it up..
 | |
|         #even then, may not be able to intelligently modify the bridge remotely, so may still not be feasible for our use..
 | |
|         #this is sufficiently hard, punting to 2.6 at least..
 | |
|     }
 | |
|     return $rc;
 | |
| }
 | |
| sub makedom {
 | |
|     my $node=shift;
 | |
|     my $cdloc = shift;
 | |
|     my $xml = shift;
 | |
|     my $dom;
 | |
|     if (not $xml and $confdata->{kvmnodedata}->{$node} and $confdata->{kvmnodedata}->{$node}->[0] and $confdata->{kvmnodedata}->{$node}->[0]->{xml}) {
 | |
|         #we do this to trigger storage prereq fixup
 | |
|         if (defined $confdata->{vm}->{$node}->[0]->{storage} and ($confdata->{vm}->{$node}->[0]->{storage} =~ /^nfs:/ or $confdata->{vm}->{$node}->[0]->{storage} =~ /^dir:/ or $confdata->{vm}->{$node}->[0]->{storage} =~ /^lvm:/)) {
 | |
|             if ($confdata->{vm}->{$node}->[0]->{master}) {
 | |
|                 my $vmmastertab=xCAT::Table->new('vmmaster',-create=>0);
 | |
|                 my $masterent;
 | |
|                 if ($vmmastertab) {
 | |
|                    $masterent=$vmmastertab->getAttribs({name=>$confdata->{vm}->{$node}->[0]->{master}},['storage']);
 | |
|                 }
 | |
|                 if ($masterent and $masterent->{storage}) {
 | |
|                      foreach (split /,/,$masterent->{storage}) {
 | |
|                          s/=.*//;
 | |
|                          get_storage_pool_by_url($_);
 | |
|                      }
 | |
|                 }
 | |
|             }
 | |
|             my $urls =  $confdata->{vm}->{$node}->[0]->{storage} and $confdata->{vm}->{$node}->[0]->{storage};
 | |
|             foreach (split /,/,$urls) {
 | |
|                 s/=.*//;
 | |
|                 get_storage_pool_by_url($_);
 | |
|             }
 | |
|         }
 | |
|         $xml = $confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|         my $newxml = reconfigvm($node,$xml);
 | |
|         if ($newxml) {
 | |
|             $xml=$newxml;
 | |
|         }
 | |
|     } elsif (not $xml) {
 | |
|         $xml = build_xmldesc($node,cd=>$cdloc);
 | |
|     }
 | |
|     my $parseddom = $parser->parse_string($xml);
 | |
|     my ($graphics) = $parseddom->findnodes("//graphics");
 | |
|     if ($confdata->{vm}->{$node}->[0]->{vidpassword}) {
 | |
|     	$graphics->setAttribute("passwd",$confdata->{vm}->{$node}->[0]->{vidpassword});
 | |
|     } else {
 | |
|     	$graphics->setAttribute("passwd",genpassword(20));
 | |
|     }
 | |
|     $graphics->setAttribute("listen",'0.0.0.0');
 | |
|     $xml = $parseddom->toString();
 | |
|     my $errstr;
 | |
|     eval { 
 | |
| 	if ($::XCATSITEVALS{persistkvmguests}) {
 | |
| 		$dom=$hypconn->define_domain($xml); 
 | |
| 		$dom->create()
 | |
| 	} else {
 | |
| 		$dom=$hypconn->create_domain($xml); 
 | |
| 	}
 | |
|     };
 | |
|     if ($@) { $errstr = $@; }
 | |
|     if (ref $errstr) {
 | |
|        $errstr = ":".$errstr->{message};
 | |
|     }
 | |
|     if ($errstr) { return (undef,$errstr); }
 | |
|     if ($dom) {
 | |
|            refresh_vm($dom);
 | |
|     }
 | |
|     return $dom,undef;
 | |
| }
 | |
| 
 | |
| sub createstorage {
 | |
| #svn rev 6638 held the older vintage of createstorage
 | |
|     #print "createstorage called\n";
 | |
|     my $filename=shift;
 | |
|     my $mastername=shift;
 | |
|     my $size=shift;
 | |
|     my $cfginfo = shift;
 | |
|     my $force = shift;
 | |
|     #my $diskstruct = shift;
 | |
|     my $node = $cfginfo->{node};
 | |
|     my @flags = split /,/,$cfginfo->{virtflags};
 | |
|     foreach (@flags) {
 | |
|         if (/^imageformat=(.*)\z/) {
 | |
|             $imgfmt=$1;
 | |
|         } elsif (/^clonemethod=(.*)\z/) {
 | |
|             $clonemethod=$1;
 | |
|         }
 | |
|     }
 | |
|     my $mountpath;
 | |
|     my $pathappend;
 | |
| 
 | |
| 
 | |
|     #for nfs paths and qemu-img, we do the magic locally only for now
 | |
|     my $basename;
 | |
|     my $dirname;
 | |
|     if ($mastername and $size) {
 | |
|         return 1,"Can not specify both a master to clone and size(s)";
 | |
|     }
 | |
|     $filename=~s/=(.*)//;
 | |
|     my $model=$1;
 | |
|     unless ($model) {
 | |
|         #if not defined, model will stay undefined like above
 | |
|         $model = $cfginfo->{storagemodel};
 | |
|     }
 | |
|     my $prefix='hd';
 | |
|     if ($model eq 'scsi') {
 | |
|         $prefix='sd';
 | |
|     } elsif ($model eq 'virtio') {
 | |
|         $prefix='vd';
 | |
|     }
 | |
|     my @suffixes=('a','b','d'..'zzz');
 | |
|     if ($filename =~ /^nfs:/ or $filename =~ /^dir:/ or $filename =~ /^lvm:/) { #libvirt storage pool to be used for this
 | |
|         my @sizes = split /,/,$size;
 | |
|         foreach (@sizes) {
 | |
|             get_filepath_by_url(url=>$filename,dev=>$prefix.shift(@suffixes),create=>$_, force=>$force);
 | |
|         }
 | |
|     }else{
 | |
|         oldCreateStorage($filename, $mastername, $size, $cfginfo, $force);
 | |
|     } 
 | |
|     my $masterserver;
 | |
|     if ($mastername) { #cloning
 | |
|     }
 | |
|     if ($size) {#new volume
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub oldCreateStorage {
 | |
|     my $filename=shift;
 | |
|     my $mastername=shift;
 | |
|     my $size=shift;
 | |
|     my $cfginfo = shift;
 | |
|     my $force = shift;
 | |
|     my $node = $cfginfo->{node};
 | |
|     my @flags = split /,/,$cfginfo->{virtflags};
 | |
|     foreach (@flags) {
 | |
|         if (/^imageformat=(.*)\z/) {
 | |
|             $imgfmt=$1;
 | |
|         } elsif (/^clonemethod=(.*)\z/) {
 | |
|             $clonemethod=$1;
 | |
|         }
 | |
|     }
 | |
|     my $mountpath;
 | |
|     my $pathappend;
 | |
|     my $storageserver;
 | |
|     #for nfs paths and qemu-img, we do the magic locally only for now
 | |
|     my $basename;
 | |
|     my $dirname;
 | |
|     ($basename,$dirname) = fileparse($filename);
 | |
|     unless ($storageserver) {
 | |
|         if (-f $filename) {
 | |
|             unless ($force) {
 | |
|                 return 1,"Storage already exists, delete manually or use --force";
 | |
|             }
 | |
|             unlink $filename;
 | |
|         }
 | |
|     }
 | |
|     if ($storageserver and $mastername and $clonemethod eq 'reflink') {
 | |
|         my $rc=system("ssh $storageserver mkdir -p $dirname");
 | |
|         if ($rc) {
 | |
|             return 1,"Unable to manage storage on remote server $storageserver";
 | |
|         }
 | |
|     } elsif ($storageserver) {
 | |
|         my @mounts = `mount`;
 | |
|         my $foundmount;
 | |
|         foreach (@mounts) {
 | |
|           if (/^$storageserver:$mountpath/) {
 | |
| 	     chomp;
 | |
|              s/^.* on (\S*) type nfs.*$/$1/;
 | |
|              $dirname = $_;
 | |
|              mkpath($dirname.$pathappend);
 | |
|              $foundmount=1;
 | |
|              last;
 | |
|           }
 | |
|         }
 | |
|         unless ($foundmount) {
 | |
|             return 1,"qemu-img cloning requires that the management server have the directory $mountpath from $storageserver mounted";
 | |
|         }
 | |
|     } else {
 | |
|         mkpath($dirname);
 | |
|     }
 | |
|     if ($mastername and $size) {
 | |
|         return 1,"Can not specify both a master to clone and a size";
 | |
|     }
 | |
|     my $masterserver;
 | |
|     if ($mastername) {
 | |
|         unless ($mastername =~ /^\// or $mastername =~ /^nfs:/) {
 | |
|             $mastername = $xCAT_plugin::kvm::masterdir.'/'.$mastername;
 | |
|         }
 | |
|         if ($mastername =~ m!nfs://([^/]*)(/.*\z)!) {
 | |
|             $mastername = $2;
 | |
|             $masterserver = $1;
 | |
|         }
 | |
|         if ($masterserver ne $storageserver) {
 | |
|             return 1,"Not supporting cloning between $masterserver and $storageserver at this time, for now ensure master images and target VM images are on the same server";
 | |
|         }
 | |
|         my $rc;
 | |
|         if ($clonemethod eq 'qemu-img') {
 | |
|             my $dirn;
 | |
|             my $filn;
 | |
|             ($filn,$dirn) = fileparse($filename);
 | |
|             chdir($dirn);
 | |
|             $rc=system("qemu-img create -f qcow2 -b $mastername $filename");
 | |
|         } elsif ($clonemethod eq 'reflink') {
 | |
|             if ($storageserver) {
 | |
|                 $rc=system("ssh $storageserver cp --reflink $mastername $filename");
 | |
|             } else {
 | |
|                 $rc=system("cp --reflink $mastername $filename");
 | |
|             }
 | |
|         }
 | |
|         if ($rc) {
 | |
|             return $rc,"Failure creating image $filename from $mastername";
 | |
|         }
 | |
|     }
 | |
|     if ($size) {
 | |
|         my $rc = system("qemu-img create -f $imgfmt $filename ".getUnits($size,"g",1024));
 | |
|         if ($rc) {
 | |
|             return $rc,"Failure creating image $filename of size $size\n";
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub rinv {
 | |
|     shift;
 | |
|     my $dom;
 | |
|     eval {
 | |
|        $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     my $currstate=getpowstate($dom);
 | |
|     my $currxml;
 | |
|     if ($currstate eq 'on') {
 | |
|         $currxml=$dom->get_xml_description();
 | |
|     } else {
 | |
|         $currxml  =$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|     }
 | |
|     unless ($currxml) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"VM does not appear to exist"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $domain=$parser->parse_string($currxml);
 | |
|     my $uuid = $domain->findnodes('/domain/uuid')->[0]->to_literal;
 | |
|     $uuid =~ s/^(..)(..)(..)(..)-(..)(..)-(..)(..)/$4$3$2$1-$6$5-$8$7/;
 | |
|     xCAT::SvrUtils::sendmsg("UUID/GUID: $uuid", $callback,$node);
 | |
|     my $cpus = $domain->findnodes('/domain/vcpu')->[0]->to_literal;
 | |
|     xCAT::SvrUtils::sendmsg("CPUs: $cpus", $callback,$node);
 | |
|     my $memnode = $domain->findnodes('/domain/currentMemory')->[0];
 | |
|     my $maxmemnode = $domain->findnodes('/domain/memory')->[0];
 | |
|     unless ($memnode) {
 | |
|         $memnode = $maxmemnode;
 | |
|     }
 | |
|     if ($memnode) {
 | |
|         my $mem = $memnode->to_literal;
 | |
|         $mem=$mem/1024;
 | |
|         xCAT::SvrUtils::sendmsg("Memory: $mem MB", $callback,$node);
 | |
|     }
 | |
|     if ($maxmemnode) {
 | |
| 	my $maxmem = $maxmemnode->to_literal;
 | |
| 	$maxmem=$maxmem/1024;
 | |
|         xCAT::SvrUtils::sendmsg("Maximum Memory: $maxmem MB", $callback,$node);
 | |
| 	
 | |
|     }
 | |
|     invstorage($domain);
 | |
|     invnics($domain);
 | |
| }
 | |
| sub get_storage_pool_by_volume {
 | |
|     my $vol = shift;
 | |
|     my $path=$vol->get_path();
 | |
|     return get_storage_pool_by_path($path);
 | |
| }
 | |
| sub get_storage_pool_by_path {
 | |
| #attempts to get pool for a volume, returns false on failure
 | |
|     my $file = shift;
 | |
|     my $pool;
 | |
|     return eval {
 | |
|         my @currpools = $hypconn->list_storage_pools();
 | |
|         push @currpools,$hypconn->list_defined_storage_pools();
 | |
|         foreach $pool (@currpools) {
 | |
|             my $parsedpool = $parser->parse_string($pool->get_xml_description());
 | |
|             my $currpath = $parsedpool->findnodes("/pool/target/path/text()")->[0]->data;
 | |
|             if ($currpath eq $file or $file =~ /^$currpath\/[^\/]*$/) {
 | |
|                 return $pool;
 | |
|             }
 | |
|         }
 | |
|         return undef;
 | |
|         # $pool = $hypconn->get_storage_pool_by_uuid($pooluuid);
 | |
|     };
 | |
| }
 | |
| 
 | |
| sub invstorage {
 | |
|     my $domain = shift;
 | |
|     my @disks = $domain->findnodes('/domain/devices/disk');
 | |
|     my $disk;
 | |
|     foreach $disk (@disks) {
 | |
|         my $name = $disk->findnodes('./target')->[0]->getAttribute("dev");
 | |
|         my $xref = "";
 | |
|         my $addr =  $disk->findnodes('./address')->[0];
 | |
|         if ($addr) {
 | |
|             if ($name =~ /^vd/) {
 | |
|                 $xref = " (v".$addr->getAttribute("bus").":".$addr->getAttribute('slot').".".$addr->getAttribute("function").")";
 | |
|                 $xref =~ s/0x//g;
 | |
|             } else {
 | |
|                 $xref = " (d".$addr->getAttribute("controller").":".$addr->getAttribute("bus").":".$addr->getAttribute("unit").")";
 | |
|             }
 | |
|         }
 | |
| 
 | |
| 	my @candidatenodes = $disk->findnodes('./source');
 | |
| 	unless (scalar @candidatenodes) {
 | |
| 		next;
 | |
| 	}
 | |
|         my $file = $candidatenodes[0]->getAttribute('file');
 | |
|         #we'll attempt to map file path to pool name and volume name
 | |
|         #fallback to just reporting filename if not feasible
 | |
|         #libvirt lacks a way to lookup a storage pool by path, so we'll only do so if using the 'default' xCAT scheme with uuid in the path
 | |
|         $file =~ m!/([^/]*)/($node\..*)\z!;
 | |
|         my $volname=$2;
 | |
|         my $vollocation=$file;
 | |
|         eval {
 | |
|             my $pool = get_storage_pool_by_path($file);
 | |
|             my $poolname = $pool->get_name();
 | |
|             $vollocation = "[$poolname] $volname";
 | |
|         };
 | |
|         #at least I get to skip the whole pool mess here
 | |
|         my $vol = $hypconn->get_storage_volume_by_path($file);
 | |
|         my $size;
 | |
|         if ($vol) {
 | |
|             my %info = %{$vol->get_info()};
 | |
|             if ($info{allocation} and $info{capacity}) {
 | |
|                 $size = $info{allocation};
 | |
|                 $size = $size/1048576; #convert to MB
 | |
|                 $size = sprintf("%.3f",$size);
 | |
|                 $size .= "/".($info{capacity}/1048576);
 | |
|             }
 | |
|         }
 | |
|         $callback->({
 | |
|             node=>{
 | |
|                 name=>$node,
 | |
|                 data=>{
 | |
|                     desc=>"Disk $name$xref",
 | |
|                     contents=>"$size MB @ $vollocation",
 | |
|                 }
 | |
|             }
 | |
|         });
 | |
|     }
 | |
| }
 | |
| sub invnics {
 | |
|     my $domain=shift;
 | |
|     my @nics = $domain->findnodes('/domain/devices/interface');
 | |
|     my $nic;
 | |
|     foreach $nic (@nics) {
 | |
|         my $mac = $nic->findnodes('./mac')->[0]->getAttribute('address');
 | |
|         my $addr = $nic->findnodes('./address')->[0];
 | |
|         my $loc;
 | |
|         if ($addr) {
 | |
|             my $bus = $addr->getAttribute('bus');
 | |
|             $bus =~ s/^0x//;
 | |
|             my $slot = $addr->getAttribute('slot');
 | |
|             $slot =~ s/^0x//;
 | |
|             my $function = $addr->getAttribute('function');
 | |
|             $function =~ s/^0x//;
 | |
|             $loc=" at $bus:$slot.$function";
 | |
|         }
 | |
|         $callback->({
 | |
|             node=>{
 | |
|                 name=>$node,
 | |
|                 data=>{
 | |
|                     desc=>"Network adapter$loc",
 | |
|                     contents=>$mac,
 | |
|                 }
 | |
|             }
 | |
|         });
 | |
|     }
 | |
| }
 | |
| sub rmvm {
 | |
|     shift;
 | |
|     @ARGV=@_;
 | |
|     my $force;
 | |
|     my $purge;
 | |
|     GetOptions(
 | |
|         'f' => \$force,
 | |
|         'p' => \$purge,
 | |
|     );
 | |
|     my $dom;
 | |
|     eval {
 | |
|        $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     my $currstate=getpowstate($dom);
 | |
|     my $currxml;
 | |
|     if ($currstate eq 'on') {
 | |
|         if ($force) {
 | |
|             $currxml=$dom->get_xml_description();
 | |
|             $dom->destroy();
 | |
|         } else {
 | |
|             xCAT::SvrUtils::sendmsg([1,"Cannot rmvm active guest (use -f argument to force)"], $callback,$node);
 | |
|             return;
 | |
|         }
 | |
|     } else {
 | |
|         $currxml  =$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|     }
 | |
|     if ($purge and $currxml) {
 | |
|         my $deadman = $parser->parse_string($currxml);
 | |
|         my @purgedisks = $deadman->findnodes("/domain/devices/disk/source");
 | |
|         my $disk;
 | |
|         foreach $disk (@purgedisks) {
 | |
| 	    my $disktype = $disk->parentNode()->getAttribute("device");
 | |
| 	    if ($disktype eq "cdrom") { next; }
 | |
|             my $file = $disk->getAttribute("file");
 | |
|             my $vol = $hypconn->get_storage_volume_by_path($file);
 | |
|             if ($vol) {
 | |
|                 $vol->delete();
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     eval { #try to fetch the domain by name even after it has been destroyed, if it is still there it needs an 'undefine'
 | |
|        $dom = $hypconn->get_domain_by_name($node);
 | |
|        $dom->undefine();
 | |
|     };
 | |
| 	
 | |
|     $updatetable->{kvm_nodedata}->{'!*XCATNODESTODELETE*!'}->{$node}=1;
 | |
| }
 | |
| sub chvm {
 | |
|     shift;
 | |
|     my @addsizes;
 | |
|     my %resize;
 | |
|     my $cpucount;
 | |
|     my @purge;
 | |
|     my @derefdisks;
 | |
|     my $memory;
 | |
|     my $cdrom;
 | |
|     my $eject;
 | |
|     @ARGV=@_;
 | |
|     require Getopt::Long;
 | |
|     GetOptions(
 | |
|         "a=s"=>\@addsizes,
 | |
|         "d=s"=>\@derefdisks,
 | |
|         "mem|memory=s"=>\$memory,
 | |
| 	"optical|dvd|cdrom=s"=>\$cdrom,
 | |
| 	"eject"=>\$eject,
 | |
|         "cpus|cpu=s" => \$cpucount,
 | |
|         "p=s"=>\@purge,
 | |
|         "resize=s%" => \%resize,
 | |
|         );
 | |
|     if (@derefdisks) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"Detach without purge TODO for kvm"],$callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     if (@addsizes and @purge) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"Currently adding and purging concurrently is not supported"],$callback,$node);
 | |
|         return;
 | |
|     }
 | |
| 
 | |
| 
 | |
|     my %useddisks;
 | |
|     my $dom;
 | |
|     eval {
 | |
|         $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     my $vmxml;
 | |
|     if ($dom) {
 | |
|         $vmxml=$dom->get_xml_description();
 | |
|     } else {
 | |
|         $vmxml=$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|     }
 | |
|     my $currstate=getpowstate($dom);
 | |
|     if (defined $confdata->{vm}->{$node}->[0]->{storage}) {
 | |
|         my $store;
 | |
|         foreach $store (split /\|/, $confdata->{vm}->{$node}->[0]->{storage}) {
 | |
|             $store =~ s/,.*//;
 | |
|             $store =~ s/=.*//;
 | |
|             if (($store =~ /^nfs:\/\//) || ($store =~ /^dir:\/\//) || ($store =~ /^lvm:/)) {
 | |
|                 my %disks = %{get_multiple_paths_by_url(url=>$store,node=>$node)};
 | |
|                 foreach (keys %disks) {
 | |
|                     $useddisks{$disks{$_}->{device}}=1;
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     if (@addsizes) { #need to add disks, first identify used devnames
 | |
|         my @diskstoadd;
 | |
|         my $location = $confdata->{vm}->{$node}->[0]->{storage};
 | |
|         $location =~ s/.*\|//; #use the rightmost location for making new devices
 | |
|         $location =~ s/,.*//; #no comma specified parameters are valid
 | |
|         $location =~ s/=(.*)//; #store model if specified here
 | |
|         my $model = $1;
 | |
|         unless ($model) {
 | |
|             #if not defined, model will stay undefined like above
 | |
|             $model = $confdata->{vm}->{$node}->[0]->{storagemodel}
 | |
|         }
 | |
|         my $prefix='hd';
 | |
|         if ($model eq 'scsi') {
 | |
|             $prefix='sd';
 | |
|         } elsif ($model eq 'virtio') {
 | |
|             $prefix='vd';
 | |
|         }
 | |
|         if ($prefix eq 'hd' and $currstate eq 'on') {
 | |
|             xCAT::SvrUtils::sendmsg("VM must be powered off to add IDE drives",$callback,$node);
 | |
|             next;
 | |
|         }
 | |
|         my @suffixes;
 | |
|         if ($prefix eq 'hd') { 
 | |
|             @suffixes=('a','b','d'..'zzz');
 | |
|         } else {
 | |
|             @suffixes=('a'..'zzz');
 | |
|         }
 | |
|         my @newsizes;
 | |
|         foreach (@addsizes) {
 | |
|             push @newsizes,split /,/,$_;
 | |
|         }
 | |
|         foreach (@newsizes) {
 | |
|             my $dev;
 | |
|             do {
 | |
|                 $dev = $prefix.shift(@suffixes);
 | |
|             } while ($useddisks{$dev});
 | |
|             #ok, now I need a volume created to attach
 | |
|             push @diskstoadd,get_filepath_by_url(url=>$location,dev=>$dev,create=>$_);
 | |
|         }
 | |
|         #now that the volumes are made, must build xml for each and attempt attach if and only if the VM is live
 | |
|         foreach (@diskstoadd) {
 | |
|             my $suffix;
 | |
|             my $format;
 | |
|             if (/^[^\.]*\.([^\.]*)\.([^\.]*)/) {
 | |
|                 $suffix=$1;
 | |
|                 $format=$2;
 | |
|             } elsif (/^[^\.]*\.([^\.]*)/) {
 | |
|                 $suffix=$1;
 | |
|                 $format='raw';
 | |
|             }
 | |
|             my $bus;
 | |
|             if ($suffix =~ /^sd/) {
 | |
|                 $bus='scsi';
 | |
|             } elsif ($suffix =~ /hd/) {
 | |
|                 $bus='ide';
 | |
|             } elsif ($suffix =~ /vd/) {
 | |
|                 $bus='virtio';
 | |
|             }
 | |
| 	    #when creating a new disk not cloned from anything, disable cache as copy on write content similarity is a lost cause...
 | |
|             my $xml = "<disk type='file' device='disk'><driver name='qemu' type='$format' cache='none'/><source file='$_'/><target dev='$suffix' bus='$bus'/></disk>";
 | |
|             if ($currstate eq 'on') { #attempt live attach
 | |
|               eval {
 | |
|               $dom->attach_device($xml);
 | |
|               };
 | |
|               if ($@) {
 | |
|                 my $err=$@;
 | |
|                 if ($err =~ /No more available PCI addresses/) {
 | |
|                     xCAT::SvrUtils::sendmsg([1,"Exhausted Virtio limits trying to add $_"],$callback,$node);
 | |
|                 } else {
 | |
|                     xCAT::SvrUtils::sendmsg([1,"Unable to attach $_ because of ".$err],$callback,$node);
 | |
|                 }
 | |
|                 my $file = $_;
 | |
|                 my $vol = $hypconn->get_storage_volume_by_path($file);
 | |
|                 if ($vol) {
 | |
|                     $vol->delete();
 | |
|                 }
 | |
|               }
 | |
|               $vmxml=$dom->get_xml_description();
 | |
|             } elsif ($confdata->{kvmnodedata}->{$node}->[0]->{xml}) { 
 | |
|                 $vmxml=$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|                 my $disknode = $parser->parse_balanced_chunk($xml);
 | |
|                 my $vmdoc = $parser->parse_string($vmxml);
 | |
|                 my $devicesnode = $vmdoc->findnodes("/domain/devices")->[0];
 | |
|                 $devicesnode->appendChild($disknode);
 | |
|                 $vmxml=$vmdoc->toString();
 | |
|             }
 | |
|             $updatetable->{kvm_nodedata}->{$node}->{xml}=$vmxml;
 | |
|         }
 | |
|     } elsif (@purge) {
 | |
|         my $dom;
 | |
|         eval {
 | |
|             $dom = $hypconn->get_domain_by_name($node);
 | |
|         };
 | |
|         my $vmxml;
 | |
|         if ($dom) {
 | |
|             $vmxml=$dom->get_xml_description();
 | |
|         } else {
 | |
|             $vmxml=$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|         }
 | |
|         my $currstate=getpowstate($dom);
 | |
|         my @disklist=get_disks_by_userspecs(\@purge,$vmxml,'returnmoddedxml');
 | |
|         my $moddedxml = shift @disklist;
 | |
|         foreach (@disklist) {
 | |
|             my $devxml=$_->[0];
 | |
|             my $file=$_->[1];
 | |
|             $file =~ m!/([^/]*)/($node\..*)\z!;
 | |
|             #first, detach the device.
 | |
|             eval {
 | |
|             if ($currstate eq 'on') { 
 | |
|                 $dom->detach_device($devxml); 
 | |
|                 $vmxml=$dom->get_xml_description();
 | |
|             } else {
 | |
|                 $vmxml=$moddedxml;
 | |
|             }
 | |
|             $updatetable->{kvm_nodedata}->{$node}->{xml}=$vmxml;
 | |
|             };
 | |
|             if ($@) {
 | |
|                 xCAT::SvrUtils::sendmsg([1,"Unable to remove device"],$callback,$node);
 | |
|             } else {
 | |
|                 #if that worked, remove the disk..
 | |
|                 my $vol = $hypconn->get_storage_volume_by_path($file);
 | |
|                 if ($vol) {
 | |
|                     $vol->delete();
 | |
|                 }
 | |
|             }
 | |
| 
 | |
|         }
 | |
|     } 
 | |
|     my $newcdxml;
 | |
|     if ($cdrom) {
 | |
|       my $cdpath;
 | |
|       if ($cdrom =~ m!://!) {
 | |
| 	my $url = $cdrom;
 | |
| 	$url =~ s!([^/]+)\z!!;
 | |
| 	my $imagename=$1;
 | |
| 	my $poolobj = get_storage_pool_by_url($url);
 | |
| 	unless ($poolobj) { die "Cound not get storage pool for $url"; }
 | |
| 	my $poolxml = $poolobj->get_xml_description(); #yes, I have to XML parse for even this...
 | |
| 	my $parsedpool = $parser->parse_string($poolxml);
 | |
| 	$cdpath = $parsedpool->findnodes("/pool/target/path/text()")->[0]->data;
 | |
| 	$cdpath .= "/".$imagename;
 | |
|       } else {
 | |
| 	if ($cdrom =~ m!^/dev/!) {
 | |
| 	  die "TODO: device pass through if anyone cares";
 | |
| 	} elsif ($cdrom =~ m!^/!) { #full path... I guess
 | |
| 	  $cdpath=$cdrom;
 | |
| 	} else {
 | |
| 	  die "TODO: relative paths, use client cwd as hint?";
 | |
| 	}
 | |
|       }
 | |
|       unless ($cdpath) { die "unable to understand cd path specification"; }
 | |
|       $newcdxml = "<disk type='file' device='cdrom'><source file='$cdpath'/><target dev='hdc'/><readonly/></disk>";
 | |
|     } elsif ($eject) {
 | |
|       $newcdxml = "<disk type='file' device='cdrom'><target dev='hdc'/><readonly/></disk>";
 | |
|     }
 | |
|     if ($newcdxml) {
 | |
|      if ($currstate eq 'on') { 
 | |
|          $dom->attach_device($newcdxml); 
 | |
|          $vmxml=$dom->get_xml_description();
 | |
|       } else {
 | |
| 	unless ($vmxml) {
 | |
| 	  $vmxml=$confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
| 	}
 | |
| 	my $domparsed = $parser->parse_string($vmxml);
 | |
| 	my $candidatenodes=$domparsed->findnodes("//disk[\@device='cdrom']");
 | |
| 	if (scalar (@$candidatenodes) != 1) {
 | |
| 	  die "shouldn't be possible, should only have one cdrom";
 | |
| 	}
 | |
| 	my $newcd=$parser->parse_balanced_chunk($newcdxml);
 | |
| 	$candidatenodes->[0]->replaceNode($newcd);
 | |
| 	my $moddedxml=$domparsed->toString;
 | |
| 	if ($moddedxml) {
 | |
| 	  $vmxml=$moddedxml;
 | |
| 	}
 | |
|       }
 | |
|       if ($vmxml) {
 | |
| 	$updatetable->{kvm_nodedata}->{$node}->{xml}=$vmxml;
 | |
|       }
 | |
|     }
 | |
|     if ($cpucount or $memory) {
 | |
|         if ($currstate eq 'on') {
 | |
|             if ($cpucount) {xCAT::SvrUtils::sendmsg([1,"Hot add of cpus not supported (VM must be powered down to successfuly change)"],$callback,$node); }
 | |
|             if ($cpucount) {
 | |
|                 #$dom->set_vcpus($cpucount); this didn't work out as well as I hoped..
 | |
|                 #xCAT::SvrUtils::sendmsg([1,"Hot add of cpus not supported"],$callback,$node);
 | |
|             }
 | |
|             if ($memory) {
 | |
| 		eval {
 | |
| 	                $dom->set_memory(getUnits($memory,"M",1024));
 | |
| 		};
 | |
| 		if ($@) {
 | |
| 			if ($@ =~ /cannot set memory higher/) {
 | |
| 				xCAT::SvrUtils::sendmsg([1,"Unable to increase memory beyond current capacity (requires VM to be powered down to change)"],$callback,$node);
 | |
| 			}
 | |
| 		} else {
 | |
| 			if ($confdata->{vm}->{$node}->[0]->{memory} and $confdata->{vm}->{$node}->[0]->{memory} != $memory) {
 | |
| 				$updatetable->{vm}->{$node}->{memory}=$memory;
 | |
| 			}
 | |
| 		}
 | |
|          	$vmxml=$dom->get_xml_description();
 | |
| 		if ($vmxml) {
 | |
|             		$updatetable->{kvm_nodedata}->{$node}->{xml}=$vmxml;
 | |
| 		}
 | |
|             }
 | |
|         } else { #offline xml edits
 | |
|             my $parsed=$parser->parse_string($vmxml); #TODO: should only do this once, oh well
 | |
|             if ($cpucount) {
 | |
|                 $parsed->findnodes("/domain/vcpu/text()")->[0]->setData($cpucount);
 | |
|             }
 | |
|             if ($memory) {
 | |
|                 $parsed->findnodes("/domain/memory/text()")->[0]->setData(getUnits($memory,"M",1024));
 | |
|                 my @currmem = $parsed->findnodes("/domain/currentMemory/text()");
 | |
|                 foreach (@currmem) {
 | |
|                     $_->setData(getUnits($memory,"M",1024));
 | |
|                 }
 | |
| 		if ($confdata->{vm}->{$node}->[0]->{memory} and $confdata->{vm}->{$node}->[0]->{memory} != $memory) {
 | |
| 			$updatetable->{vm}->{$node}->{memory}=$memory;
 | |
| 		}
 | |
| 
 | |
|             }
 | |
|             $vmxml=$parsed->toString;
 | |
|             $updatetable->{kvm_nodedata}->{$node}->{xml}=$vmxml;
 | |
|         }
 | |
|     }
 | |
| 
 | |
| }
 | |
| sub get_disks_by_userspecs {
 | |
|     my $specs = shift;
 | |
|     my $xml = shift;
 | |
|     my $returnmoddedxml=shift;
 | |
|     my $struct = XMLin($xml,forcearray=>1);
 | |
|     my $dominf = $parser->parse_string($xml);
 | |
|     my @disknodes = $dominf->findnodes('/domain/devices/disk');
 | |
|     my @returnxmls;
 | |
|     foreach my $spec (@$specs) {
 | |
|         my $disknode;
 | |
|         foreach $disknode (@disknodes) {
 | |
|             if ($spec =~ /^.d./) { #vda, hdb, sdc, etc, match be equality to target->{dev}
 | |
|                 if ($disknode->findnodes('./target')->[0]->getAttribute("dev") eq $spec) {
 | |
|                     push @returnxmls,[$disknode->toString(),$disknode->findnodes('./source')->[0]->getAttribute('file')];
 | |
|                     if ($returnmoddedxml) { 
 | |
|                         $disknode->parentNode->removeChild($disknode);
 | |
|                     }
 | |
|                 }
 | |
|             } elsif ($spec =~ /^d(.*)/) { #delete by scsi unit number..
 | |
|                 my $loc=$1;
 | |
|                 my $addr = $disknode->findnodes('./address')->[0];
 | |
|                 if ($loc =~ /:/) { #controller, bus, unit
 | |
|                     my $controller;
 | |
|                     my $bus;
 | |
|                     my $unit;
 | |
|                     ($controller,$bus,$unit) = split /:/,$loc;
 | |
|                     if (hex($addr->getAttribute('controller')) == hex($controller) and ($addr->getAttribute('bus')) == hex($bus) and ($addr->getAttribute('unit')) == hex($unit)) {
 | |
|                         push @returnxmls,[$disknode->toString(),$disknode->findnodes('./source')->[0]->getAttribute('file')];
 | |
|                         if ($returnmoddedxml) { 
 | |
|                             $disknode->parentNode->removeChild($disknode);
 | |
|                         }
 | |
|                     }
 | |
|                     
 | |
|                 } else { #match just on unit number, not helpful on ide as much generally, but whatever
 | |
|                     if (hex($addr->getAttribute('unit')) == hex($loc)) {
 | |
|                         push @returnxmls,[$disknode->toString(),$disknode->findnodes('./source')->[0]->getAttribute('file')];
 | |
|                         if ($returnmoddedxml) { 
 | |
|                             $disknode->parentNode->removeChild($disknode);
 | |
|                         }
 | |
|                     }
 | |
|                 }
 | |
|             } elsif ($spec =~ /^v(.*)/) { #virtio pci selector
 | |
|                 my $slot=$1;
 | |
|                 $slot =~ s/^(.*)://; #remove pci bus number (not used for now)
 | |
|                 my $bus=$1;
 | |
|                 $slot =~ s/\.0$//;
 | |
|                 my $addr=$disknode->findnodes('./address')->[0];
 | |
|                 if (hex($addr->getAttribute('slot')) == hex($slot) and hex($addr->getAttribute('bus') == hex($bus))) {
 | |
|                     push @returnxmls,[$disknode->toString(),$disknode->findnodes('./source')->[0]->getAttribute('file')];
 | |
|                     if ($returnmoddedxml) { 
 | |
|                         $disknode->parentNode->removeChild($disknode);
 | |
|                     }
 | |
|                 }
 | |
|             } #other formats TBD
 | |
|         }
 | |
|     }
 | |
|     if ($returnmoddedxml) {#there are list entries to delete
 | |
|         unshift @returnxmls,$dominf->toString();
 | |
|     }
 | |
|     return @returnxmls;
 | |
| }
 | |
| 
 | |
| sub promote_vm_to_master {
 | |
|     my %args=@_;
 | |
|     my $target=$args{target};
 | |
|     my $force=$args{force};
 | |
|     my $detach=$args{detach};
 | |
|     if ($target !~ m!://!) { #if not a url, use same place as source
 | |
|         my $sourcedir = $confdata->{vm}->{$node}->[0]->{storage};
 | |
|         $sourcedir =~ s/=.*//;
 | |
|         $sourcedir =~ s/,.*//;
 | |
|         $sourcedir =~ s!/\z!!;
 | |
|         $target = $sourcedir."/".$target;
 | |
|     }
 | |
|     unless ($target =~ /^nfs:\/\//) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"KVM plugin only has nfs://<server>/<path>/<mastername> support for cloning at this moment"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $dom;
 | |
|     eval {
 | |
|      $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     if ($dom and not $force) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"VM shut be shut down before attempting to clone (-f to copy unclean disks)"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $xml;
 | |
|     if ($dom) {
 | |
|         $xml = $dom->get_xml_description();
 | |
|         $detach=1; #can't rebase if vm is on
 | |
|     } else {
 | |
|         $xml = $confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|     }
 | |
|     unless ($xml) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"VM must be created before it can be cloned"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $parsedxml = $parser->parse_string($xml);
 | |
|     my($tmpnod) = $parsedxml->findnodes('/domain/uuid/text()');
 | |
|     if ($tmpnod) {
 | |
|         $tmpnod->setData("none"); #get rid of the VM specific uuid
 | |
|     }
 | |
| 
 | |
|     $target =~ m!^(.*)/([^/]*)\z!;
 | |
|     my $directory=$1;
 | |
|     my $mastername=$2;
 | |
| 
 | |
|     ($tmpnod) = $parsedxml->findnodes('/domain/name/text()');
 | |
|     if ($tmpnod) {
 | |
|         $tmpnod->setData($mastername); #name the xml whatever the master name is to be
 | |
|     }
 | |
|     foreach ($parsedxml->findnodes("/domain/devices/interface/mac")) { #clear all mac addresses 
 | |
|         if ($_->hasAttribute("address")) { $_->setAttribute("address"=>''); }
 | |
|     }
 | |
|     my $poolobj = get_storage_pool_by_url($directory);
 | |
|     unless ($poolobj) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"Unable to reach $directory from hypervisor"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     #arguments validated, on with our lives
 | |
| #firrder of business, calculate all the image names to be created and ensure none will conflict.
 | |
|     my @disks = $parsedxml->findnodes('/domain/devices/disk/source');
 | |
|     my %volclonemap;
 | |
|     foreach (@disks) {
 | |
|         my $filename = $_->getAttribute('file');
 | |
|         my $volname = $filename;
 | |
|         $volname =~ s!.*/!!; #perl is greedy by default
 | |
|         $volname =~ s/^$node/$mastername/;
 | |
|         my $novol;
 | |
|         eval { #use two evals, there is a chance the pool has a task blocking refresh like long-running clone.... libvirt should do better IMO, oh well
 | |
|             $poolobj->refresh();
 | |
|         };
 | |
|         eval {
 | |
|             $novol = $poolobj->get_volume_by_name($volname);
 | |
|         };
 | |
|         if ($novol) {
 | |
|             xCAT::SvrUtils::sendmsg([1,"$volname already exists in target storage pool"], $callback,$node);
 | |
|             return;
 | |
|         }
 | |
|         my $sourcevol;
 | |
|         eval {
 | |
|             $sourcevol = $hypconn->get_storage_volume_by_path($filename);
 | |
|         };
 | |
|         unless ($sourcevol) {
 | |
|             xCAT::SvrUtils::sendmsg([1,"Unable to access $filename to clone"], $callback,$node);
 | |
|             return;
 | |
|         }
 | |
|         $volclonemap{$filename}=[$sourcevol,$volname];
 | |
|         $filename = get_path_for_pool($poolobj);
 | |
|         $filename =~ s!/\z!!;
 | |
|         $filename .= '/'.$volname;
 | |
|         $_->setAttribute(file=>$filename);
 | |
|     }
 | |
|     foreach (keys %volclonemap) {
 | |
|         my $sourcevol = $volclonemap{$_}->[0];
 | |
|         my $targname = $volclonemap{$_}->[1];
 | |
|         my $format;
 | |
|         $targname =~ /([^\.]*)$/;
 | |
|         $format=$1;
 | |
|         my $newvol;
 | |
|         my %sourceinfo = %{$sourcevol->get_info()};
 | |
|         my $targxml = "<volume><name>$targname</name><target><format type='$format'/></target><capacity>".$sourceinfo{capacity}."</capacity></volume>";
 | |
|         xCAT::SvrUtils::sendmsg("Cloning ".$sourcevol->get_name()." (currently is ".($sourceinfo{allocation}/1048576)." MB and has a capacity of ".($sourceinfo{capacity}/1048576)."MB)",$callback,$node);
 | |
|         eval {
 | |
|             $newvol =$poolobj->clone_volume($targxml,$sourcevol);
 | |
|         };
 | |
|         if ($newvol) {
 | |
|             %sourceinfo = %{$newvol->get_info()};
 | |
|             xCAT::SvrUtils::sendmsg("Cloning of ".$sourcevol->get_name()." complete (clone uses ".($sourceinfo{allocation}/1048576)." for a disk size of ".($sourceinfo{capacity}/1048576)."MB)",$callback,$node);
 | |
|             unless ($detach) {
 | |
|                 my $rebasepath = $sourcevol->get_path();
 | |
|                 my $rebasename = $sourcevol->get_name();
 | |
|                 my $rebasepool = get_storage_pool_by_volume($sourcevol);
 | |
|                 unless ($rebasepool) {
 | |
|                     xCAT::SvrUtils::sendmsg([1,"Skipping rebase of $rebasename, unable to find correct storage pool"],$callback,$node);
 | |
|                     next;
 | |
|                 }
 | |
|                 xCAT::SvrUtils::sendmsg("Rebasing $rebasename from master",$callback,$node);
 | |
|                 $sourcevol->delete();
 | |
|                 my $newbasexml="<volume><name>$rebasename</name><target><format type='$format'/></target><capacity>".$sourceinfo{capacity}."</capacity><backingStore><path>".$newvol->get_path()."</path><format type='$format'/></backingStore></volume>";
 | |
|                 my $newbasevol;
 | |
|                 eval {
 | |
|                     $newbasevol = $rebasepool->create_volume($newbasexml);
 | |
|                 };
 | |
|                 if ($newbasevol) {
 | |
|                     xCAT::SvrUtils::sendmsg("Rebased $rebasename from master",$callback,$node);
 | |
|                 } else {
 | |
|                     xCAT::SvrUtils::sendmsg([1,"Critical failure, rebasing process failed halfway through, source VM trashed"],$callback,$node);
 | |
|                 }
 | |
|             }
 | |
|         } else {
 | |
|             xCAT::SvrUtils::sendmsg([1,"Cloning of ".$sourcevol->get_name()." failed due to ". $@],$callback,$node);
 | |
|             return;
 | |
|         }
 | |
|     }
 | |
|     my $mastertabentry={};
 | |
|     foreach (qw/os arch profile/) {
 | |
|         if (defined ($confdata->{nodetype}->{$node}->[0]->{$_})) {
 | |
|             $mastertabentry->{$_}=$confdata->{nodetype}->{$node}->[0]->{$_};
 | |
|         }
 | |
|     }
 | |
|     foreach (qw/storagemodel nics/) {
 | |
|         if (defined ($confdata->{vm}->{$node}->[0]->{$_})) {
 | |
|             $mastertabentry->{$_}=$confdata->{vm}->{$node}->[0]->{$_};
 | |
|         }
 | |
|     }
 | |
|     $mastertabentry->{storage}=$directory;
 | |
|     $mastertabentry->{vintage}=localtime;
 | |
|     $mastertabentry->{originator}=$requester;
 | |
|     unless ($detach) {
 | |
|         $updatetable->{vm}->{$node}->{master}=$mastername;
 | |
|     }
 | |
|     $updatetable->{vmmaster}->{$mastername}=$mastertabentry;
 | |
|     $updatetable->{kvm_masterdata}->{$mastername}->{xml} = $parsedxml->toString();
 | |
| }
 | |
| sub clonevm {
 | |
|     shift; #throw away node
 | |
|     @ARGV=@_;
 | |
|     my $target;
 | |
|     my $base;
 | |
|     my $detach;
 | |
|     my $force;
 | |
|     GetOptions(
 | |
|         'f' => \$force,
 | |
|         'b=s' => \$base,
 | |
|         't=s' => \$target,
 | |
|         'd' => \$detach,
 | |
|     );
 | |
|     if ($base and $target) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"Cannot specify both base (-b) and target (-t)"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     if ($target) { #we need to take a single vm and create a master out of it
 | |
|         return promote_vm_to_master(target=>$target,force=>$force,detach=>$detach);
 | |
|     } elsif ($base) {
 | |
|         return clone_vm_from_master(base=>$base,detach=>$detach);
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub clone_vm_from_master {
 | |
|     my %args = @_;
 | |
|     my $base=$args{base};
 | |
|     my $detach=$args{detach};
 | |
|     my $vmmastertab=xCAT::Table->new('vmmaster',-create=>0);
 | |
|     my $kvmmastertab = xCAT::Table->new('kvm_masterdata',-create=>0);
 | |
|     unless ($vmmastertab and $kvmmastertab) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"No KVM master images in tables"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $mastername=$base;
 | |
|     $mastername=~s!.*/!!; #shouldn't be needed, as storage is in there, but just in case
 | |
|     my $masteref=$vmmastertab->getAttribs({name=>$mastername},[qw/os arch profile storage storagemodel nics/]);
 | |
|     my $kvmmasteref=$kvmmastertab->getAttribs({name=>$mastername},['xml']);
 | |
|     unless ($masteref and $kvmmasteref) {
 | |
|         xCAT::SvrUtils::sendmsg([1,"KVM master $mastername not found in tables"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $newnodexml = $parser->parse_string($kvmmasteref->{xml});
 | |
|     $newnodexml->findnodes("/domain/name/text()")->[0]->setData($node); #set name correctly
 | |
|     my $uuid=getNodeUUID($node);
 | |
|     $newnodexml->findnodes("/domain/uuid/text()")->[0]->setData($uuid); #put in correct uuid
 | |
|     #set up mac addresses and such right...
 | |
|     fixup_clone_network(mastername=>$mastername,mastertableentry=>$masteref,kvmmastertableentry=>$kvmmasteref,xmlinprogress=>$newnodexml);
 | |
|     #ok, now the fun part, storage...
 | |
|     my $disk;
 | |
|     if ($masteref->{storage}) {
 | |
|         foreach (split /,/,$masteref->{storage}) {
 | |
|                 s/=.*//;
 | |
|                 get_storage_pool_by_url($_);
 | |
|         }
 | |
|     }
 | |
|     my $url;
 | |
|     if ($confdata->{vm}->{$node}->[0]->{storage}) {
 | |
|         unless ($confdata->{vm}->{$node}->[0]->{storage} =~ /^nfs:/) {
 | |
|             die "not implemented";
 | |
|         }
 | |
|         $url = $confdata->{vm}->{$node}->[0]->{storage};
 | |
|     } else {
 | |
|         $url = $masteref->{storage};
 | |
|         $updatetable->{vm}->{$node}->{storage}=$url;
 | |
|     }
 | |
|     if ($masteref->{storagemodel} and not $confdata->{vm}->{$node}->[0]->{storagemodel}) {
 | |
|         $updatetable->{vm}->{$node}->{storagemodel}=$masteref->{storagemodel};
 | |
|     }
 | |
|     $url =~ s/,.*//;
 | |
|     my $destinationpool = get_storage_pool_by_url($url);
 | |
|     foreach $disk ($newnodexml->findnodes("/domain/devices/disk")) {
 | |
| 	my ($source) = ($disk->findnodes("./source"));
 | |
| 	unless ($source) { next; } #most likely an empty cdrom
 | |
|         my $srcfilename = $source->getAttribute("file");
 | |
|         my $filename = $srcfilename;
 | |
|         $filename =~ s/^.*$mastername/$node/;
 | |
|         $filename =~ m!\.([^\.]*)\z!;
 | |
|         my $format=$1;
 | |
|         my $newvol;
 | |
|         if ($detach) {
 | |
|             my $sourcevol = $hypconn->get_storage_volume_by_path($srcfilename);
 | |
|             my %sourceinfo = %{$sourcevol->get_info()};
 | |
|             my $targxml = "<volume><name>$filename</name><target><format type='$format'/></target><capacity>".$sourceinfo{capacity}."</capacity></volume>";
 | |
|             xCAT::SvrUtils::sendmsg("Cloning ".$sourcevol->get_name()." (currently is ".($sourceinfo{allocation}/1048576)." MB and has a capacity of ".($sourceinfo{capacity}/1048576)."MB)",$callback,$node);
 | |
|             eval {
 | |
|              $newvol =$destinationpool->clone_volume($targxml,$sourcevol);
 | |
|             };
 | |
| 	    if ($@) {
 | |
| 		if ($@ =~ /already exists/) {
 | |
|                         return 1,"Storage creation request conflicts with existing file(s)";
 | |
| 		} else {
 | |
|                         return 1,"Unknown issue $@";
 | |
| 		}
 | |
| 	   }
 | |
|         } else {
 | |
|             my $sourcevol = $hypconn->get_storage_volume_by_path($srcfilename);
 | |
|             my %sourceinfo = %{$sourcevol->get_info()};
 | |
|             my $newbasexml="<volume><name>$filename</name><target><format type='$format'/></target><capacity>".$sourceinfo{capacity}."</capacity><backingStore><path>$srcfilename</path><format type='$format'/></backingStore></volume>";
 | |
| 	    eval {
 | |
|            $newvol = $destinationpool->create_volume($newbasexml);
 | |
| 		};
 | |
| 	    if ($@) {
 | |
| 		if ($@ =~ /already in use/) {
 | |
|                         return 1,"Storage creation request conflicts with existing file(s)";
 | |
| 		} else {
 | |
|                         return 1,"Unknown issue $@";
 | |
| 		}
 | |
| 	   }
 | |
|            $updatetable->{vm}->{$node}->{master}=$mastername;
 | |
|         }
 | |
|         my $newfilename=$newvol->get_path();
 | |
|         $disk->findnodes("./source")->[0]->setAttribute("file"=>$newfilename);
 | |
| 	if (not $detach) {  #if we are a copied image, enable writethrough cache in order to reduce trips out to disk
 | |
| 		 #but if the format is not qcow2, still leave it at 'none'
 | |
| 		my $type = $disk->findnodes("./driver")->[0]->getAttribute("type");
 | |
| 		if ($type eq "qcow2") { $disk->findnodes("./driver")->[0]->setAttribute("cache"=>"writethrough"); }
 | |
| 	}
 | |
| 		
 | |
|     }
 | |
|     my $textxml=$newnodexml->toString();
 | |
|     $updatetable->{kvm_nodedata}->{$node}->{xml}=$textxml;
 | |
| 
 | |
| }
 | |
| 
 | |
| sub fixup_clone_network {
 | |
|     my %args = @_;
 | |
|     my $newnodexml = $args{xmlinprogress};
 | |
|     my $mastername=$args{mastername};
 | |
|     my $masteref=$args{mastertableentry};
 | |
|     my $kvmmasteref=$args{kvmmastertableentry};
 | |
|     unless (ref ($confdata->{vm}->{$node})) {
 | |
|         $confdata->{vm}->{$node}=[{nics=>$masteref->{nics}}];
 | |
|         $updatetable->{vm}->{$node}->{nics}=$masteref->{nics};
 | |
|     }
 | |
|     unless ($confdata->{vm}->{$node}->[0]->{nics}) { #if no nic configuration yet, take the one stored in the master
 | |
|         $confdata->{vm}->{$node}->[0]->{nics}=$masteref->{nics};
 | |
|         $updatetable->{vm}->{$node}->{nics}=$masteref->{nics};
 | |
|     }
 | |
|     my @nics;
 | |
|     if ($confdata->{vm}->{$node}->[0]->{nics}) { #could still be empty if it came from master that way
 | |
|         @nics = split /,/,$confdata->{vm}->{$node}->[0]->{nics};
 | |
|     }
 | |
|     my @nicsinmaster = $newnodexml->findnodes("/domain/devices/interface");
 | |
|     if (scalar @nicsinmaster > scalar @nics) { #we don't have enough places to attach nics to..
 | |
|         xCAT::SvrUtils::sendmsg([1,"KVM master $mastername has ".scalar @nicsinmaster." but this vm only has ".scalar @nics." defined"], $callback,$node);
 | |
|         return;
 | |
|     }
 | |
|     my $nicstruct;
 | |
|     my @macs=xCAT::VMCommon::getMacAddresses($confdata,$node,scalar @nics);
 | |
|     foreach $nicstruct (@nicsinmaster) {
 | |
|         my $bridge = shift @nics;
 | |
|         $bridge =~ s/.*://;
 | |
|         $bridge =~ s/=.*//;
 | |
|         $nicstruct->findnodes("./mac")->[0]->setAttribute("address"=>shift @macs);
 | |
|         $nicstruct->findnodes("./source")->[0]->setAttribute("bridge"=>$bridge);
 | |
|     }
 | |
|     my $nic;
 | |
|     my $deviceroot=$newnodexml->findnodes("/domain/devices")->[0];
 | |
|     foreach $nic (@nics) { #need more xml to throw at it..
 | |
|         my $type = 'e1000'; #better default fake nic than rtl8139, relevant to most
 | |
|         $nic =~ s/.*://; #the detail of how the bridge was built is of no
 | |
|                         #interest to this segment of code
 | |
|         if ($confdata->{vm}->{$node}->[0]->{nicmodel}) {
 | |
|             $type = $confdata->{vm}->{$node}->[0]->{nicmodel};
 | |
|         }
 | |
|         if ($nic =~ /=/) {
 | |
|             ($nic,$type) = split /=/,$nic,2;
 | |
|         }
 | |
|         my $xmlsnippet = "<interface type='bridge'><mac address='".(shift @macs)."'/><source bridge='".$nic."'/><model type='$type'/></interface>";
 | |
|         my $chunk = $parser->parse_balanced_chunk($xmlsnippet);
 | |
|         $deviceroot->appendChild($chunk);
 | |
|     }
 | |
| }
 | |
| sub mkvm {
 | |
|  shift; #Throuw away first argument
 | |
|  @ARGV=@_;
 | |
|  my $disksize;
 | |
|  my $mastername;
 | |
|  my $force=0;
 | |
|  require Getopt::Long;
 | |
|  my $memory;
 | |
|  my $cpucount;
 | |
|  GetOptions(
 | |
|     'master|m=s'=>\$mastername,
 | |
|     'size|s=s'=>\$disksize,
 | |
|     "mem=s"=>\$memory,
 | |
|     "cpus=s" => \$cpucount,
 | |
|     'force|f'=>\$force
 | |
|  );
 | |
|  if (defined $confdata->{vm}->{$node}->[0]->{storage}) {
 | |
|     my $diskname=$confdata->{vm}->{$node}->[0]->{storage};
 | |
|     if ($diskname =~ /^phy:/) { #in this case, mkvm should have no argumens
 | |
|         if ($mastername or $disksize) {
 | |
|             return 1,"mkvm management of block device storage not implemented";
 | |
|         }
 | |
|     }
 | |
|     #print "force=$force\n";
 | |
|        my @return;
 | |
|     if ($mastername or $disksize) {
 | |
| 	eval {
 | |
| 	@return = createstorage($diskname,$mastername,$disksize,$confdata->{vm}->{$node}->[0],$force);
 | |
| 	};
 | |
| 	if ($@) {
 | |
|                 if ($@ =~ /ath already exists/) {
 | |
|                         return 1,"Storage creation request conflicts with existing file(s)";
 | |
|                 } else {
 | |
|                         return 1,"Unknown issue $@";
 | |
|                 }
 | |
|           }
 | |
| 
 | |
|          unless ($confdata->{kvmnodedata}->{$node} and $confdata->{kvmnodedata}->{$node}->[0] and $confdata->{kvmnodedata}->{$node}->[0]->{xml}) {
 | |
|              my $xml;
 | |
|              $xml = build_xmldesc($node,cpus=>$cpucount,memory=>$memory);
 | |
|              $updatetable->{kvm_nodedata}->{$node}->{xml}=$xml;
 | |
|          }
 | |
|     }
 | |
|          my $xml;
 | |
|     if ($confdata->{kvmnodedata}->{$node} and $confdata->{kvmnodedata}->{$node}->[0] and $confdata->{kvmnodedata}->{$node}->[0]->{xml}) {
 | |
|     	$xml = $confdata->{kvmnodedata}->{$node}->[0]->{xml};
 | |
|     } else { # ($confdata->{kvmnodedata}->{$node} and $confdata->{kvmnodedata}->{$node}->[0] and $confdata->{kvmnodedata}->{$node}->[0]->{xml}) {
 | |
|          $xml = build_xmldesc($node,cpus=>$cpucount,memory=>$memory);
 | |
|          $updatetable->{kvm_nodedata}->{$node}->{xml}=$xml;
 | |
|     }
 | |
| 	 if ($::XCATSITEVALS{persistkvmguests}) {
 | |
| 	 	$hypconn->define_domain($xml);
 | |
| 	}
 | |
|          return @return;
 | |
|  } else {
 | |
|      if ($mastername or $disksize) {
 | |
|          return 1,"Requested initialization of storage, but vm.storage has no value for node";
 | |
|      }
 | |
|  }
 | |
| }
 | |
| sub power {
 | |
|     @ARGV=@_;
 | |
|     require Getopt::Long;
 | |
|     my $cdloc;
 | |
|     GetOptions('cdrom|iso|c|i=s'=>\$cdloc);
 | |
|     my $subcommand = shift @ARGV;
 | |
|     my $retstring;
 | |
|     my $dom;
 | |
|     eval {
 | |
|      $dom = $hypconn->get_domain_by_name($node);
 | |
|     };
 | |
|     if ($subcommand eq "boot") {
 | |
|         my $currstate=getpowstate($dom);
 | |
|         $retstring=$currstate." ";
 | |
|         if ($currstate eq "off") {
 | |
|             $subcommand="on";
 | |
|         } elsif ($currstate eq "on") {
 | |
|             $subcommand="reset";
 | |
|         }
 | |
|     }
 | |
|     my $errstr;
 | |
|     if ($subcommand eq 'on') {
 | |
|         unless ($dom) {
 | |
|             if ($use_xhrm) {
 | |
|                 if (xhrm_satisfy($node,$hyp)) {
 | |
| 			return (1,"Failure satisfying networking and storage requirements on $hyp for $node");
 | |
| 		} 
 | |
|             }
 | |
| #TODO: here, storage validation is not necessarily performed, consequently, must explicitly do storage validation
 | |
| #this worked before I started doing the offline xml store because every rpower on tried to rebuild
 | |
|             ($dom,$errstr) = makedom($node,$cdloc);
 | |
|             if ($errstr) { return (1,$errstr); }
 | |
|         } elsif (not $dom->is_active()) {
 | |
| 		$dom->create();
 | |
|         } else {
 | |
|           $retstring .= "$status_noop";
 | |
|         }
 | |
|     } elsif ($subcommand eq 'off') {
 | |
|         if ($dom) {
 | |
|             my $newxml=$dom->get_xml_description();
 | |
|             $updatetable->{kvm_nodedata}->{$node}->{xml}=$newxml;
 | |
| 	    if ($dom->is_active()) { 
 | |
|             	$dom->destroy();
 | |
| 	    }
 | |
|             undef $dom;
 | |
|         } else { $retstring .= "$status_noop"; }
 | |
|     } elsif ($subcommand eq 'softoff') {
 | |
|         if ($dom) {
 | |
|             my $newxml=$dom->get_xml_description();
 | |
|             $updatetable->{kvm_nodedata}->{$node}->{xml}=$newxml;
 | |
|             $dom->shutdown();
 | |
|         } else { $retstring .= "$status_noop"; } 
 | |
|     } elsif ($subcommand eq 'reset') {
 | |
|         if ($dom) {
 | |
|             my $oldxml=$dom->get_xml_description();
 | |
|             my $newxml=reconfigvm($node,$oldxml);
 | |
|             #This *was* to be clever, but libvirt doesn't even frontend the capability, great...
 | |
|             unless ($newxml) { $newxml=$oldxml; } #TODO: remove this when the 'else' line can be sanely filled out
 | |
|             if ($newxml) { #need to destroy and repower..
 | |
|                 $updatetable->{kvm_nodedata}->{$node}->{xml}=$newxml;
 | |
| 		my $persist = $dom->is_persistent();
 | |
|                 $dom->destroy();
 | |
| 		if ($persist) { $dom->undefine(); }
 | |
|                 undef $dom;
 | |
|                 if ($use_xhrm) {
 | |
|                     xhrm_satisfy($node,$hyp);
 | |
|                 }
 | |
|                 ($dom,$errstr) = makedom($node,$cdloc,$newxml);
 | |
|                 if ($errstr) { return (1,$errstr); }
 | |
|             } else { #no changes, just restart the domain TODO when possible, stupid lack of feature...
 | |
|             }
 | |
|             $retstring.="reset";
 | |
|         } else { $retstring .= "$status_noop"; } 
 | |
|     } else { 
 | |
|         unless ($subcommand =~ /^stat/) {
 | |
|             return (1,"Unsupported power directive '$subcommand'");
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     unless ($retstring =~ /reset/) {
 | |
|         $retstring=$retstring.getpowstate($dom);
 | |
|     }
 | |
|     return (0,$retstring);
 | |
| }
 | |
| 
 | |
| sub lsvm {
 | |
|     my $node = shift;
 | |
|     my @doms = $hypconn->list_domains();
 | |
|     my @vms;
 | |
|     foreach (@doms) {
 | |
|         push @vms,$_->get_name();
 | |
|     }
 | |
|     return (0,@vms);
 | |
| }
 | |
| 
 | |
| 
 | |
| sub guestcmd {
 | |
|   $hyp = shift;
 | |
|   $node = shift;
 | |
|   my $command = shift;
 | |
|   my @args = @_;
 | |
|   my $error;
 | |
|   if ($command eq "rpower") {
 | |
|     return power(@args);
 | |
|   } elsif ($command eq "mkvm") {
 | |
|       return mkvm($node,@args);
 | |
|   } elsif ($command eq "clonevm") {
 | |
|       return clonevm($node,@args);
 | |
|   } elsif ($command eq "chvm") {
 | |
|       return chvm($node,@args);
 | |
|   } elsif ($command eq "rmvm") {
 | |
|       return rmvm($node,@args);
 | |
|   } elsif ($command eq "rinv") {
 | |
|       return rinv($node,@args);
 | |
|   } elsif ($command eq "rmigrate") {
 | |
|       return migrate($node,@args);
 | |
|   } elsif ($command eq "getrvidparms") {
 | |
|       return getrvidparms($node,@args);
 | |
|   } elsif ($command eq "getcons") {
 | |
|       return getcons($node,@args);
 | |
|   } elsif ($command eq "lsvm") {
 | |
|       return lsvm($node,@args);
 | |
|   }
 | |
| =cut
 | |
|   } elsif ($command eq "rvitals") {
 | |
|     return vitals(@args);
 | |
|   } elsif ($command =~ /r[ms]preset/) {
 | |
|     return resetmp(@args);
 | |
|   } elsif ($command eq "rspconfig") {
 | |
|     return mpaconfig($mpa,$user,$pass,$node,$slot,@args);
 | |
|   } elsif ($command eq "rbootseq") {
 | |
|     return bootseq(@args);
 | |
|   } elsif ($command eq "switchblade") {
 | |
|      return switchblade(@args);
 | |
|   } elsif ($command eq "getmacs") {
 | |
|     return getmacs(@args);
 | |
|   } elsif ($command eq "rinv") {
 | |
|     return inv(@args);
 | |
|   } elsif ($command eq "reventlog") {
 | |
|     return eventlog(@args);
 | |
|   } elsif ($command eq "rscan") {
 | |
|     return rscan(\@args);
 | |
|   }
 | |
|   
 | |
| =cut
 | |
|   return (1,"$command not a supported command by kvm method");
 | |
| }
 | |
| 
 | |
| sub preprocess_request { 
 | |
|   my $request = shift;
 | |
|   if ($request->{_xcatpreprocessed}->[0] == 1) { return [$request]; }
 | |
|   my $callback=shift;
 | |
|   my @requests;
 | |
| 
 | |
|   my $noderange = $request->{node}; #Should be arrayref
 | |
|   my $command = $request->{command}->[0];
 | |
|   my $extrargs = $request->{arg};
 | |
|   my @exargs=($request->{arg});
 | |
|   if (ref($extrargs)) {
 | |
|     @exargs=@$extrargs;
 | |
|   }
 | |
| 
 | |
|   my $usage_string=xCAT::Usage->parseCommand($command, @exargs);
 | |
|   if ($usage_string) {
 | |
|     $callback->({data=>$usage_string});
 | |
|     $request = {};
 | |
|     return;
 | |
|   }
 | |
| 
 | |
|   if (!$noderange) {
 | |
|     $usage_string=xCAT::Usage->getUsage($command);
 | |
|     $callback->({data=>$usage_string});
 | |
|     $request = {};
 | |
|     return;
 | |
|   }   
 | |
|   
 | |
|   #print "noderange=@$noderange\n";
 | |
| 
 | |
|   # find service nodes for requested nodes
 | |
|   # build an individual request for each service node
 | |
|   my $service  = "xcat";
 | |
|   my $sn = xCAT::ServiceNodeUtils->get_ServiceNode($noderange, $service, "MN");
 | |
| 
 | |
|   # build each request for each service node
 | |
| 
 | |
|   foreach my $snkey (keys %$sn)
 | |
|   {
 | |
|     #print "snkey=$snkey\n";
 | |
|     my $reqcopy = {%$request};
 | |
|     $reqcopy->{node} = $sn->{$snkey};
 | |
|     $reqcopy->{'_xcatdest'} = $snkey;
 | |
|     $reqcopy->{_xcatpreprocessed}->[0] = 1;
 | |
|     push @requests, $reqcopy;
 | |
|   }
 | |
|   return \@requests;
 | |
| }
 | |
|  
 | |
|     
 | |
| sub adopt {
 | |
|     my $orphash = shift;
 | |
|     my $hyphash = shift;
 | |
|     my %addmemory = ();
 | |
|     my $node;
 | |
|     my $target;
 | |
|     my $vmupdates;
 | |
|     foreach $node (keys %{$orphash}) {
 | |
|         $target=pick_target($node,\%addmemory);
 | |
|         unless ($target) {
 | |
|             next;
 | |
|         }
 | |
|         if ($confdata->{vm}->{$node}->[0]->{memory}) {
 | |
|             $addmemory{$target}+=getUnits($confdata->{vm}->{$node}->[0]->{memory},"M",1024);
 | |
|         } else {
 | |
|             $addmemory{$target}+=getUnits("512","M",1024);
 | |
|         }
 | |
|         $hyphash{$target}->{nodes}->{$node}=1;
 | |
|         delete $orphash->{$node};
 | |
|         $vmupdates->{$node}->{host}=$target;
 | |
|     }
 | |
|     unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>1); }
 | |
|     $vmtab->setNodesAttribs($vmupdates);
 | |
|     if (keys %{$orphash}) {
 | |
|         return 0;
 | |
|     } else { 
 | |
|         return 1;
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub process_request { 
 | |
|   $SIG{INT} = $SIG{TERM} = sub { 
 | |
|      foreach (keys %vm_comm_pids) {
 | |
|         kill 2, $_;
 | |
|      }
 | |
|      exit 0;
 | |
|   };
 | |
|   unless ($parser) {
 | |
|       $parser = XML::LibXML->new();
 | |
|   }
 | |
|   %offlinehyps=();
 | |
|   %hypstats=();
 | |
|   %offlinevms=();
 | |
|   my $request = shift;
 | |
|   if ($request->{_xcat_authname}->[0]) {
 | |
|       $requester=$request->{_xcat_authname}->[0];
 | |
|   }
 | |
|   $callback = shift;
 | |
|   unless ($libvirtsupport) {
 | |
|       $libvirtsupport = eval { 
 | |
|       require Sys::Virt; 
 | |
|       if (Sys::Virt->VERSION < "0.2.0") {
 | |
|           die;
 | |
|       }
 | |
|       1;
 | |
|       };
 | |
|   }
 | |
|   unless ($libvirtsupport) { #Still no Sys::Virt module
 | |
|       $callback->({error=>"Sys::Virt perl module missing or older than 0.2.0, unable to fulfill KVM plugin requirements",errorcode=>[42]});
 | |
|       return [];
 | |
|   }
 | |
|   require Sys::Virt::Domain;
 | |
|   %runningstates = (&Sys::Virt::Domain::STATE_NOSTATE=>1,&Sys::Virt::Domain::STATE_RUNNING=>1,&Sys::Virt::Domain::STATE_BLOCKED=>1);
 | |
| 
 | |
|   $doreq = shift;
 | |
|   my $level = shift;
 | |
|   my $noderange = $request->{node};
 | |
|   my $command = $request->{command}->[0];
 | |
|   my @exargs;
 | |
|   unless ($command) {
 | |
|      return; #Empty request
 | |
|   }
 | |
|   if (ref($request->{arg})) {
 | |
|     @exargs = @{$request->{arg}};
 | |
|   } else {
 | |
|     @exargs = ($request->{arg});
 | |
|   }
 | |
|   my $forcemode = 0;
 | |
|   my %orphans=();
 | |
|   if ($command eq 'vmstatenotify') {
 | |
|       unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>1); }
 | |
|       my $state = $exargs[0];
 | |
|       if ($state eq 'vmoff') {
 | |
|           $vmtab->setNodeAttribs($exargs[1],{powerstate=>'off'});
 | |
|           return;
 | |
|       } elsif ($state eq 'vmon') {
 | |
|           $vmtab->setNodeAttribs($exargs[1],{powerstate=>'on'});
 | |
|           return;
 | |
|       } elsif ($state eq 'hypshutdown') { #turn this into an evacuate
 | |
|           my $nodelisttab = xCAT::Table->new('nodelist');
 | |
|           my $appstatus = $nodelisttab->getNodeAttribs($noderange->[0],['appstatus']);
 | |
|           my @apps =split /,/,$appstatus->{'appstatus'};
 | |
|           my @newapps;
 | |
|           foreach (@apps) {
 | |
|               if ($_ eq 'virtualization') { next; }
 | |
|               push @newapps,$_;
 | |
|           }
 | |
|           $nodelisttab->setNodeAttribs($noderange->[0],{appstatus=>join(',',@newapps)});
 | |
|           $command="revacuate";
 | |
|           @exargs=();
 | |
|       } elsif ($state eq 'hypstartup') { #if starting up, check for nodes on this hypervisor and start them up
 | |
|           my $nodelisttab = xCAT::Table->new('nodelist');
 | |
|           my $appstatus = $nodelisttab->getNodeAttribs($noderange->[0],['appstatus']);
 | |
|           my @apps =split /,/,$appstatus->{appstatus};
 | |
|           unless (grep {$_ eq 'virtualization'} @apps) {
 | |
|               push @apps,'virtualization';
 | |
|               $nodelisttab->setNodeAttribs($noderange->[0],{appstatus=>join(',',@apps)});
 | |
|           }
 | |
|           my @tents = $vmtab->getAttribs({host=>$noderange->[0],power=>'on'},['node']);
 | |
|           $noderange=[];
 | |
|           foreach (@tents) {
 | |
|               push @$noderange,noderange($_->{node});
 | |
|           }
 | |
|           $command="rpower";
 | |
|           @exargs=("on");
 | |
|       }
 | |
| 
 | |
|   }
 | |
|   if ($command eq 'revacuate') {
 | |
|       my $newnoderange;
 | |
|       if (grep { $_ eq '-f' } @exargs) {
 | |
|           $forcemode=1;
 | |
|       }
 | |
|       foreach (@$noderange) {
 | |
|         my $hyp = $_; #I used $_ too much here... sorry
 | |
|         $hypconn=undef;
 | |
|         push @destblacklist,$_;
 | |
|         if ((not $offlinehyps{$_}) and nodesockopen($_,22)) {
 | |
|             eval { #Contain bugs that won't be in $@
 | |
|                 $hypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$_."/system?no_tty=1&netcat=nc");
 | |
|             };
 | |
|             unless ($hypconn) { #retry for socat
 | |
|                 eval { #Contain bugs that won't be in $@
 | |
|                     $hypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$_."/system?no_tty=1");
 | |
|                 };
 | |
|             }
 | |
|         }
 | |
|         unless ($hypconn)  {
 | |
|             $offlinehyps{$hyp}=1;
 | |
|             if ($forcemode) { #forcemode indicates the hypervisor is probably already dead, and to clear vm.host of all the nodes, and adopt the ones that are supposed to be 'on', power them on
 | |
|                 unless ($vmtab) { $vmtab = new xCAT::Table('vm',-create=>0); }
 | |
|                 unless ($vmtab) { next; }
 | |
|                 my @vents = $vmtab->getAttribs({host=>$hyp},['node','powerstate']);
 | |
|                 my $vent;
 | |
|                 my $nodestozap;
 | |
|                 foreach $vent (@vents) {
 | |
|                     my @nodes = noderange($vent->{node});
 | |
|                     if ($vent->{powerstate} eq 'on') {
 | |
|                         foreach (@nodes) { 
 | |
|                             $offlinevms{$_}=1;
 | |
|                             $orphans{$_}=1; 
 | |
|                             push @$newnoderange,$_;
 | |
|                         }
 | |
|                     }
 | |
|                     push @$nodestozap,@nodes;
 | |
|                 }
 | |
|                 $vmtab->setNodesAttribs($nodestozap,{host=>'|^.*$||'});
 | |
|             } else {
 | |
|                 $callback->({node=>[{name=>[$_],error=>["Cannot communicate via libvirt to node"]}]});
 | |
|             }
 | |
|             next;
 | |
|         }
 | |
|         if ($hypconn) {
 | |
|             foreach ($hypconn->list_domains()) {
 | |
|                 my $guestname = $_->get_name();
 | |
|                 if ($guestname eq 'Domain-0') {
 | |
|                     next;
 | |
|                 }
 | |
|                 push @$newnoderange,$guestname;
 | |
|             }
 | |
|         }
 | |
|       }
 | |
|       $hypconn=undef;
 | |
|       $noderange = $newnoderange;
 | |
|       $command = 'rmigrate';
 | |
|   }
 | |
| 
 | |
|   if ($::XCATSITEVALS{usexhrm}) { $use_xhrm=1; }
 | |
|   $vmtab = xCAT::Table->new("vm");
 | |
|   $confdata={};
 | |
|   unless ($command eq 'lsvm') { 
 | |
| 	xCAT::VMCommon::grab_table_data($noderange,$confdata,$callback); 
 | |
|   my $kvmdatatab = xCAT::Table->new("kvm_nodedata",-create=>0); #grab any pertinent pre-existing xml
 | |
|   if ($kvmdatatab) {
 | |
|       $confdata->{kvmnodedata} = $kvmdatatab->getNodesAttribs($noderange,[qw/xml/]);
 | |
|   } else {
 | |
|       $confdata->{kvmnodedata} = {};
 | |
|   }
 | |
|   }
 | |
|   if ($command eq 'mkvm' or ($command eq 'clonevm' and (grep { "$_" eq '-b' } @exargs)) or ($command eq 'rpower' and (grep { "$_" eq "on"  or $_ eq "boot" or $_ eq "reset" } @exargs))) {
 | |
|       xCAT::VMCommon::requestMacAddresses($confdata,$noderange);
 | |
|       my @dhcpnodes;
 | |
|       foreach (keys %{$confdata->{dhcpneeded}}) {
 | |
|         push @dhcpnodes,$_;
 | |
|         delete $confdata->{dhcpneeded}->{$_};
 | |
|      }
 | |
|      unless ($::XCATSITEVALS{'dhcpsetup'} and ($::XCATSITEVALS{'dhcpsetup'} =~ /^n/i or $::XCATSITEVALS{'dhcpsetup'} =~ /^d/i or $::XCATSITEVALS{'dhcpsetup'} eq '0')) {
 | |
|         $doreq->({command=>['makedhcp'],node=>\@dhcpnodes});
 | |
|      }
 | |
|   }
 | |
| 
 | |
|   if ($command eq 'revacuate' or $command eq 'rmigrate') {
 | |
|       $vmmaxp=1; #for now throttle concurrent migrations, requires more sophisticated heuristics to ensure sanity
 | |
|   } else {
 | |
|       my $tmp;
 | |
|       if ($::XCATSITEVALS{vmmaxp}) { $vmmaxp=$::XCATSITEVALS{vmmaxp}; }
 | |
|   }
 | |
| 
 | |
|   my $children = 0;
 | |
|   $SIG{CHLD} = sub { my $cpid; while (($cpid = waitpid(-1, WNOHANG)) > 0) { if ($vm_comm_pids{$cpid}) { delete $vm_comm_pids{$cpid}; $children--; } } };
 | |
|   my $inputs = new IO::Select;;
 | |
|   my $sub_fds = new IO::Select;
 | |
|   %hyphash=();
 | |
|   if ($command eq 'lsvm') { #command intended for hypervisors, not guests
 | |
|       foreach(@$noderange) { $hyphash{$_}->{nodes}->{$_}=1; }
 | |
|   } else {
 | |
|       foreach (keys %{$confdata->{vm}}) {
 | |
|           if ($confdata->{vm}->{$_}->[0]->{host}) {
 | |
|               $hyphash{$confdata->{vm}->{$_}->[0]->{host}}->{nodes}->{$_}=1;
 | |
|           } else {
 | |
|               $orphans{$_}=1;
 | |
|           }
 | |
|       }
 | |
|   }
 | |
|   if (keys %orphans) {
 | |
|       if ($command eq "rpower") {
 | |
|           if (grep /^on$/,@exargs or grep /^boot$/,@exargs) {
 | |
|             unless (adopt(\%orphans,\%hyphash)) {
 | |
|                 $callback->({error=>"Can't find ".join(",",keys %orphans),errorcode=>[1]});
 | |
|                 return 1;
 | |
|               }
 | |
|           } else {
 | |
|               foreach (keys %orphans) {
 | |
|                   $callback->({node=>[{name=>[$_],data=>[{contents=>['off']}]}]});
 | |
|               }
 | |
|           }
 | |
|       } elsif ($command eq "rmigrate") {
 | |
|           if ($forcemode) {
 | |
|             unless (adopt(\%orphans,\%hyphash)) {
 | |
|                 $callback->({error=>"Can't find ".join(",",keys %orphans),errorcode=>[1]});
 | |
|                 return 1;
 | |
|               }
 | |
|           } else {
 | |
|             $callback->({error=>"Can't find ".join(",",keys %orphans),errorcode=>[1]});
 | |
|             return;
 | |
|           }
 | |
|       } elsif ($command eq "mkvm" or $command eq "clonevm") { #must adopt to create
 | |
|             unless (adopt(\%orphans,\%hyphash)) {
 | |
|                 $callback->({error=>"Can't find ".join(",",keys %orphans),errorcode=>[1]});
 | |
|                 return 1;
 | |
|               }
 | |
|           #mkvm used to be able to happen devoid of any hypervisor, make a fake hypervisor entry to allow this to occur
 | |
|           #commenting that out for now
 | |
| #          foreach (keys %orphans) {
 | |
| #              $hyphash{'!@!XCATDUMMYHYPERVISOR!@!'}->{nodes}->{$_}=1;
 | |
| #          }
 | |
|       } else {
 | |
|           $callback->({error=>"Can't find ".join(",",keys %orphans),errorcode=>[1]});
 | |
|           return;
 | |
|       }
 | |
|   }
 | |
|   if ($command eq "rbeacon") {
 | |
|       my %req=();
 | |
|       $req{command}=['rbeacon'];
 | |
|       $req{arg}=\@exargs;
 | |
|       $req{node}=[keys %hyphash];
 | |
|       $doreq->(\%req,$callback);
 | |
|       return;
 | |
|   }
 | |
| 
 | |
|   #get new node status
 | |
|   my %oldnodestatus=(); #saves the old node status
 | |
|   my @allerrornodes=();
 | |
|   my $check=0;
 | |
|   my $global_check=1;
 | |
|   if ($::XCATSITEVALS{nodestatus} =~ /0|n|N/) { $global_check=0; }
 | |
| 
 | |
| 
 | |
|   if ($command eq 'rpower') {
 | |
|     my $subcommand=$exargs[0];
 | |
|     if (($global_check) && ($subcommand ne 'stat') && ($subcommand ne 'status')) { 
 | |
|       $check=1; 
 | |
|       my @allnodes=@$noderange;
 | |
| 
 | |
|       #save the old status
 | |
|       my $nodelisttab = xCAT::Table->new('nodelist');
 | |
|       if ($nodelisttab) {
 | |
|         my $tabdata     = $nodelisttab->getNodesAttribs(\@allnodes, ['node', 'status']);
 | |
|         foreach my $node (@allnodes)
 | |
|         {
 | |
|             my $tmp1 = $tabdata->{$node}->[0];
 | |
|             if ($tmp1) { 
 | |
| 		if ($tmp1->{status}) { $oldnodestatus{$node}=$tmp1->{status}; }
 | |
| 		else { $oldnodestatus{$node}=""; }
 | |
| 	    }
 | |
| 	}
 | |
|       }
 | |
|       #print "oldstatus:" . Dumper(\%oldnodestatus);
 | |
|       
 | |
|       #set the new status to the nodelist.status
 | |
|       my %newnodestatus=(); 
 | |
|       my $newstat;
 | |
|       if (($subcommand eq 'off') || ($subcommand eq 'softoff')) { 
 | |
| 	  my $newstat=$::STATUS_POWERING_OFF; 
 | |
| 	  $newnodestatus{$newstat}=\@allnodes;
 | |
|       } else {
 | |
|         #get the current nodeset stat
 | |
|         if (@allnodes>0) {
 | |
| 	  my $nsh={};
 | |
|           my ($ret, $msg)=xCAT::SvrUtils->getNodesetStates(\@allnodes, $nsh);
 | |
|           if (!$ret) { 
 | |
|             foreach (keys %$nsh) {
 | |
| 		my $newstat=xCAT_monitoring::monitorctrl->getNodeStatusFromNodesetState($_, "rpower");
 | |
| 		$newnodestatus{$newstat}=$nsh->{$_};
 | |
| 	    }
 | |
| 	  } else {
 | |
| 	      $callback->({data=>$msg});
 | |
| 	  }
 | |
|         }
 | |
|       }
 | |
|       #print "newstatus" . Dumper(\%newnodestatus);
 | |
|       xCAT_monitoring::monitorctrl::setNodeStatusAttributes(\%newnodestatus, 1);
 | |
|     }
 | |
|   }
 | |
| 
 | |
|   if ($::XCATSITEVALS{masterimgdir}) { $xCAT_plugin::kvm::masterdir=$::XCATSITEVALS{masterimgdir} }
 | |
| 
 | |
| 
 | |
| 
 | |
|   foreach $hyp (sort (keys %hyphash)) {
 | |
|     while ($children > $vmmaxp) { 
 | |
|       my $handlednodes={};
 | |
|       forward_data($callback,$sub_fds,$handlednodes);
 | |
|       #update the node status to the nodelist.status table
 | |
|       if ($check) {
 | |
|         updateNodeStatus($handlednodes, \@allerrornodes);
 | |
|       }
 | |
|     }
 | |
|     $children++;
 | |
|     my $cfd;
 | |
|     my $pfd;
 | |
|     socketpair($pfd, $cfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
 | |
|     $cfd->autoflush(1);
 | |
|     $pfd->autoflush(1);
 | |
|     my $cpid = xCAT::Utils->xfork;
 | |
|     unless (defined($cpid)) { die "Fork error"; }
 | |
|     unless ($cpid) {
 | |
|       close($cfd);
 | |
|       dohyp($pfd,$hyp,$command,-args=>\@exargs);
 | |
|       exit(0);
 | |
|     }
 | |
|     $vm_comm_pids{$cpid} = 1;
 | |
|     close ($pfd);
 | |
|     $sub_fds->add($cfd);
 | |
|   }
 | |
|   while ($sub_fds->count > 0) { # or $children > 0) { #if count is zero, even if we have live children, we can't possibly get data from them
 | |
|     my $handlednodes={};
 | |
|     forward_data($callback,$sub_fds,$handlednodes);
 | |
|     #update the node status to the nodelist.status table
 | |
|     if ($check) {
 | |
|       updateNodeStatus($handlednodes, \@allerrornodes);
 | |
|     }
 | |
|   }
 | |
|   #while (wait() > -1) { } #keep around just in case we find the absolute need to wait for children to be gone
 | |
| 
 | |
|   #Make sure they get drained, this probably is overkill but shouldn't hurt
 | |
|   #my $rc=1;
 | |
|   #while ( $rc>0 ) {
 | |
|   #  my $handlednodes={};
 | |
|   #  $rc=forward_data($callback,$sub_fds,$handlednodes);
 | |
|   #  #update the node status to the nodelist.status table
 | |
|   #  if ($check) {
 | |
|   #    updateNodeStatus($handlednodes, \@allerrornodes);
 | |
|   #  }
 | |
|   #} 
 | |
| 
 | |
|   if ($check) {
 | |
|       #print "allerrornodes=@allerrornodes\n";
 | |
|       #revert the status back for there is no-op for the nodes
 | |
|       my %old=(); 
 | |
|       foreach my $node (@allerrornodes) {
 | |
| 	  my $stat=$oldnodestatus{$node};
 | |
| 	  if (exists($old{$stat})) {
 | |
| 	      my $pa=$old{$stat};
 | |
| 	      push(@$pa, $node);
 | |
| 	  }
 | |
| 	  else {
 | |
| 	      $old{$stat}=[$node];
 | |
| 	  }
 | |
|       } 
 | |
|       xCAT_monitoring::monitorctrl::setNodeStatusAttributes(\%old, 1);
 | |
|   }   
 | |
| }
 | |
| 
 | |
| sub updateNodeStatus {
 | |
|   my $handlednodes=shift;
 | |
|   my $allerrornodes=shift;
 | |
|   foreach my $node (keys(%$handlednodes)) {
 | |
|     if ($handlednodes->{$node} == -1) { push(@$allerrornodes, $node); }  
 | |
|   }
 | |
| }
 | |
| 
 | |
| sub forward_data {
 | |
|   my $callback = shift;
 | |
|   my $fds = shift;
 | |
|   my $errornodes=shift;
 | |
|   my @ready_fds = $fds->can_read(1);
 | |
|   my $rfh;
 | |
|   my $rc = @ready_fds;
 | |
|   foreach $rfh (@ready_fds) {
 | |
|     my $data;
 | |
|     my $responses;
 | |
|     eval {
 | |
|     	$responses = fd_retrieve($rfh);
 | |
|     };
 | |
|     if ($@ and $@ =~ /^Magic number checking on storable file/) { #this most likely means we ran over the end of available input
 | |
|       $fds->remove($rfh);
 | |
|       close($rfh);
 | |
|     } else {
 | |
|       eval { print $rfh "ACK\n"; }; #ignore failures to send inter-process ack
 | |
|       foreach (@$responses) {
 | |
|         #save the nodes that has errors and the ones that has no-op for use by the node status monitoring
 | |
|         my $no_op=0;
 | |
|         if ($_->{node}->[0]->{errorcode}) { $no_op=1; }
 | |
|         else { 
 | |
|           my $text=$_->{node}->[0]->{data}->[0]->{contents}->[0];
 | |
|           #print "data:$text\n";
 | |
|           if (($text) && ($text =~ /$status_noop/)) {
 | |
| 	    $no_op=1;
 | |
|             #remove the symbols that meant for use by node status
 | |
|             $_->{node}->[0]->{data}->[0]->{contents}->[0] =~ s/$status_noop//; 
 | |
|           }
 | |
|         }  
 | |
| 	#print "data:". $_->{node}->[0]->{data}->[0]->{contents}->[0] . "\n";
 | |
|         if ($no_op) {
 | |
|           if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=-1; } 
 | |
|       } else {
 | |
|           if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=1; } 
 | |
|       }
 | |
|         $callback->($_);
 | |
|       }
 | |
|     }
 | |
|   }
 | |
|   yield(); #Try to avoid useless iterations as much as possible
 | |
|   return $rc;
 | |
| }
 | |
| 
 | |
| 
 | |
| sub dohyp {
 | |
|   my $out = shift;
 | |
|   $hyp = shift;
 | |
|   my $command=shift;
 | |
|   my %namedargs=@_;
 | |
|   my @exargs=@{$namedargs{-args}};
 | |
|   my $node;
 | |
|   my $args = \@exargs;
 | |
|   #$vmtab = xCAT::Table->new("vm");
 | |
|   $vmtab = undef;
 | |
|   unless ($offlinehyps{$hyp} or ($hyp eq '!@!XCATDUMMYHYPERVISOR!@!') or nodesockopen($hyp,22)) {
 | |
|     $offlinehyps{$hyp}=1;
 | |
|   }
 | |
| 
 | |
| 
 | |
|   eval { #Contain Sys::Virt bugs that make $@ useless
 | |
|     if ($hyp eq '!@!XCATDUMMYHYPERVISOR!@!') {  #Fake connection for commands that have a fake hypervisor key
 | |
|         $hypconn = 1;
 | |
|     } elsif (not $offlinehyps{$hyp}) { 
 | |
|         $hypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$hyp."/system?no_tty=1&netcat=nc");
 | |
|     }
 | |
|   };
 | |
|   unless ($hypconn or $offlinehyps{$hyp}) {
 | |
|     eval { #Contain Sys::Virt bugs that make $@ useless
 | |
|         $hypconn= Sys::Virt->new(uri=>"qemu+ssh://root@".$hyp."/system?no_tty=1");
 | |
|     };
 | |
|   }
 | |
|   unless ($hypconn) {
 | |
|      my %err=(node=>[]);
 | |
|      foreach (keys %{$hyphash{$hyp}->{nodes}}) {
 | |
|         push (@{$err{node}},{name=>[$_],error=>["Cannot communicate via libvirt to $hyp"],errorcode=>[1]});
 | |
|      }
 | |
|      store_fd([\%err],$out);
 | |
|      yield();
 | |
|      waitforack($out);
 | |
|      %err=(node=>[]);
 | |
|      if ($command eq 'rmigrate' and grep { $_ eq '-f'  } @$args) {
 | |
|      foreach (keys %{$hyphash{$hyp}->{nodes}}) {
 | |
|         push (@{$err{node}},{name=>[$_],error=>["Forcibly relocating VM from $hyp"],errorcode=>[1]});
 | |
|      }
 | |
|      	store_fd([\%err],$out);
 | |
|      } else {
 | |
|      	return 1,"General error establishing libvirt communication";
 | |
|      }
 | |
|   }
 | |
|   foreach $node (sort (keys %{$hyphash{$hyp}->{nodes}})) {
 | |
|     my ($rc,@output) = guestcmd($hyp,$node,$command,@$args); 
 | |
| 
 | |
|     foreach(@output) {
 | |
|       my %output;
 | |
|       if (ref($_)) {
 | |
| 	  store_fd([$_],$out);
 | |
|           yield();
 | |
|           waitforack($out);
 | |
|           next;
 | |
|       }
 | |
|       
 | |
|       (my $desc,my $text) = split (/:/,$_,2);
 | |
|       unless ($text) {
 | |
|         $text=$desc;
 | |
|       } else {
 | |
|         $desc =~ s/^\s+//;
 | |
|         $desc =~ s/\s+$//;
 | |
|         if ($desc) {
 | |
|           $output{node}->[0]->{data}->[0]->{desc}->[0]=$desc;
 | |
|         }
 | |
|       }
 | |
|       $text =~ s/^\s+//;
 | |
|       $text =~ s/\s+$//;
 | |
|       $output{node}->[0]->{errorcode} = $rc;
 | |
|       $output{node}->[0]->{name}->[0]=$node;
 | |
|       if ($rc == 0) {
 | |
| 	$output{node}->[0]->{data}->[0]->{contents}->[0]=$text;
 | |
|       } else {
 | |
|          $output{node}->[0]->{error} = $text;
 | |
|       }
 | |
|       store_fd([\%output],$out);
 | |
|       yield();
 | |
|       waitforack($out);
 | |
|     }
 | |
|     yield();
 | |
|   }
 | |
|   foreach (keys %$updatetable) {
 | |
|       my $tabhandle = xCAT::Table->new($_,-create=>1);
 | |
|       my $updates = $updatetable->{$_};
 | |
|       if ($updates->{'!*XCATNODESTODELETE*!'}) {
 | |
|           my @delkeys;
 | |
|           foreach (keys %{$updates->{'!*XCATNODESTODELETE*!'}}) {
 | |
|               if ($_) { push @delkeys, {node=>$_}; }
 | |
|           }
 | |
|           if (@delkeys) {  $tabhandle->delEntries(\@delkeys); }
 | |
|           delete $updates->{'!*XCATNODESTODELETE*!'};
 | |
|       }
 | |
|       $tabhandle->setNodesAttribs($updatetable->{$_});
 | |
|   }
 | |
|   #my $msgtoparent=freeze(\@outhashes); # = XMLout(\%output,RootName => 'xcatresponse');
 | |
|   #print $out $msgtoparent; #$node.": $_\n";
 | |
| }
 | |
|     
 | |
| 1;
 |