source: gs2-extensions/parallel-building/trunk/src/opt/Perseus/perseus-medusa.pl@ 29649

#!/usr/bin/perl

# Pragma
use strict;
use warnings;
$|++; # Unbuffer STDOUT

# Perl Built-in Modules
use Getopt::Long;
use IO::Socket::INET;
use Pod::Usage;

my $start_time = time();
print "[" . localtime($start_time) . "]\n";
print "===== Persus =====\n";
print "To slay a Medusa you need an appropriately shiney shield - this is\n";
print "that shield.\n";
print "\n";

# 1. Configuration
my $debug = 0;
my $help = 0;
my $kill_delay = 5;
my $listen_time = 60;
my $man = 0;
my $search_path = '/tmp/perseus.txt';
my $search_port = 0;
my $search_url = 'http://www.cms.waikato.ac.nz/~jmt12/perseus.txt';
GetOptions ('debug'         => \$debug,
            'kill_delay=i'  => \$kill_delay,
            'listen_port=i' => \$search_port,
            'listen_time=i' => \$listen_time,
            'path=s'        => \$search_path,
            'url=s'         => \$search_url,
            'help|?'        => \$help,
            man             => \$man
           )
or pod2usage(2);
if ($help)
{
  pod2usage(1);
}
if ($man)
{
 pod2usage(-exitval => 0, -verbose => 2);
}
print " * Configuration\n";
print "   - Debug? " . ($debug ? "Yes" : "No") . "\n";
print "   - Search path: " . $search_path . "\n";
print "   - Search URL: " . $search_url . "\n";
print "   - Search port: " . $search_port . "\n";
print "   - Listen time: " . $listen_time . " seconds\n";
print "   - Delay before KILL: " . $kill_delay . " seconds\n";

# 2. Search
print " * Looking for Instructions\n";
my $instructions = [];
print "   - Search for sentinel file... ";
if (&searchPath())
{
  print "Found\n";
}
else
{
  print "Not found\n";
}

if (scalar(@{$instructions}) == 0)
{
    print "   - Search for internet page... ";
    if (&searchURL())
    {
    print "Found\n";
    }
    else
    {
    print "Not found\n";
    }
    print "Done!\n";
}

if (scalar(@{$instructions}) == 0)
{
    if ($search_port > 0)
    {
    print "   - Listen on port... ";
    if (&searchPort())
    {
        print "Contacted\n";
    }
    else
    {
        print "No contact\n";
    }
    print "Done!\n";
    }
    else
    {
    print "  - Skipping port search\n";
    }
}


# 3. Action
if (scalar(@{$instructions}))
{
  print " * Processing Instructions\n";
  my @instructions2;
  # - terms and kills first
  my $instruction_ptr = pop(@{$instructions});
  while (defined $instruction_ptr)
  {
    my @instruction = @{$instruction_ptr};
    if ($instruction[0] eq 'pid')
    {
      &commandTerminate($instruction[1]);
    }
    else
    {
      push(@instructions2, $instruction_ptr);
    }
    $instruction_ptr = pop(@{$instructions});
  }
  # - then slays
  $instruction_ptr = pop(@instructions2);
  while (defined $instruction_ptr)
  {
    my @instruction = @{$instruction_ptr};
    if ($instruction[0] eq 'user')
    {
      &commandSlay($instruction[1]);
    }
    else
    {
      push(@{$instructions}, $instruction_ptr);
    }
    $instruction_ptr = pop(@instructions2);
  }
  # - then commands (reboot)
  $instruction_ptr = pop(@{$instructions});
  while (defined $instruction_ptr)
  {
    my @instruction = @{$instruction_ptr};
    if ($instruction[0] eq 'cmd' && $instruction[1] eq 'reboot')
    {
      &commandReboot();
    }
    else
    {
      push(@instructions2, $instruction_ptr);
    }
    $instruction_ptr = pop(@{$instructions});
  }
  # - left overs
  foreach $instruction_ptr (@instructions2)
  {
    my @instruction = @{$instruction_ptr};
    print "Error! Unrecognized instruction \"" . $instruction[0] . ":" . $instruction[1] . "\"\n";
  }
}
else
{
  print " * No Instructions!\n";
}

# 4. Complete!
my $end_time = time();
my $duration = $end_time - $start_time;
print "===== Complete in " . $duration . " seconds =====\n";
print "[" . localtime($end_time) . "]\n\n";
exit;


## @function commandIsRunning
#
sub commandIsRunning
{
  my ($pid) = @_;
  my $cmd = 'ps -p ' . $pid . ' > /dev/null';
  `$cmd`;
  my $retval = $?;
  return ($retval == 0);
}
## commandIsRunning() ##

## @function commandReboot
#
# Wait five minutes then reboot the machine
#
sub commandReboot
{
  print " - rebooting\n";
  print &shellCommand('shutdown -r +5', 1);
}
## commandReboot ##

## @function commandSlay
#
sub commandSlay
{
  my ($user) = @_;
  print " - slay all processes by: " . $user . "\n";
  print &shellCommand('slay -clean ' . $user);
}
## commandSlay() ##

## @function commandTerminate
#
sub commandTerminate
{
  my ($pid) = @_;
  if (&commandIsRunning($pid))
  {
    print " - terminate process: " . $pid . "... ";
    # send SIGTERM
    print &shellCommand('kill -s SIGTERM ' . $pid);
    # wait delay seconds
    sleep($kill_delay);
    # see if process still there
    if (&commandIsRunning($pid))
    {
      print "Failed\n";
      print " - kill process: " . $pid . "... ";
      print &shellCommand('kill -s SIGKILL ' . $pid);
      sleep($kill_delay);
      if (&commandIsRunning($pid))
      {
        print "Failed\n";
      }
      else
      {
        print "Killed\n";
      }
    }
    else
    {
      print "Terminated\n";
    }
  }
  else
  {
    print "  - can't terminate, no such process: " . $pid . "\n";
  }
  # if it is still running then it must be uninterruptable... nothing we can
  # do from here
}
## commandTerminate() ##


## @function parseInstructions
#
sub parseInstructions
{
  my ($content) = @_;
  my $instruction_count = 0;
  while ($content =~ s/(pid|user|cmd)\:([^\s]+)//i)
  {
    my $type = lc($1);
    my $value = $2;
    push(@{$instructions}, [$1, $2]);
    $instruction_count++;
  }
  return $instruction_count;
}
## parseInstructions() ##


## @function printDebug()
#
sub printDebug
{
  my ($msg) = @_;
  if ($debug)
  {
    print "[DEBUG] " . $msg . " [" . time() . "]\n";
  }
}
## printDebug() ##


## @function searchPath()
#
sub searchPath
{
  my $result = 0;
  # A user can ask us to do stuff by dumping a file here
  if (-e $search_path)
  {
    # read instructions (<type>:<value>\n) from the file
    if (open(FIN, '<:utf8', $search_path))
    {
      my $content;
      sysread(FIN, $content, -s $search_path);
      $result = &parseInstructions($content);
      close(FIN);
    }
    else
    {
      print STDERR "Error! Failed to open file for reading: " . $search_path . "\n";
    }
    # remove the file (if we can)
    #unlink($search_path);
  }
  return $result;
}
## searchPath() ##


## @function searchPort
#
sub searchPort
{
  my $result = 0;
  # timeout isn't implemented in Perl sockets, so we cheat and use an alarm
  # that interrupts an eval block
  eval {
    local $SIG{ALRM} = sub { die 'timeout' };
    alarm $listen_time;
    my $socket = IO::Socket::INET->new(Proto     => 'tcp',
                                       LocalPort => $search_port,
                                       Listen    => 1,
                                       ReuseAddr => 1
                                      );
    if (defined $socket)
    {
      print "[listening on port " . $search_port . "... ";
      while (my $client = $socket->accept())
      {
        print "connected... ";
        $client->autoflush(1);
        my $line;
        while ($line = <$client>)
        {
          $result += &parseInstruction($line);
        }
        close $client;
        print "complete]";
      }
    }
    else
    {
      print STDERR "Error! Failed to open socket for listening: " . $search_port . "\n";
    }
    alarm 0; # reset alarm
  };
  alarm 0; # reset alarm
  if (defined $@)
  {
    if ($@ =~ /timeout/)
    {
      print "timed out]";
    }
    else
    {
      print "Error! " . @! . "\n";
    }
  }
  return $result;
}
## searchPort() ##


## @function searchURL
#
sub searchURL
{
  # we use wget as it is simple, and doesn't require Perl module changes
  my $cmd = 'wget -q -O - "' . $search_url . '"';
  &printDebug($cmd);
  my $content = `$cmd`;
  my $result = &parseInstructions($content);
  return $result;
}
## searchURL() ##


## @function shellCommand()
#
sub shellCommand
{
  my ($cmd, $background) = @_;
  my $result = '';
  if ($debug)
  {
    &printDebug('shellCommand("' . $cmd . '")');
  }
  elsif (defined $background)
  {
    $result = `$cmd 2>&1 &`;
  }
  else
  {
    $result = `$cmd 2>&1`;
  }
  return $result;
}
## shellCommand() ##

__END__
=head1 NAME
sample - Using GetOpt::Long and Pod::Usage
=head1 SYNOPSIS
sample [options] [file ...]
 Options:
   -help            brief help message
   -man             full documentation
=head1 OPTIONS
=over 8
=item B<-help>
Print a brief help message and exits.
=item B<-man>
Prints the manual page and exits.
=back
=head1 DESCRIPTION
B<This program> will read the given input file(s) and do something useful with the contents thereof.
=cut