#!/usr/bin/perl
#
# Minisys: maintain a small "system" of programs
#

use strict;
use Getopt::Long;
use Cwd qw(abs_path);
use POSIX qw(setsid);
use IO::Handle;

my $version = "2008.200";
my $help = undef;
my $verbose = 0;
my $shutdown = undef;

my $sysreport = 0;
my $startdelay = 10;
my $restartdelay = 30;
my $termwait = 30;
#my $email = 'chad@iris.washington.edu';
my $email = '';
my $logdir = "log";
my $lmta = "/usr/lib/sendmail";

my $logfile = "$logdir/minisys.log";
my $pidfile = "$logdir/minisys.pid";
my $termfile = "$logdir/minisys.term";

# Parse command line arguments
my $getoptsret = GetOptions ( 'help|h'     => \$help,
                              'verbose|v'  => \$verbose,
                              'shutdown|s' => \$shutdown,
			    );

# Print simple help message
if ( $#ARGV < 0 ) {
  print "Minisys: maintain a list of processes\n\n";
  print "Usage: minisys config.msys\n\n";
  exit (1);
}

# Check for configuration file
die "Cannot find config file $ARGV[0]\n" if ( ! -f "$ARGV[0]" );

# Determine full path of configuration and hostname
my $config = abs_path ($ARGV[0]);
my $hostname = `uname -n`;

# Check for log directory and try to create if needed
if ( ! -d "$logdir" ) {
  mkdir ("$logdir", 0777) || die "Cannot create log directory: $logdir\n";
}

# Check for currently running minisys
if ( -f "$pidfile" ) {
  # Get running PID from file
  open (PID, "<$pidfile") || die "Cannot open PID file '$pidfile': $!\n";
  my $rpid = do { local $/, <PID> }; chomp ($rpid);
  close PID;
  
  # Check if PID is currently running
  if ( kill (0, $rpid) ) {
    # Set shutdown signal if requested
    if ( defined $shutdown ) {
      print STDERR "Shutting down running minisys (pid: $rpid)\n";
      &TermHandler;
      exit (0);
    }
    else {
      print STDERR "Minisys is already running as pid $rpid\n";
      exit (0);
    }
  }
  elsif ( defined $shutdown ) {
    print STDERR "Minisys instance is not currently running\n";
    print STDERR "No pid $rpid could be found, clearing pid file\n";
    if ( ! unlink ($pidfile) ) { print STDERR "Cannot unlink $pidfile: $!\n"; }
    exit (0);
  }
}
elsif ( defined $shutdown ) {
  print STDERR "Minisys instance is not currently running\n";
  exit (0);
}

# Clear termination signal file if present
if ( -f "$termfile" ) {
  unlink ($termfile) || die "Cannot remove termination signal file: $!\n";
}

# Set signal handers for SIGINT and SIGTERM
$SIG{'INT'} = 'TermHandler';
$SIG{'TERM'} = 'TermHandler';

# Daemonize this script
print STDERR "Daemonizing minisys\n";
&Daemonize;

# Open Minisys log file and re-direct STDERR there
print STDERR "Opening log file: $logfile\n" if ( $verbose >= 1 );
open (MLOG, ">>$logfile") || die "Cannot open $logfile: $!\n";
MLOG->autoflush(1);

# Save PID
my $mpid = $$;
print STDERR "Saving PID $mpid to $pidfile\n" if ( $verbose >= 1 );
open (PID, ">$pidfile") || die "Cannot open PID file '$pidfile': $!\n";
print PID "$mpid\n";
close PID;

# Re-direct STDERR to log file
open (STDERR, '>&MLOG') || die "Cannot re-direct stderr: $!\n";

&tlog ("Minisys starting");

# CHAD, send startup email

my %pid = ();
my %pcmd = ();
my %pstart = ();
my @procs = ();
my $cftime = undef;

# Loop until a termination file is present
while ( ! -f "$termfile" ) {

  # Process config file if modification time has changed
  if ( (-M "$config") != $cftime || ! defined $cftime ) {
    &ProcessConfig;
    $cftime = (-M "$config");
  }
  
  # Check for processes that have died
  foreach my $proc ( keys %pid ) {
    if ( ! kill (0, $pid{$proc}) ) {
      &tlog ("$proc (pid $pid{$proc}) died");
      &SendMsg ("Minisys: $proc (pid $pid{$proc}) died",
		"Minisys: $proc (pid $pid{$proc}) died\nScheduling restart in $restartdelay seconds");
      $pstart{$proc} = time + $restartdelay;
    }
  }
  
  # Check for processes that need to be terminated
  foreach my $proc ( keys %pcmd ) {
    if ( $pstart{$proc} < 0 ) {
      &tlog ("Terminating $proc (pid $pid{$proc})");
      &TermProcess ($pid{$proc});
      delete $pid{$proc};
      delete $pcmd{$proc};
      delete $start{$proc};
    }
  }
  
  # Check for processes that need to be executed
  my $ctime = time;
  my @startlist = ();
  foreach my $proc ( keys %pcmd ) {
    if ( $pstart{$proc} <= $ctime ) {
      push (@startlist, $proc);
    }
  }
  
  CHAD, startup the procs in startlist using $startdelay
  
  # Sleep for 1 second
  sleep 1;
}

# Shutdown sequence
#CHAD, shutdown all processes in reverse of @procs order
&ShutdownAll;

# Remove minisys pid and term file
&tlog ("Removing PID file") if ( $verbose >= 1 );
if ( ! unlink ($pidfile) ) { print MLOG "Cannot unlink $pidfile: $!\n"; }
&tlog ("Removing termination signal file") if ( $verbose >= 1 );
if ( ! unlink ($termfile) ) { print MLOG "Cannot unlink $termfile: $!\n"; }

# CHAD, send shutdown email

&tlog ("Minisys terminated.");

# Close minisys log file
close MLOG;

## End of main


# Process the config file
sub ProcessConfig {
  &tlog ("Processing config file");
  
  if ( ! open (CF, "<$config") ) {
    &tlog ("Cannot open config file $config: $!\n");
    return;
  }
  
  my $ctime = time;
  @proclist = (); # Reset list of processes
  
  # Process config file line-by-line
  foreach my $line (<CF>) {
    # Skip comment lines beginnig with #
    next if ( $line =~ /^#/ );
    
    if ( $line =~ /^Process\s/ ) {
      my ($proc, $cmd) = $line =~ /^Process\s+(\w+)\s+(.*)$/;
      
      if ( ! defined $proc || ! defined $cmd ) {
	&tlog ("Skipping Process line: '$line'");
      }
      else {
	$cmd =~ s/\s+//; # Trim trailing spaces
	
	push (@proclist, $proc);
	
	# If the process exists check if the command has changed
	if ( exists %pcmd{$proc} && $pcmd{$proc} ne $cmd ) {
	  &tlog ("$proc: command changed");
	  
	  # Trigger restart by setting process time to 0
	  $pstart{$proc} = $ctime;
	}
	
	# Otherwise add the command to the process list
	if ( ! exists %pcmd{$proc} ) {
	  $pcmd{$proc} = $cmd;
	  $pstart{$proc} = $ctime;
	}
      }
    } # End of Process
    
    elsif ( $line =~ /^Email\s/ ) {
      # Regex to test for valid email address
      my $validemailre = q{^([0-9a-zA-Z]([-.\w]*[0-9a-zA-Z])*@(([0-9a-zA-Z])+([-\w]*[0-9a-zA-Z])*\.)+[a-zA-Z]{2,9})$};
      
      my ($caddr) =~ /^Email\s+(.*)/;
      $caddr =~ s/\s+//; # Trim trailing spaces
      
      # Loop over specified addresses and validate them
      my @addrs = ();
      foreach my $addr ( split (/[\s,]+/, $cemail) ) {
	if ( $addr !~ /${validemailre}/) {
	  &tlog ("Email address '$addr' is invalid, skipping");
	}
	else {
	  push (@addrs, $addr);
	}
      }
      
      # Set email variable to combined addresses
      $email = join (' ', @addrs);
    } # End of Email
  } # End of parsing config file
  
  close (CF);
  
  # Check current process list against those in the config file and terminate those not found
  foreach my $rproc ( keys %pcmd ) {
    $pstart{$rproc} = -1 if ( ! grep (@proclist, $rpcoc) );
  }
}


# Shutdown all processes
sub ShutdownAll {
  &tlog ("Shutting down processes\n");
  
  # CHAD
}


# Execute a process and return the process ID
sub ExecProcess { # ExecProcess (command)
  my @cmd = @_;
  
  &tlog ("Executing: '@cmd'");
  
  # Fork process
  my $spid = fork;
  
  if ( ! defined $spid ) {
    $tlog ("Fork failed.");
    return $spid;
  }
  
  if ( ! $spid ) {
    # Exec the system command (replacing this child process)
    exec (@cmd);
    die "Exec of sub-process failed";
  }
  
  &tlog ("Executed PID: $spid") if ( $verbose >= 1 );
  
  return $spid;
}


# Terminate a process and return the process ID
sub TermProcess { # TermProcess (pid)
  my $pid = shift;
  
  &tlog ("Terminating pid $pid");
  
  # Send process the TERM signal
  kill ('TERM', $pid);
  
  # Wait up to $termwait seconds for process to terminate
  my $count = 0;
  while ( ! (kill 0, $pid) && $count < $termwait ) {
    $count++;
    sleep (1);
  }
  
  # If process is still running set the KILL signal
  if ( kill (0, $pid ) ) {
    kill ('KILL', $pid);
  }
}


# Send an email message
sub SendMsg {  # sendmsg (subject, message)
  my $subject = shift;
  my $message = shift;
  
  # Check that email address is defined
  return if ( ! $email );
  
  open ( MAIL, "|$lmta $email" ) || print MLOG "Error sending email: $!\n";
  print MAIL "From: minisys on $hostname\n";
  print MAIL "Subject: $subject\n";
  print MAIL "Minisys configuration: $config\n\n";
  print MAIL "$message";
  close MAIL;
} # End of sendmsg()


# Log messages with current time stamp
sub tlog { # tlog (message, options, ...)
  my $format = shift;
  my @variables = @_;
  
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
    localtime(time);
  $year += 1900;
  $mon += 1;
  my $tstamp = sprintf ("%04d-%02d-%02d %02d:%02d:%02d",
			$year, $mon, $mday, $hour, $min, $sec);
  
  # Log message with time stamp
  printf MLOG "$tstamp $format\n", @variables;
}


# Deamonize current process/script
sub Daemonize {
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
  
  defined (my $pid = fork) or die "Can't fork: $!";
  exit if $pid;
  setsid                  or die "Can't start a new session: $!";
}


# Termination signal handler
sub TermHandler {
  # Create termination signal file
  open (TF, ">$termfile") || die "Cannot create $termfile: $!\n";
  close (TF);
}