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

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


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]";
   push @return, "\ton - set maintenance flag; no domains can be started/migrated to node";
   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::targetNode ) {
      push @_, $main::targetNode;
   }
   @_ = keys %{$main::statusDB->{'node'}} unless @_;
   while ( my $nodename = shift  ) {
      print "Updating $nodename\n" if $main::DEBUG;
      $return = `ssh $nodename 'virsh nodeinfo'`;
      print "Output of ssh $nodename 'virsh nodeinfo' is\n" . $return if $main::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::DEBUG;
   &main::writeDB();
   return "Node has been updated\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 {
#   &main::readDB();
#   print "Adding $main::targetNode as new node\n" if $main::DEBUG;
#   $main::statusDB->{'node'}->{$main::targetNode} = '';
#   print "Calling update for new node\n" if $main::DEBUG;
   &update( @_ );
}

sub maintenance {
   my ( $node, $action ) = @_;
   &main::readDB(1);
   if ( $action ) {
      $main::statusDB->{'node'}->{$node}->{'maintenance'} = ( lc( $action ) eq 'on' ) ? 1 : 0;
   }
   &main::writeDB();
   return "Maintenance set to " . ( $main::statusDB->{'node'}->{$node}->{'maintenance'} ? 'On' : 'Off' ) . "\n";
}