WebSVN – havirt – Diff – /trunk/havirt.pm

 package havirt;
 use warnings;
 use strict;
+BEGIN {
+   use FindBin;
+   use File::Spec;
+   # use libraries from the directory this script is in
+   use Cwd 'abs_path';
+   use File::Basename;
+   use lib dirname( abs_path( __FILE__ ) );
+}
 use Data::Dumper qw(Dumper); # Import the Dumper() subroutine
 # define the version number
 # see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod
 use version;
 use Exporter;
 our @ISA = qw( Exporter );
 our @EXPORT = qw(
+                  &readDB
-                  &readDB &writeDB
+                  &writeDB
-                  &report &scan
+                  &report
+                  &scan
-                  &makeCommand &forceScan
+                  &makeCommand
+                  &forceScan
                   &executeAndWait
                   &findDomain
                   &diffArray
+                  &makeConfig
+                  &readConfig
+                  &getAvailableResources
+                  &resource
+                  &validateResources
+                  &migrate
                 );
 # read a DB file (just a YAML)
 # if $lock is set, will create a "lock" file so other processes will
 # not try to write to it. Using custom code as flock is automagically
 # release when the file is read
 sub readDB {
    my $lock = shift;
-   my $lockFileName = "$main::statusDBName.lock";
+   my $lockFileName = "$main::config->{'status db filename'}.lock";
    my $lockTime = 5; # maximum time to wait for lock to clear
    # wait for lock to clear if it exists, if we are wanting a lock
    # and we have tried it for $locktime iterations
    while ( $lock && -f $lockFileName && $lockTime-- ) {
       sleep 1; # wait one second, then try again
+   }
    if ( $lock ) {
-      die "Something has $main::statusDBName locked, aborting\n" if -f $lockFileName;
+      die "Something has $main::config->{'status db filename'} locked, aborting\n" if -f $lockFileName;
       `touch $lockFileName`;
+   }
    my $yaml = YAML::Tiny->new( {} );
-   if ( -f $main::statusDBName ) {
+   if ( -f $main::config->{'status db filename'} ) {
-      $yaml = YAML::Tiny->read( $main::statusDBName );
+      $yaml = YAML::Tiny->read( $main::config->{'status db filename'} );
+   }
    $main::statusDB = $yaml->[0];
+}
 sub writeDB {
    my $yaml = YAML::Tiny->new( $main::statusDB );
-   $yaml->write( $main::statusDBName );
+   $yaml->write( $main::config->{'status db filename'} );
-   unlink "$main::statusDBName.lock" if -f "$main::statusDBName.lock"; # release any lock we might have on it
+   unlink "$main::config->{'status db filename'}.lock" if -f "$main::config->{'status db filename'}.lock"; # release any lock we might have on it
+}
 sub report {
-   if ( $main::reportFormat eq 'tsv' ) {
+   if ( $main::config->{'flags'}->{'format'} eq 'tsv' ) {
       return &report_tsv( @_ );
    } else {
       return &report_screen( @_ );
+   }
+}
+}
 # scans a node to determine which domains are running on it
 sub getDomainsOnNode {
    my $node = shift;
+   my $command = &main::makeCommand( $node, 'virsh list' );
+   print "havirt.pm:getDomainsOnNode, command is $command\n" if $main::config->{'flags'}->{'debug'} > 2;
-   my @nodeList = grep { /^\s*\d/ } `ssh $node 'virsh list'`;
+   my @nodeList = grep { /^\s*\d/ } `$command`;
    for ( my $i = 0; $i < @nodeList; $i++ ) {
       if ( $nodeList[$i] =~ m/\s*\d+\s*([^ ]+)/ ) {
          $nodeList[$i] = $1;
+      }
+   }
    my @node = @_;
    my $foundNode = '';
    &readDB();
    unless ( @node ) {
       @node = keys %{$main::statusDB->{'node'} };
-      print "findDomain, nodes = " . join( "\t", @node ) . "\n" if $main::DEBUG > 1;
+      print "findDomain, nodes = " . join( "\t", @node ) . "\n" if $main::config->{'flags'}->{'debug'} > 1;
+   }
    foreach my $thisNode ( @node ) {
-      my $output = `ssh $thisNode 'virsh list'`;
+      my $command = &main::makeCommand( $thisNode, 'virsh list' );
+      my $output = `$command`;
-      print "findDomain, $thisNode list =\n" . $output . "\n" if $main::DEBUG > 1;;
+      print "findDomain, $thisNode list =\n" . $output . "\n" if $main::config->{'flags'}->{'debug'} > 1;;
       return $thisNode if ( $output =~ m/$domainName/ );
+   }
    return '';
+}
 # 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 {
+   my @targets = @_;
-   if ( -f $main::lastScanFileName && ! $main::force ) {
+   if ( -f $main::config->{'last scan filename'} && ! $main::config->{'flags'}->{'yes'} ) {
-      my $lastScan = time - ( stat( $main::lastScanFileName ) ) [9];
+      my $lastScan = time - ( stat( $main::config->{'last scan filename'} ) ) [9];
-      return "Scan was run $lastScan seconds ago\n" unless $lastScan > $main::minScanTimes;
+      return "Scan was run $lastScan seconds ago\n" unless $lastScan > $main::config->{'minum scan time'};
+   }
-   `touch $main::lastScanFileName`;
+   `touch $main::config->{'last scan filename'}`;
    &main::readDB(1);
-   print Dumper( $main::statusDB->{'nodePopulation'} ) if $main::DEBUG > 2;
+   print Dumper( $main::statusDB->{'nodePopulation'} ) if $main::config->{'flags'}->{'debug'} > 2;
-   my @targets;
-   if ( $main::targetNode ) {
+   if ( $main::config->{'flags'}->{'target'} ) {
-      push @targets, $main::targetNode;
+      push @targets, $main::config->{'flags'}->{'target'};
-   } else {
-      @targets = keys %{$main::statusDB->{'node'}};
+   }
+   @targets = keys %{$main::statusDB->{'node'}} unless @targets;
-   print "Scanning " . join( "\n", @targets ) . "\n" if $main::DEBUG;
+   print "Scanning " . join( "\n", @targets ) . "\n" if $main::config->{'flags'}->{'debug'};
    foreach my $node (@targets) {
       $main::statusDB->{'nodePopulation'}->{$node}->{'running'} = &getDomainsOnNode( $node );
       $main::statusDB->{'nodePopulation'}->{$node}->{'lastchecked'} = time;
       foreach my $domain ( keys %{$main::statusDB->{'nodePopulation'}->{$node}->{'running'}} ) {
          # make sure there is an entry for all of these domains
          $main::statusDB->{'virt'}->{$domain} = {} unless exists( $main::statusDB->{'virt'}->{$domain} );
+      }
-      print Dumper( $main::statusDB->{'nodePopulation'}->{$node} ) if $main::DEBUG > 2;
+      print Dumper( $main::statusDB->{'nodePopulation'}->{$node} ) if $main::config->{'flags'}->{'debug'} > 2;
+   }
    &main::writeDB();
    return "Node(s) updated\n";
+}
 # makes the command that will be run on a node
 # Created as a sub so we can change format easily
+# if node is the node we're on, we don't need to do a remote call
+# if node is null, we'll assume we do the command here
+# otherwise, we'll do an ssh to the node and run the command there
 sub makeCommand {
    my ( $node, $command ) = @_;
+   my $me = `hostname`;
+   chomp $me;
+   if ( ! $node || $node eq $me ) {
+      return $command;
+   } else {
-   return "ssh $node '$command'";
+      return "ssh $node '$command'";
+   }
+}
 # force a node scan, even if time has not expired
 sub forceScan {
-   my $save = $main::force;
+   my $save = $main::config->{'flags'}->{'yes'};
-   $main::force = 1;
+   $main::config->{'flags'}->{'yes'} = 1;
    &main::scan();
-   $main::force = $save;
+   $main::config->{'flags'}->{'yes'} = $save;
+}
 # executes command $command, then repeatedly runs virsh list
 # on $scanNode, grep'ing for $scanDomain
 # $condition is 1 (true) or 0 (false)
 sub executeAndWait {
    my ( $command, $scanNode, $scanDomain, $condition ) = @_;
    my $waitSeconds = 5; # number of seconds to wait before checking again
    my $maxIterations = 60 / $waitSeconds; # maximum number of tries
-   print "Running [$command], then waiting $waitSeconds to check if complete\n" if $main::DEBUG;
+   print "Running [$command], then waiting $waitSeconds to check if complete\n" if $main::config->{'flags'}->{'debug'};
    `$command`;
    my $waitCommand = &makeCommand( $scanNode, "virsh list | grep $scanDomain" );
    my $output = '';
    do {
       return 0 unless ( $maxIterations-- ); # we've waited too long, so probably not working
       print '. ';
-      sleep 5;
+      sleep 1;
       $output = `$waitCommand`;
-      print "[$waitCommand] returned [$output]\n" if $main::DEBUG > 1;
+      print "[$waitCommand] returned [$output]\n" if $main::config->{'flags'}->{'debug'} > 1;
    } until ( $condition ? $output : !$output );
    return 1; # made it successful
+}
 # find the differences between two arrays (passed by reference)
          $j++;
+      }
+   }
    return \@result;
+}
+# create a config file if one does not exist
+sub makeConfig {
+   my ( $config, $filename ) = @_;
+   $config->{'script dir'} = $FindBin::RealBin;
+   $config->{'script name'} = $FindBin::Script;
+   $config->{'db dir'} = $config->{'script dir'} . '/var';
+   $config->{'conf dir'} = $config->{'script dir'} . '/conf';
+   $config->{'status db filename'} = $config->{'db dir'} . '/status.yaml';
+   $config->{'last scan filename'} = $config->{'script dir'} . '/var/lastscan';
+   $config->{'minum scan time'} = 5 * 60; # five minutes
+   $config->{'node reserved memory'} = 8 * 1024 * 1024; # 8 gigabytes
+   $config->{'node reserved vcpu' } = 0; # turn off reserved vcpu
+   $config->{'flags'}->{'format'} = 'screen';
+   $config->{'flags'}->{'yes'} = 0;
+   $config->{'flags'}->{'quiet'} = 0;
+   $config->{'flags'}->{'target'} = '';
+   $config->{'flags'}->{'dryrun'} = 1;
+   $config->{'flags'}->{'debug'} = 0;
+   $config->{'flags'}->{'help'} = 0;
+   $config->{'flags'}->{'version'} = 0;
+   my $yaml = YAML::Tiny->new( $config );
+   $yaml->write( $filename );
+}
+# read the config file and return it
+sub readConfig {
+   my $filename = shift;
+   my $yaml = YAML::Tiny->new( {} );
+   if ( -f $filename ) {
+      $yaml = YAML::Tiny->read( $filename );
+   }
+   return $yaml->[0];
+}
+# find available resource on a node
+sub resource {
+   my $node = shift;
+   die "Can not find node $node in havirt.pm:resource\n"
+      unless $main::statusDB->{'node'}->{$node};
+   my $return = {
+      'memory' => 0,
+      'cpu_count' => 0
+      };
+   foreach my $key ( keys %$return ) {
+      $return->{$key} = $main::statusDB->{'node'}->{$node}->{$key}
+         if defined $main::statusDB->{'node'}->{$node}->{$key};
+   } # foreach
+   return $return;
+}
+sub getAvailableResources {
+   my $node = shift;
+   &readDB();
+   die "Can not find node $node in havirt.pm:resource\n"
+      unless $main::statusDB->{'node'}->{$node};
+   my $totalResources = &resource( $node );
+   print Dumper( $totalResources ) if $main::config->{'flags'}->{'debug'};
+   foreach my $domain ( keys %{ $main::statusDB->{'nodePopulation'}->{$node}->{'running'} } ) {
+      $totalResources->{'memory'} -= $main::statusDB->{'virt'}->{$domain}->{'memory'};
+      $totalResources->{'cpu_count'} -= $main::statusDB->{'virt'}->{$domain}->{'vcpu'};
+   }
+   return $totalResources;
+}
+# validate that node has enough resources for the domains which occupy the
+# remainder of the stack
+# returns 0 on success, or one or more error messages in a string on failure
+sub validateResources {
+   my $node = shift;
+   &readDB();
+   my @return;
+   my $nodeResources = &getAvailableResources( $node );
+   print "In havirt.pm:validateResources, checking if enough room on $node for\n" . join( "\n", @_ ) . "\n"
+      if ( $main::config->{'flags'}->{'debug'} );
+   # subtract the reserved memory from the node
+   $nodeResources->{'memory'} -= $main::config->{'node reserved memory'};
+   $nodeResources->{'cpu_count'} -= $main::config->{'node reserved vcpu'} if $main::config->{'node reserved vcpu'};
+   while ( my $domain = shift ) {
+      $nodeResources->{'memory'} -= $main::statusDB->{'virt'}->{$domain}->{'memory'};
+      $nodeResources->{'cpu_count'} -= $main::statusDB->{'virt'}->{$domain}->{'vcpu'};
+   }
+   print "In havirt.pm:validateResources, $node will have $nodeResources->{memory} memory and $nodeResources->{cpu_count} vcpu's after task\n"
+      if ( $main::config->{'flags'}->{'debug'} > 1 );
+   push @return, "This action would result in memory of $nodeResources->{memory}" if $nodeResources->{'memory'} <= 0;
+   push @return, "This action would result in virtual cpu count of $nodeResources->{cpu_count}" if $nodeResources->{'cpu_count'} <= 0 && $main::config->{'flags'}->{'node reserved vcpu'};
+   return @return ? join( "\n", @return ) . "\n" : 0;
+}
+# migrate domain from current node it is on to $target
+sub migrate {
+   my ( $virt, $target ) = @_;
+   my $return;
+   my $node;
+   # these are replaced by the safer findDomain
+   #&main::forceScan();
+   #&main::readDB();
+   $node = &main::findDomain( $virt );
+   print Dumper( $main::statusDB->{'nodePopulation'} ) if $main::config->{'flags'}->{'debug'} > 2;
+   die "I can not find $virt on any node\n" unless $node;
+   die "Domain $virt in maintenance mode, can not migrate it\n" if $main::statusDB->{'virt'}->{$virt}->{'maintenance'};
+   die "Node $target in maintenance mode, can not migrate anything to it\n" if $main::statusDB->{'node'}->{$target}->{'maintenance'};
+   die "$virt already on $target\n" if $target eq $node;
+   my $command = &main::makeCommand( $node, "virsh migrate --live --persistent --verbose  $virt qemu+ssh://$target/system" );
+   if ( $main::config->{'flags'}->{'yes'} ) { # they want us to actually do it
+      $return = ( &main::executeAndWait( $command, $node, $virt, 0 ) ? 'Success' : 'Time Out waiting for shutdown');
+      &main::forceScan();
+   } else {
+      $return = $command;
+   }
+   return "$return\n";
+}

Subversion Repositories havirt

(root)/trunk/havirt.pm – Rev 19 → 25