Subversion Repositories havirt

Rev

Rev 2 | Rev 4 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 3
Line 1... Line 1...
1 
#! /usr/bin/env perl
 1 
#! /usr/bin/env perl
2 
 
 2 
 
3 
use strict;
 3 
use strict;
4 
use warnings;
 4 
use warnings;
- 
 
 5 
 
- 
 
 6 
# havirt
- 
 
 7 
# Basically an extension of virsh which will perform actions on virtuals
- 
 
 8 
# running on multiple, connected hypervisors (virsh calls them nodes)
- 
 
 9 
# existing as a cluster of hypervisors where virtuals can be shut down,
- 
 
 10 
# started and migrated at need.
- 
 
 11 
#
- 
 
 12 
# Progam consists of one executable (havirt) and multiple Perl Modules
- 
 
 13 
# (*.pm), each of which encompasses a function. However, this is NOT
- 
 
 14 
# written as an Object Oriented system.
- 
 
 15 
#
- 
 
 16 
# havirt --help gives a brief help screen.
- 
 
 17 
 
- 
 
 18 
# Copyright 2024 Daily Data, Inc.
- 
 
 19 
#
- 
 
 20 
# Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
- 
 
 21 
# conditions are met:
- 
 
 22 
#
- 
 
 23 
#   Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
- 
 
 24 
#   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer
- 
 
 25 
#   in the documentation and/or other materials provided with the distribution.
- 
 
 26 
#   Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived
- 
 
 27 
#   from this software without specific prior written permission.
- 
 
 28 
#
- 
 
 29 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT
- 
 
 30 
# NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
- 
 
 31 
# THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
- 
 
 32 
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- 
 
 33 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
- 
 
 34 
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 35 
 
- 
 
 36 
 
5 
#use experimental "switch";
 37 
#use experimental "switch";
6 
 
 38 
 
7 
# requires File::Slurp.
39 
# requires File::Slurp.
8 
# In Debian derivatives
 40 
# In Debian derivatives
9 
# apt install libfile-slurp-perl
 41 
# apt install libfile-slurp-perl
Line 16... Line 48...
16 
   use File::Spec;
 48 
   use File::Spec;
17 
   # use libraries from the directory this script is in
 49 
   # use libraries from the directory this script is in
18 
   use lib File::Spec->catdir($FindBin::Bin);
 50 
   use lib File::Spec->catdir($FindBin::Bin);
19 
}
 51 
}
20 
 
 52 
 
- 
 
 53 
use havirt; # Load all our shared stuff
- 
 
 54 
 
21 
use Data::Dumper;
 55 
use Data::Dumper;
22 
use YAML::Tiny;
 56 
use YAML::Tiny;
23 
 
 57 
 
24 
# global variables
 58 
# global variables
25 
my $scriptDir = $FindBin::RealBin;
 59 
my $scriptDir = $FindBin::RealBin;
26 
my $scriptName = $FindBin::Script;
 60 
my $scriptName = $FindBin::Script;
27 
my $confDir = "$scriptDir/conf";
 61 
my $confDir = "$scriptDir/conf";
28 
my $dbDir = "$scriptDir/var";
 62 
my $dbDir = "$scriptDir/var";
29 
my $nodeDBName = "$dbDir/node.yaml";
 63 
our $nodeDBName = "$dbDir/node.yaml";
30 
my $domainDBName = "$dbDir/domains.yaml";
 64 
my $domainDBName = "$dbDir/domains.yaml";
31 
my $nodePopulationDBName = "$dbDir/node_population.yaml";
 65 
our $nodePopulationDBName = "$dbDir/node_population.yaml";
32 
 
 66 
 
33 
# these contain the values from the databases
 67 
# these contain the values from the databases
34 
# loaded on demand
 68 
# loaded on demand
35 
my $nodeDB;
 69 
our $nodeDB;
36 
my $virtDB;
 70 
our $virtDB;
37 
my $nodePopulations;
 71 
our $nodePopulations;
38 
 
 72 
 
39 
 
 73 
 
40 
my $dryRun = 1;
 74 
my $dryRun = 1;
41 
my $DEBUG = 0;
 75 
my $DEBUG = 0;
42 
 
 76 
 
Line 49... Line 83...
49 
   print "\tdomain update ALL|RUNNING|[domain] [domain]... # update domains\n";
 83 
   print "\tdomain update ALL|RUNNING|[domain] [domain]... # update domains\n";
50 
   print "\tdomain list ALL|RUNNING|[domain] [domain]... # display tab delimited list of domain specs\n";
 84 
   print "\tdomain list ALL|RUNNING|[domain] [domain]... # display tab delimited list of domain specs\n";
51 
   print "\tcluster status # report of memory and vcpu status on all nodes\n";
 85 
   print "\tcluster status # report of memory and vcpu status on all nodes\n";
52 
}
 86 
}
53 
 
 87 
 
54 
sub readDB {
 - 
 
55 
   my ($filename) = @_;
 - 
 
56 
   my $yaml = YAML::Tiny->new( {} );
 - 
 
57 
   if ( -f $filename ) {
 - 
 
58 
      $yaml = YAML::Tiny->read( $filename );
 - 
 
59 
   }
 - 
 
60 
   return $yaml->[0];
 - 
 
61 
}
 - 
 
62 
 
 - 
 
63 
sub writeDB {
 - 
 
64 
   my ($filename,$data) = @_;
 - 
 
65 
   my $yaml = YAML::Tiny->new( $data );
 - 
 
66 
   $yaml->write( $filename );
 - 
 
67 
}
 - 
 
68 
 
 - 
 
69 
sub loadVirtDB {
 88 
sub loadVirtDB {
70 
   return if $virtDB;
 89 
   return if $virtDB;
71 
   $virtDB = &readDB( $domainDBName );
 90 
   $virtDB = &readDB( $domainDBName );
72 
}
 91 
}
73 
 
 92 
 
74 
sub loadNodePopulations {
 93 
sub loadNodePopulations {
75 
   return if $nodePopulations;
 94 
   return if $nodePopulations;
76 
   $nodePopulations = &readDB( $nodePopulationDBName );
 95 
   $nodePopulations = &readDB( $nodePopulationDBName );
77 
}
 96 
}
78 
 
 97 
 
79 
sub loadNodeDB {
 - 
 
80 
   return if $nodeDB;
 - 
 
81 
   $nodeDB = &readDB( $nodeDBName );
 - 
 
82 
}
 - 
 
83 
 
 - 
 
84 
sub domain {
 98 
sub domain {
85 
   my $action = lc shift;
 99 
   my $action = lc shift;
86 
   my $return = '';
 100 
   my $return = '';
87 
   &loadVirtDB();
 101 
   &loadVirtDB();
88 
   &loadNodePopulations();
 102 
   &loadNodePopulations();
Line 174... Line 188...
174 
 
 188 
 
175 
   $xml =~ m/type='vnc' port='(\d+)'/;
 189 
   $xml =~ m/type='vnc' port='(\d+)'/;
176 
   $virtDB->{$virt}->{'vnc'} = $1;
 190 
   $virtDB->{$virt}->{'vnc'} = $1;
177 
}
 191 
}
178 
 
 192 
 
179 
sub getDomainsOnNode {
 - 
 
180 
   my $node = shift;
 - 
 
181 
   my @nodeList = grep { /^\s*\d/ } `ssh $node 'virsh list'`;
 - 
 
182 
   for ( my $i = 0; $i < @nodeList; $i++ ) {
 - 
 
183 
      if ( $nodeList[$i] =~ m/\s*\d+\s*([^ ]+)/ ) {
 - 
 
184 
         $nodeList[$i] = $1;
 - 
 
185 
      }
 - 
 
186 
   }
 - 
 
187 
   my %hash = map{ $_ => time } @nodeList;
 - 
 
188 
   return \%hash;
 - 
 
189 
}
 - 
 
190 
 
 - 
 
191 
sub node {
 - 
 
192 
   my $action = lc shift;
 - 
 
193 
 
 - 
 
194 
   my %conversion = (
- 
 
195 
     'CPU frequency' => 'clock',
 - 
 
196 
     'CPU model' => 'cpu_model',
 - 
 
197 
     'CPU socket(s)' => 'cpu_socket',
 - 
 
198 
     'CPU(s)' => 'cpu_count',
 - 
 
199 
     'Core(s) per socket' => 'cpu_cores',
 - 
 
200 
     'Memory size' => 'memory',
 - 
 
201 
     'NUMA cell(s)' => 'numa_cells',
 - 
 
202 
     'Thread(s) per core' => 'threads_per_core'
 - 
 
203 
   );
 - 
 
204 
 
 - 
 
205 
 
 - 
 
206 
   print "In node, action is $action\n" if $DEBUG;
 - 
 
207 
   my $return = '';
 - 
 
208 
   &loadNodeDB();
 - 
 
209 
   if ( $action eq 'update' ) { # read information for nodes and update database
 - 
 
210 
      @_ = keys %$nodeDB if ( $_[0] eq 'ALL' );
 - 
 
211 
      while ( my $nodename = shift ) {
 - 
 
212 
         print "Updating $nodename\n" if $DEBUG;
 - 
 
213 
         $return = `ssh $nodename 'virsh nodeinfo'`;
 - 
 
214 
         print "Output of ssh $nodename 'virsh nodeinfo' is\n" . $return if $DEBUG;
 - 
 
215 
         my @nodeinfo = split( "\n", $return );
 - 
 
216 
         for ( my $i = 0; $i < @nodeinfo; $i++ ) {
 - 
 
217 
            my ($key, $value) = split( /:\s+/, $nodeinfo[$i] );
 - 
 
218 
            if ( $value =~ m/^(\d+)\s+[a-z]+$/i ) {
 - 
 
219 
               $value = $1;
 - 
 
220 
            }
 - 
 
221 
            $key = $conversion{$key} if exists( $conversion{$key} );
 - 
 
222 
            $nodeDB->{$nodename}->{$key} = $value;
 - 
 
223 
         } # for
 - 
 
224 
      } # while
 - 
 
225 
      print "nodeDB state after update\n" . Dumper( $nodeDB ) if $DEBUG;
 - 
 
226 
      &writeDB( $nodeDBName, $nodeDB );
 - 
 
227 
   } elsif ( $action eq 'list' ) { # dump database as a tab separated file with headers
 - 
 
228 
      my @return;
 - 
 
229 
      foreach my $node ( sort keys %$nodeDB ) {
 - 
 
230 
         @return[0] = "Node\t" . join( "\t", sort keys %{ $nodeDB->{$node} } ) unless @return;
 - 
 
231 
         my @line;
 - 
 
232 
         push @line, $node;
 - 
 
233 
         foreach my $column (sort keys %{ $nodeDB->{$node} }) {
 - 
 
234 
            push @line, $nodeDB->{$node}->{$column};
 - 
 
235 
         }
 - 
 
236 
         push @return, join( "\t", @line );
 - 
 
237 
      }
 - 
 
238 
      $return = join( "\n", @return ) . "\n";
 - 
 
239 
   } elsif ( $action eq 'scan' ) {
 - 
 
240 
      foreach my $node ( keys %$nodeDB ) {
 - 
 
241 
         $nodePopulations->{$node}->{'running'} = &getDomainsOnNode( $node );
 - 
 
242 
         $nodePopulations->{$node}->{'lastchecked'} = time;
 - 
 
243 
      }
 - 
 
244 
      &writeDB( $nodePopulationDBName,$nodePopulations );
 - 
 
245 
   } # if..elsif
 - 
 
246 
   return $return;
 - 
 
247 
}
 - 
 
248 
 
 - 
 
249 
 
 - 
 
250 
sub cluster {
 193 
sub cluster {
251 
   my $action = lc shift;
 194 
   my $action = lc shift;
252 
   my $return = '';
 195 
   my $return = '';
253 
   if ( $action eq 'status' ) {
 196 
   if ( $action eq 'status' ) {
254 
      &loadVirtDB();
 197 
      &loadVirtDB();
Line 286... Line 229...
286 
 
 229 
 
287 
my $command = shift; # the first one is the actual subsection
 230 
my $command = shift; # the first one is the actual subsection
288 
my $action = shift; # second is action to run
 231 
my $action = shift; # second is action to run
289 
 
 232 
 
290 
if ( $command eq 'node' ) {
 233 
if ( $command eq 'node' ) {
- 
 
 234 
   require node;
- 
 
 235 
   Module->import( qw/node/ );
291 
   print &node( $action, @ARGV );
 236 
   print &node::node( $action, @ARGV );
292 
} elsif ( $command eq 'domain' ) {
 237 
} elsif ( $command eq 'domain' ) {
293 
   print &domain( $action, @ARGV );
 238 
   print &domain( $action, @ARGV );
294 
} elsif ( $command eq 'cluster' ) {
 239 
} elsif ( $command eq 'cluster' ) {
295 
   print &cluster( $action, @ARGV );
 240 
   print &cluster( $action, @ARGV );
296 
} else {
 241 
} else {