Subversion Repositories havirt

#!/usr/bin/env perl

# All functions related to maniplating a specific node

# 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

#

# v1.2.0 20240826 RWR

# Added some code to migrate domains if node placed in maintenance mode

# Added a lot of 'verbose' print lines, and modified for new flag structure

#

# v1.2.1 20240828 RWR

# Fixed node maintenance, adding scanning and fixing some bugs with

# the migration code

#

# v1.2.2 20260102 RWR

# Refactored command execution in update() function to use centralized execute()

package node;

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("1.2.2");

use Data::Dumper;

use Exporter;

our @ISA = qw( Exporter );

our @EXPORT = qw( 

                  &node &list &update &scan &add

                );

# Converts from output of node info to a key we want to use

my %conversion = ( 

  'CPU frequency' => 'clock',

  'CPU model' => 'cpu_model',

  'CPU socket(s)' => 'cpu_socket',

  'CPU(s)' => 'cpu_count',

  'Core(s) per socket' => 'cpu_cores',

  'Memory size' => 'memory',

  'NUMA cell(s)' => 'numa_cells',

  'Thread(s) per core' => 'threads_per_core'

);

# show a help screen

sub help {

   my @return;

   push @return, "node update [nodename|-t nodename]";

   push @return, "\tUpdates capabilities on one or more nodes, default is all nodes";

   push @return, "node add nodename";

   push @return, "\tAdds a new node to the cluster. nodename must be reachable via ssh without password";

   push @return, "node list [--format screen|tsv]";

   push @return, "\tLists all nodes with some statistics about them as screen or tsv (default screen)";

   push @return, "node scan [nodename|-t nodename]";

   push @return, "\tUpdates list of domains on one or more existing nodes, default is all nodes";

   push @return, "node maintenance nodename [on|off --target=targetNode]";

   push @return, "\ton - set maintenance flag; no domains can be started/migrated to node";

   push @return, "\t     target must be set with the --target flag";

   push @return, "\toff - Allows domains to be migrated/started on node";

   push @return, "\tnothing - displays current maintenance flag";

   return join( "\n", @return ) . "\n";

}

# lists hardware capabilities of all nodes (virsh nodeinfo)

sub list {

   my @header;

   my @data;

   my $return;

   &main::readDB();

   foreach my $node ( sort keys %{$main::statusDB->{'node'}} ) {

      unless ( @header ) {

         # just grab the keys for headers

         @header = sort keys %{ $main::statusDB->{'node'}->{$node} };

         # put Node at the beginning

         unshift ( @header, 'Node' );

      }

      my @line;

      push @line, $node;

      foreach my $column (sort keys %{ $main::statusDB->{'node'}->{$node} }) {

         push @line, $main::statusDB->{'node'}->{$node}->{$column};

      }

      push (@data, \@line );

   }

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

}

# Get information about a node. Really only needs to be done when a node is

# first defined, or if there is a hardware upgrade

# reads information off of the stack (@_), but will add to that if --target

# was defined

sub update {

   &main::readDB( 1 ); # open and lock so we can write to it later

   my @return;

   my @requiredFields = ( 'maintenance' );

   my @targets;

   if ( $main::config->{'flags'}->{'target'} ) {

      push @_, $main::config->{'flags'}->{'target'};

   }

   @_ = keys %{$main::statusDB->{'node'}} unless @_;

   while ( my $nodename = shift  ) {

      print "Updating $nodename\n" if $main::config->{'flags'}->{'debug'} || $main::config->{'flags'}->{'verbose'};

      my $command = &main::makeCommand($nodename, "virsh nodeinfo" );

      if ( $main::config->{'flags'}->{'dryrun'} ) {

         push @return, $command;

      } else {  

         my $return= &main::execute($command);

         print "Output of [$command] is\n" . $return if $main::config->{'flags'}->{'debug'};

         my @nodeinfo = split( "\n", $return );

         for ( my $i = 0; $i < @nodeinfo; $i++ ) {

            my ($key, $value) = split( /:\s+/, $nodeinfo[$i] );

            if ( $value =~ m/^(\d+)\s+[a-z]+$/i ) {

               $value = $1;

            }

            $key = $conversion{$key} if exists( $conversion{$key} );

            $main::statusDB->{'node'}->{$nodename}->{$key} = $value;

         } # for

         foreach my $field ( @requiredFields ) {

            $main::statusDB->{'node'}->{$nodename}->{$field} = '' 

               unless defined ( $main::statusDB->{'node'}->{$nodename}->{$field} );

         } # foreach

      }

   } # while

   print "main::statusDB->{'node'} state after update\n" . Dumper( $main::statusDB->{'node'} ) if $main::config->{'flags'}->{'debug'};

   &main::writeDB();

   return "Node has been updated\n" . join( "\n", @return ) . "\n";

}      

# check one or more nodes and determine which domains are running on them.

# defaults to everything in the node database, but the -t can have it run on only one

# this is the function that should be run every few minutes on one of the servers

sub scan {

   return &main::scan(@_);

}

# add a new node. This is the same as doing an update on a node that doesn't exist.

sub add {

   &update( @_ );

}

# put node in maintenance mode

# no domains are allowed to be started or migrated to a node in maintenance mode

# if we are turning maintenance mode on, we must migrate all domains off

# maintenance does NOT remove existing domains, but prevents new ones from being added

# however, cluster::balance will try to migrate them off

sub maintenance {

   my ( $node, $action ) = @_;

   &main::readDB();

   my @return;

   if ( $action ) {

      print "Found action [$action] in node.pm:maintenance\n" if $main::config->{'flags'}->{'debug'};

      &main::readDB(1);

      $main::statusDB->{'node'}->{$node}->{'maintenance'} = lc $action eq 'on';

      &main::writeDB();

   }

   &main::readDB();

   print Dumper( $main::statusDB ) if $main::config->{'flags'}->{'debug'} > 2;

   return "Maintenance set to " . ( $main::statusDB->{'node'}->{$node}->{'maintenance'} ? 'On' : 'Off' ) . "\n" .

          ( @return ? join( "\n", @return ) . "\n" : '');

}

# migrate domains from node $from to node $to

# the rest of the stack is a list of domains to migrate

sub migrateAllDomains {

   my $from = shift;

   my $to = shift;

   print "In node.pm:migrateAllDomains, migrating\n" . join( "\n", @_ ) . "\nto $to\n"

      if ( $main::config->{'flags'}->{'debug'} );

   my @commands;

   print "Checking for available resources on $to before migrating\n"  if $main::config->{'flags'}->{'verbose'};

   if ( my $error = &main::validateResources( $to, @_ ) ) {

      return "We can not migrate all of the domains on $from to $to\n$error\n";

   }

   while ( my $domain = shift ) {

      push @commands, &main::migrate( $domain, $to );

   }

   chomp @commands;

   return join( "\n", @commands ) . "\n";

}