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


use Data::Dumper;

use Exporter;

our @ISA = qw( Exporter );
our @EXPORT = qw( 
                  &node &list &update &scan
                );

# 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'
);


sub loadNodeDB {
   print "In loadNodeDB, reading $main::nodeDBName\n" if $main::DEBUG > 1;
   return if $main::nodeDB;
   $main::nodeDB = &main::readDB( $main::nodeDBName );
   print "Success\n" if $main::DEBUG > 1;
}

sub getDomainsOnNode {
   my $node = shift;
   my @nodeList = grep { /^\s*\d/ } `ssh $node 'virsh list'`;
   for ( my $i = 0; $i < @nodeList; $i++ ) {
      if ( $nodeList[$i] =~ m/\s*\d+\s*([^ ]+)/ ) {
         $nodeList[$i] = $1;
      }
   }
   my %hash = map{ $_ => time } @nodeList;
   return \%hash;
}


sub list {
   my @header;
   my @data;
   my $return;
   &loadNodeDB();
   foreach my $node ( sort keys %$main::nodeDB ) {
      unless ( @header ) {
         # just grab the keys for headers
         @header = sort keys %{ $main::nodeDB->{$node} };
         # put Node at the beginning
         unshift ( @header, 'Node' );
      }
      my @line;
      push @line, $node;
      foreach my $column (sort keys %{ $main::nodeDB->{$node} }) {
         push @line, $main::nodeDB->{$node}->{$column};
      }
      push (@data, \@line );
   }
   $return = &main::report( \@header, \@data );
}


sub update {
   &loadNodeDB();
   my $return;
   my @targets;
   if ( $main::targetNode ) {
      push @targets, $main::targetNode;
   } else {
      @targets = keys %$main::nodeDB;
   }
   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::nodeDB->{$nodename}->{$key} = $value;
      } # for
   } # while
   print "main::nodeDB state after update\n" . Dumper( $main::nodeDB ) if $main::DEBUG;
   &main::writeDB( $main::nodeDBName, $main::nodeDB );
   return "Node has been updated\n";
}      

sub scan {
   &loadNodeDB();
   &main::loadNodePopulations();
   print Dumper( $main::nodePopulations ) if $main::DEBUG > 2;
   my @targets;
   if ( $main::targetNode ) {
      push @targets, $main::targetNode;
   } else {
      @targets = keys %$main::nodeDB;
   }
   print "Scanning " . join( "\n", @targets ) . "\n" if $main::DEBUG;
   foreach my $node (@targets) {
      $main::nodePopulations->{$node}->{'running'} = &getDomainsOnNode( $node );
      $main::nodePopulations->{$node}->{'lastchecked'} = time;
      print Dumper( $main::nodePopulations->{$node} ) if $main::DEBUG > 2;
   }
   &main::writeDB( $main::nodePopulationDBName,$main::nodePopulations );
   return "Node(s) updated\n";
}   

sub node {
   my $action = lc shift;

   print "In node, action is $action\n" if $main::DEBUG;
   my $return = '';
   &loadNodeDB();
   if ( $action eq 'update' ) { # read information for nodes and update database
      return &update( @_ );
   } elsif ( $action eq 'list' ) { # dump database to screen
      return &list();
   } elsif ( $action eq 'scan' ) {
      return &scan();
   } # if..elsif
   return $return;
}