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

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.1");


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 list [--format|-f 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";
   push @return, "\tNote: a node with any domains running can not have maintenance mode turned on";
   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, `$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
# if there are running domains on it, migrate them off first
# If we migrate, we must then do a force scan, which locks
# the database. So, we must read the database shared first, then
# only read exclusive when we are actually changing the maintenance
# flag. The solution here is a kludge, but it at least works
# we do the exclusive read only just before we change then write
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'} > 1;
      if ( lc ( $action ) eq 'on' ) {
         if ( keys %{$main::statusDB->{'nodePopulation'}->{$node}->{'running'} } ) {
            # we've requested maintenance mode, but there are domains running on the node
            print "Found domains on $node in node.pm:maintenance\n" if $main::config->{'flags'}->{'debug'} > 1;
            print "Trying to migrate domains off of $node before doing maintenance\n" if $main::config->{'flags'}->{'verbose'} || $main::config->{'flags'}->{'debug'} > 1;
            push @return, &migrateAllDomains( $node, $main::config->{'flags'}->{'target'}, keys %{$main::statusDB->{'nodePopulation'}->{$node}->{'running'}} );
            print "Finished migration attempt, forcing a scan\n" if $main::config->{'flags'}->{'debug'} > 1;
            &main::forceScan();
         }
         if ( keys %{ $main::statusDB->{'nodePopulation'}->{$node}->{'running'} } ) {
            print "Still found running domains on $node, aborting\n" if $main::config->{'flags'}->{'debug'} > 1;
            push @return,  "Can not mark $node in maintenance mode with running domains";
         } else {
            print "Marking $node as under maintenance\n" if $main::config->{'flags'}->{'verbose'} || $main::config->{'flags'}->{'debug'};
            &main::readDB(1);
            $main::statusDB->{'node'}->{$node}->{'maintenance'} = 1;
            &main::writeDB();
         }
      } else {
         print "Marking $node as Online\n" if $main::config->{'flags'}->{'verbose'} || $main::config->{'flags'}->{'debug'};
         &main::readDB(1);
         $main::statusDB->{'node'}->{$node}->{'maintenance'} = 0;
         &main::writeDB();
      }
   }
   &main::readDB();
   print Dumper( $main::statusDB ) if $main::config->{'flags'}->{'debug'} > 2;
#   return "Maintenance set to " . ( $main::statusDB->{'node'}->{$node}->{'maintenance'} ) . "\n" .
   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";
}