Subversion Repositories havirt

#!/usr/bin/env perl

# All functions related to maniplating domains

# part of havirt.

# Copyright 2024 Daily Data, Inc.

# 

# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following 

# conditions are met:

#

#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer 

#   in the documentation and/or other materials provided with the distribution.

#   Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived

#   from this software without specific prior written permission.

# 

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT

# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL

# THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS

# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE

# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# v0.0.1 20240602 RWR

# Initial setup

package domain;

use warnings;

use strict;  

# define the version number

# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod

use version;

our $VERSION = version->declare("0.0.1");

use Data::Dumper;

use Exporter;

our @ISA = qw( Exporter );

our @EXPORT = qw( 

                  &list

                );

sub loadVirtDB {

   return if $main::virtDB;

   $main::virtDB = &main::readDB( $main::domainDBName );

}

sub list {

   &loadVirtDB();

   &main::loadNodePopulations();

   print Dumper( $main::nodePopulations ) if $main::DEBUG > 2;

   my @header;

   my @data;

   foreach my $node ( keys %$main::nodePopulations ) {

      foreach my $virt (keys %{$main::nodePopulations->{$node}->{'running'}} ) {

         unless ( @header ) {

            # if we don't have a header yet, create it from the keys in this one. Assumes every entry has same keys

            @header = sort keys %{ $main::virtDB->{$virt} };

            unshift @header, 'Node';

            unshift @header, 'Domain';

         } # unless

         my @line;

         push @line, $node;

         push @line, $virt;

         foreach my $column ( sort keys %{ $main::virtDB->{$virt} } ) {

            push @line, $main::virtDB->{$virt}->{$column};

         }

         push @data, \@line;

      }

   }

   return &main::report( \@header, \@data );

}

sub update {

   &loadVirtDB();

   unless ( @_ ) {

      # they didn't pass in anything, so do everything

      @_ = keys %{ $main::virtDB }

   } # unless

   print "Preparing to update " . join( "\n", @_ ) . "\n" if $main::DEBUG > 1;

   die;

   while ( my $virt = shift ) {

      &parseDomain( $virt );

   } # while

   &writeDB( $main::domainDBName, $main::virtDB );

}

sub getXMLValue {

   my ( $key, $string ) = @_;

   my $start = "<$key";

   my $end = "</$key>";

   $string =~ m/$start([^>]*)>([^<]+)$end/;

   return ($1,$2);

}

sub parseDomain {

   my ($virt, $nodePopulations ) = @_;

   my @keysToSave = ( 'uuid', 'memory', 'vcpu','vnc' );

   my $filename = "$main::confDir/$virt.xml";

   my $xml = &getVirtConfig( $virt, $filename );

   my ($param,$value) = &getXMLValue( 'uuid', $xml );

   $main::virtDB->{$virt}->{'uuid'} = $value;

   ($param,$value) = &getXMLValue( 'memory', $xml );

   $main::virtDB->{$virt}->{'memory'} = $value;

   ($param,$value) = &getXMLValue( 'vcpu', $xml );

   $main::virtDB->{$virt}->{'vcpu'} = $value;

   $xml =~ m/type='vnc' port='(\d+)'/;

   $main::virtDB->{$virt}->{'vnc'} = $1;

}

# get the XML definition file of a running domain off of whatever

# node it is running on, and save it to disk

sub getVirtConfig {

   my ($virt,$filename) = @_;

   my $return;

   print "In getVirtConfig looking for $virt with file $filename\n" if $main::DEBUG;

   if ( -f $filename ) {

      open XML, "<$filename" or die "Could not read from $filename: $!\n";

      $return = join( '', <XML> );

      close XML;

   } else {

      &main::loadNodePopulations();

      #die Dumper( $nodePopulations );

      foreach my $node ( keys %$main::nodePopulations ) {

         print "getVirtConfig Looking on $node for $virt\n";

         if ( exists( $main::nodePopulations->{$node}->{'running'}->{$virt} ) ) { # we found it

            print "Found $virt on node $node\n";

            $return = `ssh $node 'virsh dumpxml $virt'`;

            open XML,">$filename" or die "Could not write to $filename: $!\n";

            print XML $return;

            close XML;

         } # if

      } # foreach

   } # if..else

   return $return;

} # sub getVirtConfig