#!/usr/bin/perl -w
############################################################
# $Id: psmon,v 1.15 2005/04/13 17:29:39 nicolaw Exp $
# psmon - Process Table Monitor Script
# Copyright: (c)2002,2003,2004,2005 Nicola Worthington. All rights reserved.
############################################################
# This file is part of psmon.
#
# psmon is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# psmon is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with psmon; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
############################################################

=pod

=head1 NAME

psmon - Process Table Monitoring Script

=head1 VERSION

$Id: psmon,v 1.15 2005/04/13 17:29:39 nicolaw Exp $

=head1 SYNOPSIS

 Syntax: psmon [--conf=filename] [--daemon] [--cron] [--user=user] [--nouser]
               [--adminemail=emailaddress] [--dryrun] [--verbose]
               [--help] [--version]

    --help            Display this help
    --version         Display full version information
    --dryrun          Dryrun (do not actually kill or spawn and processes)
    --daemon          Spawn in to background daemon
    --cron            Disables 'already running' errors with the --daemon option
    --conf=str        Specify alternative config filename
    --user=str        Only scan the process table for processes running as str
    --nouser          Force scanning for all users when not run as superuser
    --adminemail=str  Force all notification emails to be sent to str
    --verbose         Output more verbose information

=head2 Crontab

Single user account crontab operation:

    MAILTO="nicolaw@cpan.org"
    HOME=/home/nicolaw
    USER=nicolaw
    */5 * * * *    psmon --daemon --cron --conf=$HOME/etc/psmon.conf --user=$USER --adminemail=$MAILTO

Regular system-wide call from cron:

    */5 * * * *    psmon --daemon --cron

Only check processes during working office hours:

    * 9-17 * * *   psmon

=head1 DESCRIPTION

This script monitors the process table using Proc::ProcessTable, and
will respawn or kill processes based on a set of rules defined in an
Apache style configuration file.

Processes will be respawned if a spawn command is defined for a process,
and no occurrences of that process are running. If the --user command line
option is specified, then the process will only be spawned if no instances
are running as the specified userid.

Processes can be killed off if they have been running for too long,
use too much CPU or memory resources, or have too many concurrent
versions running. Exceptions can be made to kill rulesets using the
I<pidfile> and I<lastsafepid> directives.

If a PID file is declared for a process, psmon will never kill the
process ID that is contained within the pid file. This is useful if for
example, you have a script which spawns hundreds of child processes
which you may need to automatically kill, but you do not want to kill
the parent process.

Any actions performed will be logged to the DAEMON syslog facility by default.
There is support to optionally also send notifications emails to an
administrator on a global or pre-rule basis.

=head1 OPERATION

=over 4

=item --dryrun

Execute a dry-run (do not actually kill or spawn and processes).

=item --conf=I<filename>

Specify alternative config filename. The configuration file defaults
to /etc/psmon.conf when running as superuser, or ~/etc/psmon.conf when
running as a non-superuser.

=item --daemon

Spawn in to background daemon.

=item --cron

Disables already running warnings when trying to launch as another daemon.

=item --user=I<user>

Only scan the process table for processes running under this username.

=item --nouser

Force scanning for all users when not run as superuser. By default psmon
will only scan processes belonging to the current user for non-superusers.

=item --adminemail=I<emailaddress>

Force all notification emails to be sent to this email address.

=item --verbose

Output more verbose information.

=back

=head1 INSTALLATION

In addition to Perl 5.005_03 or higher, the following Perl modules are
required:

    Getopt::Long
    Config::General
    POSIX
    Proc::ProcessTable
    Net::SMTP
    Unix::Syslog
    File::Basename

The POSIX module is usually supplied with Perl as standard, as is
Getopt::Long. All these modules can be obtained from CPAN. Visit
http://search.span.org and http://www.cpan.org for further details.
For the lazy people reading this, you can try the
following command to install these modules:

    for m in Getopt::Long Config::General POSIX Proc::ProcessTable \
      Net::SMTP Unix::Syslog;do perl -MCPAN -e"install $m";done

Alternatively you can run the install.sh script which comes in the
distribution tarball. It will attempt to install the right modules,
install the script and configuration file, and generate UNIX man page
documentation.

By default psmon will look for its runtime configuration in /etc/psmon.conf,
although this can be defined as otherwise from the command line. For system
wide installations it is recommended that you install your psmon in to the
default location.

=cut



package PSMon;

use strict;
use warnings;

use English;
use Getopt::Long ();
use Config::General ();
use POSIX ();
use Proc::ProcessTable ();
use File::Basename ();

# Define constants
use constant DEBUG		=> 0;  # This should be reset back to 0 for public releases
use constant PREFIX		=> ''; # You may want to set this to /home/joeb or something

# Declare global package variables
use vars qw($VERSION $SELF %OPT %C); # I want to move %OPT, and %C out of global space

# These English variables and globals are okay to stay
$WARNING			= 1;
$OUTPUT_AUTOFLUSH	= 1;
($SELF = $PROGRAM_NAME)	=~ s|^.*/||;
$VERSION = sprintf('%d.%02d', q$Revision: 1.15 $ =~ /(\d+)/g);

# Get command line options
%OPT = ( default_conf => PREFIX.'/etc/psmon.conf' );
Getopt::Long::GetOptions(\%OPT, qw(help version verbose daemon cron dryrun
								conf=s config=s user=s nouser adminemail=s));

# Display help or version info and exit if required
display_help(0) if exists $OPT{help};
display_version(0) if exists $OPT{version};

# Open syslog with PERROR (output to terminal)
my $msg = PSMon::Logging->new(
				options => \%OPT, config => \%C,
				SELF => $SELF, DEBUG => DEBUG, PREFIX => PREFIX
			);

# Check the user we should be running as
parse_user_to_run_as();
$OPT{conf} ||= $OPT{config};
$OPT{conf} = get_config_to_read_from($OPT{conf});



=pod

=head1 CONFIGURATION

The default configuration file location is /etc/psmon.conf. A different
configuration file can be declared from the command line. You will find
an example configuration file supplied in the etc/ directory of the
distribution tarball. It is recommended that you use this as a guide to
writing your own configuration file by hand. Alternatively you can use
the B<psmon-config> script which will interactively create a configuration
for you.

Syntax of the configuration file is based upon that which is used by
Apache. Each process to be monitored is declared with a Process scope
directive like this example which monitors the OpenSSH daemon:

    <Process sshd>
        spawncmd    /sbin/service sshd start
        pidfile     /var/run/sshd.pid
        instances   50
        pctcpu      90
    </Process>

There is a special I<*> process scope which applies to I<all> running
processes. This special scope should be used with extreme care. It does
not support the use of the I<spawncmd>, I<pidfile>, I<instances> or I<ttl>
directives. A typical example of this scope might be as follows:

    <Process *>
        pctcpu    95
        pctmem    80
    </Process>

Global directives which are not specific to any one process should be placed
outside of any Process scopes.

=head2 DIRECTIVES

=over 4

=item Facility

Defines which syslog facility to log to. Valid options are as follows;
LOG_KERN, LOG_USER, LOG_MAIL, LOG_DAEMON, LOG_AUTH, LOG_SYSLOG, LOG_LPR,
LOG_NEWS, LOG_UUCP, LOG_CRON, LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2,
LOG_LOCAL3, LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6 and LOG_LOCAL7. Defaults
to LOG_DAEMON.

=item LogLevel

Defines the loglevel priority that notifications to syslog will be
marked as. Valid options are as follows; LOG_EMERG, LOG_ALERT, LOG_CRIT,
LOG_ERR, LOG_WARNING, LOG_NOTICE, LOG_INFO and LOG_DEBUG. The log level
used by a notification for any failed action will automatically be
raised to the next level in order to highlight the failure. May be also be used
in a Process scope which will take priority over a global declaration.
Defaults to LOG_NOTICE.

=item KillLogLevel (previously KillPIDLogLevel)

The same as the loglevel directive, but only applies to process kill actions.
Takes priority over the loglevel directive. May be also be used in a
Process scope which will take priority over a global declaration.
Undefined by default.

=item SpawnLogLevel

The same as the loglevel directive, but only applies to process spawn actions.
Takes priority over the loglevel directive. May be also be used in a
Process scope which will take priority over a global declaration.
Undefined by default.

=item AdminEmail

Defines the email address where notification emails should be sent to.
May be also be used in a Process scope which will take priority over a
global declaration. Defaults to root@localhost.

=item NotifyEmailFrom

Defines the email address that notification email should be addresses
from. Defaults to <username>@I<hostname>.

=item Frequency

Defines the frequency of process table queries. Defaults to 60 seconds.

=item LastSafePID

When defined, psmon will never attempt to kill a process ID which is
numerically less than or equal to the value defined by lastsafepid. It
should be noted that psmon will never attempt to kill itself, or a process ID
less than or equal to 1. Defaults to 100.

=item ProtectSafePIDsQuietly

Accepts a boolean value of On or Off. Suppresses all notifications of
preserved process IDs when used in conjunction with the I<lastsafepid>
directive. Defaults to Off.

=item SMTPHost

Defines the IP address or hostname of the SMTP server to used to send
email notifications. Defaults to localhost.

=item SMTPTimeout

Defines the timeout in seconds to be used during SMTP connections.
Defaults to 20 seconds.

=item SendmailCmd

Defines the sendmail command to use to send notification emails if there
is a failure with the SMTP connection to the host defined by I<smtphost>.
Defaults to '/usr/sbin/sendmail -t'.

=item DefaultEmailMethod

Defines which method should be used by default to try and send notification
emails. Legal values are 'SMTP' or 'sendmail'. Defaults to 'sendmail'.

=item Dryrun

Forces this psmon to as if the --dryrun command line switch had specified.
This is useful if you want to force a specific configuration file to only
report and never actually take any automated action.

=item NotifyDetail

Defines the verbosity of notification emails which are sent. Can be set
to 'Simple', 'Verbose' or 'Debug'. Defaults to 'Verbose'. This directive
is depreciated.

=item NeverKillPID

Accepts a space delimited list of PIDs which will never be killed.
Defaults to 1.

=item NeverKillProcessName

Accepts a space delimited list of process names which will never be
killed. Defaults to 'kswapd kupdated mdrecoveryd pageout sched init'.

=back

=head2 PROCESS SCOPE DIRECTIVES

=over 4

=item SpawnCmd

Defines the full command line to be executed in order to respawn a dead
process.

=item KillCmd

Defines the full command line to be executed in order to gracefully
shutdown or kill a rogue process. If the command returns a boolean true
exit status then it is assumed that the command failed to execute
successfully. If no KillCmd is specified or the command fails, the
process will be killed by sending a SIGKILL signal with the standard
kill() function. Undefined by default.

=item PIDFile

Defines the full path and filename of a file created by a process which
contain it's main parent process ID.

=item TTL

Defines a maximum time to live (in seconds) of a process. The process
will be killed once it has been running longer than this value, and
it's process ID isn't contained in the defined pidfile.

=item PctCpu

Defines a maximum allowable percentage of CPU time a process may use.
The process will be killed once it's CPU usage exceeds this threshold
and it's process ID isn't contained in the defined pidfile.

=item PctMem

Defines a maximum allowable percentage of total system memory a process
may use. The process will be killed once it's memory usage exceeds this
threshold and it's process ID isn't contained in the defined pidfile.

=item Instances

Defines a maximum number of instances of a process which may run. The
process will be killed once there are more than this number of occurrences
running, and it's process ID isn't contained in the defined pid file.

=item NoEmailOnKill

Accepts a boolean value of True or False. Surpresses process killing
notification emails for this process scope. Defaults to False.

=item NoEmailOnSpawn

Accepts a boolean value of True or False. Surpresses process spawning
notification emails for this process scope. Defaults to False.

=item NoEmail

Accepts a boolean value of True or False. Surpresses all notification
emails for this process scope. Defaults to False.

=back

=head2 EXAMPLES

    <Process syslogd>
        spawncmd       /sbin/service syslogd restart
        pidfile        /var/run/syslogd.pid
        instances      1
        pctcpu         70
        pctmem         30
    </Process>

Syslog is a good example of a process which can get a little full
of itself under certain circumstances, and excessively hog CPU and
memory. Here we will kill off syslogd processes if it exceeds 70%
CPU or 30% memory utilization.

Older running copies of syslogd will be killed if they are running,
while leaving the most recently spawned copy which will be listed in
the PID file defined.

    <Process httpd>
        spawncmd      /sbin/service httpd restart
        pidfile       /var/run/httpd.pid
        loglevel      critical
        adminemail    pager@noc.company.com
    </Process>

Here we are monitoring Apache to ensure that it is restarted if
it dies. The pidfile directive in this example is actually
redundant because we have not defined any rule where we should
consider killing any httpd processes.

All notifications relating to this process will be logged with the
syslog priority of critical (LOG_CRIT), and all emailed to
pager@noc.company.com which could typically forward to a pager.

Any failed attempts to kill or restart a process will automatically
be logged as a syslog priority one level higher than that specified.
If a restart of Apache were to fail in this example, a wall
notification would be broadcast to all interactive terminals
connected to the machine, since the next log priority up from
LOG_CRIT is LOG_EMERG.

    <Process find>
        noemail    True
        ttl        3600
    </Process>

Kill old find processes which have been running for over an hour.
Do not send an email notification since it's not too important.

=cut




# Read the config file and setup signal handlers
%C = read_config($OPT{conf});
$OPT{dryrun} = 1 if $C{dryrun};
if ($C{disabled}) {
	$msg->Log('LOG_CRIT', "Your configuration file '$OPT{conf}' is disabled. Remove the 'Disabled True' directive from the file.");
	exit 3;
}



=pod

=head1 SIGNALS

=over 4

=item HUP

Forces an immediate reload of the configuration file. You should
send the HUP signal when you are running psmon as a background
daemon and have altered the psmon.conf file.

=item USR1

Forces an immediate scan of the process table.

=back

=head1 EXIT CODES

=over 4

=item Value 0: Exited gracefully

The program exited gracefully.

=item Value 2: Failure to lookup UID for username

The username specified by the --user command line option did not resolve to a valid
UID.

=item Value 3: Configuration file is disabled

The configuration file is disabled. (It contains an active 'Disabled' directive).

=item Value 4: Configuration file does not exist

The specified configuration file, (default or user specified) does not exist.

=item Value 5: Unable to open PID file handle

Failed to open a read-only file handle for the runtime PID file.

=item Value 6: Failed to fork

An error occurred while attempting to fork the child background daemon process.

=item Value 7: Unable to open PID file handle

Failed to open a write file handle for the runtime PID file.

=item Value 8: Failure to load Perl module

One or more Perl module could not be loaded. This usually happens when one of the
required Perl modules which psmon depends upon is not installed or could not be located
in the Perl LIB search path.

=back

=head1 PERFORMANCE

psmon is not especially fast. Much of it's time is spent reading the process table.
If the process table is particularly large this can take a number of seconds.
Although is rarely a major problem on todays speedy machines, I have run a few tests
so you take look at the times and decide if you can afford the wait.

 CPU             OS              Open Files/Procs    1m Load    Real Time
 PIII 1.1G       Mandrake 9.0         10148 / 267       0.01     0m0.430s
 PIII 1.2G       Mandrake 9.0         16714 / 304       0.44     0m0.640s
 Celeron 500     Red Hat 6.1           1780 /  81       1.27     0m0.880s
 PII 450         Red Hat 6.0            300 /  23       0.01     0m1.050s
 2x Xeon 1.8G    Mandrake 9.0         90530 / 750       0.38     0m1.130s
 Celeron 500     Red Hat 6.1           1517 /  77       1.00     0m1.450s
 PIII 866        Red Hat 8.0           3769 /  76       0.63     0m1.662s
 PIII 750        Red Hat 6.2            754 /  35       3.50     0m2.170s

(Figures are accurate as of release 1.0.3).

These production machines were running the latest patched stock distribution kernels.
I have listed the total number of open file descriptors, processes running and 1 minute
load average to give you a slightly better context of the performance.

=cut

# Run a single check
unless (exists $OPT{daemon}) {
	print "Reopening syslog facility\n" if $OPT{verbose};
	# Reopen syslog without PERROR (no output to terminal)
	$msg->closelog();
	$msg->openlog($C{facility});

	# Run a single check
	check_processtable(exists $OPT{user} ? $OPT{user} : '');

# Run as a daemon
} else {
	# Read the config file and setup signal handlers
	$SIG{'HUP'} = sub {
			$msg->Log('LOG_NOTICE', 'Recieved SIGHUP; reloading configuration');
			%C = read_config($OPT{conf});
		};
	$SIG{'USR1'} = sub {
			$msg->Log('LOG_NOTICE', 'Recieved SIGUSR1; checking process table immediately');
			check_processtable(exists $OPT{user} ? $OPT{user} : '');
		};

	# Figure out the PID file name
	my ($x,$y) = (POSIX::getcwd.$OPT{conf},0);
	for (0..length($x)-1) { $y += ord substr($x,$_,1); }
	my @piddirs = qw(/var/run /tmp .);
	my $pidfile = '/var/run/psmon.pid';
	for my $piddir (@piddirs) {
		my $pidfile2 = sprintf("%s%s/%s-%s-%s.pid", PREFIX,
					$piddir,
					$SELF,
					($OPT{user} ? $OPT{user} : $EFFECTIVE_USER_ID),
					$y
				);
		if (-d File::Basename::dirname($pidfile2) && -w File::Basename::dirname($pidfile2)) {
			$pidfile = $pidfile2;
			last;
		}
	}

	print "Using PID file $pidfile\n" if $OPT{verbose};

	if (DEBUG) {
		print "\$OPT{conf} = $OPT{conf}\n";
		print "\$OPT{default_conf} = $OPT{default_conf}\n";
		print "\$pidfile = $pidfile\n";
	}

	# Launch in to the background
	daemonize($pidfile);

	# Reopen syslog without PERROR (no output to terminal)
	$msg->closelog();
	$msg->openlog($C{facility});

	# Die if you remove the runtime PID file 
	while (-f $pidfile) {
		check_processtable(exists $OPT{user} ? $OPT{user} : '');
		sleep $C{frequency};
	}
}

# Finish
$msg->Log('LOG_NOTICE', "Terminating.\n");
$msg->closelog();
exit;





########################################
# User subroutines

=pod

=head1 SUBROUTINES

=over 4

=item check_processtable()

Reads the current process table, checks and then executes any appropriate
action to be taken. Does not accept any parameters. 

=cut

sub check_processtable {
	my $uid = shift;

	# Slurp in the process table
	my %proc;
	print "Scanning process table\n" if $OPT{verbose};
	my $t = new Proc::ProcessTable;
	foreach my $p (@{$t->table}) {
		# Only grab information on processes we have rules for
		next unless $C{process}->{'*'} || $C{process}->{$p->{fname}};

		# Skip processes that don't belong to the specified UID if applicable
		next if $uid && $p->{uid} != $uid;

		my $i = !exists $proc{$p->{fname}} ? 0 : @{$proc{$p->{fname}}};
		$proc{$p->{fname}}->[$i] = {
				pid		=> $p->{pid},
				ppid	=> $p->{ppid},
				fname	=> $p->{fname},
				tty		=> $p->{ttynum},
				start	=> $p->{start},
				pctcpu	=> isnumeric($p->{pctcpu}) || 0,
				pctmem	=> isnumeric($p->{pctmem}) || 0,
			};
	}
	undef $t;

	if (DEBUG) {
		require Data::Dumper;
		print Dumper(\%proc);
	}

	print "Calculating action to take\n" if $OPT{verbose};

	# Build a list of bad naughty processes
	my %slay;
	foreach my $process (keys %{$C{process}}) {
		next unless exists $proc{$process} || $process eq '*';

		if (DEBUG) {
			print "Checking $process ... \n";
			require Data::Dumper;
			print Dumper($C{process}->{$process});
		}

		foreach my $p (@{$proc{$process}}) {
			# Too many instances running
			if ($C{process}->{$process}->{instances} && @{$proc{$process}} > $C{process}->{$process}->{instances}) {
				push @{$slay{$process}}, {
						pid	=> $p->{pid},
						cause	=> 'instances',
						reason	=> sprintf("%d instances exceeds limit of %d",
								scalar @{$proc{$process}},
								$C{process}->{$process}->{instances})
					}
			}

			# Exceeded TTL
			if ($C{process}->{$process}->{ttl} && time() - $p->{start} > $C{process}->{$process}->{ttl}) {
				push @{$slay{$process}}, {
						pid	=> $p->{pid},
						cause	=> 'ttl',
						reason	=> sprintf("%d exceeds TTL of %d",
								time() - $p->{start},
								$C{process}->{$process}->{ttl})
					}
			} 

			# Check CPU and Memory usage
			pctcheck($process,$p,\%slay);
		}
	}

	# Check CPU and Memory usage for *ALL* processes
	if ($C{process}->{'*'}) {
		while (my ($process,$proclist) = each %proc) {
			for my $p (@{$proclist}) {
				pctcheck($process,$p,\%slay,'*');
			}
		}
	}

	# Check CPU and Memory usage
	sub pctcheck {
		my ($process,$p,$slayref,$scope) = @_;
		$scope ||= $process;

		# Exceeded CPU Percent
		$C{process}->{$scope}->{pctcpu} = isnumeric($C{process}->{$scope}->{pctcpu});
		if ($C{process}->{$scope}->{pctcpu} && $p->{pctcpu} > $C{process}->{$scope}->{pctcpu}) {
			push @{$slayref->{$process}}, {
					pid		=> $p->{pid},
					cause	=> 'pctcpu',
					reason	=> sprintf("%.2f%% CPU usage exceeds limit of %.2f%%",
									$p->{pctcpu},
									$C{process}->{$scope}->{pctcpu})
				}
		}

		# Exceeded Memory Percent
		$C{process}->{$scope}->{pctmem} = isnumeric($C{process}->{$scope}->{pctmem});
		if ($C{process}->{$scope}->{pctmem} && $p->{pctmem} > $C{process}->{$scope}->{pctmem}) {
			push @{$slayref->{$process}}, {
					pid		=> $p->{pid},
					cause	=> 'pctmem',
					reason	=> sprintf("%.2f%% memory usage exceeds limit of %.2f%%",
									$p->{pctmem},
									$C{process}->{$scope}->{pctmem})
				}
		}
	}

	print "Killing bad processes\n" if keys %slay && $OPT{verbose};
	# Kill naughty processes
	while (my ($process,$aryref) = each %slay) {
		# Decide what loglevel we should report the action as
		my $loglevel = $msg->loglevel($C{process}->{$process}->{killloglevel} ||
					$C{process}->{$process}->{loglevel} ||
					$C{killloglevel} || $C{loglevel} || $msg->loglevel('LOG_NOTICE'));

		# Protect safe process IDs
		if ($C{process}->{$process}->{pidfile} && !$C{process}->{$process}->{ppid}) {
			if (-e $C{process}->{$process}->{pidfile} && open(FH,$C{process}->{$process}->{pidfile})) {
				$C{process}->{$process}->{ppid} = <FH>;
				chomp $C{process}->{$process}->{ppid};
				close(FH);
			}
		}
		my $ppid = $C{process}->{$process}->{ppid} || 0;

		# See about slaying each of these process instances
		foreach my $slayref (@{$aryref}) {
			next if    $slayref->{pid} == $ppid
				|| $slayref->{pid} == $$
				|| $slayref->{pid} <= 1
				|| $C{neverkillpid} =~ /\b$slayref->{pid}\b/
				|| $C{neverkillprocessname} =~ /(^|\s+)$process(\s+|$)/;

			# Define who to mail alerts to
			my $mailto = ($C{process}->{$process}->{noemailonkill} || $C{process}->{$process}->{noemail}) ? '' : 
					$C{process}->{$process}->{adminemail} || $C{adminemail};

			# Try to slay the process
			slay_process($process, $loglevel, $mailto, $slayref,
				exists $C{process}->{$process}->{killcmd} ? $C{process}->{$process}->{killcmd} : '');
		}
	}

	# Spawn any dead processes
	foreach my $process (keys %{$C{process}}) {
		# Only attempt to spawn a process if there are no current instances, and there is a spawncmd directive defined
		if (!exists $proc{$process} && exists $C{process}->{$process}->{spawncmd}) {

			# Decide what loglevel we should report the action as
			my $loglevel = $msg->loglevel($C{process}->{$process}->{spawnloglevel} ||
						$C{process}->{$process}->{loglevel} ||
						$C{spawnloglevel} || $C{loglevel} || $msg->loglevel('LOG_NOTICE'));

			# Define who to mail alerts to
			my $mailto = ($C{process}->{$process}->{noemailonspawn} || $C{process}->{$process}->{noemail}) ? '' : 
					$C{process}->{$process}->{adminemail} || $C{adminemail};

			# Try to spawn the process
			spawn_process($process, $loglevel, $mailto, $C{process}->{$process}->{spawncmd});
		}
	}

	# Explicitly nuke it for the paranoid (yes I know it's a locally scoped lexical!) ;-)
	undef %proc;
}

=pod

=item slay_process()

Attempts to kill a process with it's killcmd, or failing that using the kill() function.
Accepts the process name, syslog log level, email notification to address and a reference
to the %slay hash.

=cut

# Type to slay a process
sub slay_process {
	my ($process, $loglevel, $mailto, $slayref, $cmd) = @_;

	# Protect safe processes
	if ($slayref->{pid} <= $C{lastsafepid} && !$C{protectsafepidsquietly}) {
		print_init_style("Saving PID $slayref->{pid} ($process) from death",'OK');
		alert($loglevel, $mailto, "Saved safe PID $slayref->{pid} ($process) from death");

	# This process is not protected
	} else { 
		print_init_style("Killing PID $slayref->{pid} ($process)");

		my $cmdrtn = $cmd && !exists $OPT{dryrun} ? system("$cmd > /dev/null 2>&1") : 0;
		if ($cmd) { # Tried to stop with the killcmd directive 
 			if ($cmdrtn) {
				print_init_style('FAILED');
				alert($loglevel-1, $mailto, "Failed to execute '$cmd' to kill PID $slayref->{pid} ($process)");
			} else {
				print_init_style('OK');
				alert($loglevel, $mailto, "Executed '$cmd' to kill PID $slayref->{pid} ($process)");
			}
		}

		# Don't try if killcmd was tried and succeded
		unless ($cmd && !$cmdrtn) { 
			my $killrtn = !exists $OPT{dryrun} ? kill(9,$slayref->{pid}) : 1;
			if ($killrtn) {
				print_init_style('KILLED');
				alert($loglevel, $mailto, "Killed PID $slayref->{pid} ($process) because $slayref->{reason}");
			} else {
				print_init_style('FAILED');
				alert($loglevel-1, $mailto, "Failed to kill PID $slayref->{pid} ($process)");
			}
		}
	}
}

=pod

=item print_init_style()

Prints a Red Hat sysvinit style status message. Accepts an array of messages
to display in sequence.

=cut

# Print a Red Hat sysinitv style status message
sub print_init_style {
	return if $OPT{daemon};
	foreach my $message (@_) {
		if (length($message) <= 6) {
			print "\033[60G\[";
			if    (exists $OPT{dryrun})    { print "\033[1;33mDRYRUN";  }
			elsif ($message eq 'OK')     { print "\033[1;32m  OK  ";  }
			elsif ($message eq 'FAILED') { print "\033[1;31m$message"; }
			elsif ($message eq 'KILLED' || $message eq 'DRYRUN') { print "\033[1;33m$message"; }
			print "\033[0;39m\]\n";
		} else {
			print $message;
		}
	}
}

=pod

=item spawn_process()

Attempts to spawn a process. Accepts the process name, syslog log level, mail
notification to address and spawn command.

=cut

# Spawn a process
sub spawn_process {
	my ($process, $loglevel, $mailto, $cmd) = @_;

	print_init_style("Starting $process");
	my $rtn = !exists $OPT{dryrun} ? system("$cmd > /dev/null 2>&1") : 0;
	if ($rtn) {
		print_init_style('FAILED');
		alert($loglevel-1, $mailto, "Failed to spawn '$process' with '$cmd'");
	} else {
		print_init_style('OK');
		alert($loglevel, $mailto, "Spawned '$process' with '$cmd'");
	}
}

=pod

=item display_help()

Displays command line help.

=cut

# Command line help
sub display_help {
	my $rtn = shift;
	require Pod::Usage;
	Pod::Usage::pod2usage(-verbose => 2);
	exit($rtn) if defined $rtn;
}

sub is_superuser {
	my $uid = shift;
	return 1 if $uid == 0;
}

sub get_config_to_read_from {
	my $filename = shift || '';

	my $retval = sprintf('%s/etc/psmon.conf',$ENV{HOME});
	if (-f $filename && -r $filename) {
		$retval = $filename;
	} elsif (is_superuser($EFFECTIVE_USER_ID)) {
		$retval = $OPT{default_conf};
	}

	print "Using $retval configuration file\n" if $OPT{verbose};
	return $retval;
}

=pod

=item parse_user_to_run_as()

Determine what UID to scan for in the process table.

=cut

sub parse_user_to_run_as {
	if (exists $OPT{user}) {
		my $name = $OPT{user};
		$OPT{user} = scalar getpwnam($OPT{user}) || '';
		unless ($OPT{user}) {
			$msg->Log('LOG_CRIT', "Invalid user specified: '$name'");
			exit 2;
		}
	} elsif (!is_superuser($EFFECTIVE_USER_ID) && !exists $OPT{nouser}) {
		$OPT{user} = $EFFECTIVE_USER_ID;
	}
	if ($OPT{verbose} && exists $OPT{user} && length($OPT{user} >= 1)) {
		my $name = scalar getpwuid($OPT{user});
		print "Scanning for processes owned by UID $OPT{user} ($name)\n";
	}
}
		

=pod

=item read_config()

Reads in runtime configuration options.

=cut

# Read in the config
sub read_config {
	my $config_file = shift;

	# Barf and die if there's no configuration file!
	unless (-e $config_file) {
		$msg->Log('LOG_CRIT', "Configuration file $config_file does not exist\n");
		exit 4;
	}

	# Define default configuration values
	my %default = (
			facility				=> 'LOG_DAEMON',
			loglevel				=> 'LOG_NOTICE',
			adminemail				=> 'root@localhost',
			notifyemailfrom			=> sprintf('%s@%s',(getpwuid($EFFECTIVE_USER_ID))[0],(POSIX::uname())[1]),
			smtphost				=> 'localhost',
			smtptimeout				=> 20,
			sendmailcmd				=> '/usr/sbin/sendmail -t',
			defaultemailmethod		=> 'sendmail',
			frequency				=> 60,
			lastsafepid				=> 100,
			neverkillpid			=> 1,
			neverkillprocessname	=> 'kswapd kupdated mdrecoveryd pageout sched init',
			protectsafepidsquietly	=> 0,
			notifydetail			=> 'verbose',
		);

	# Read config file
	my $conf = new Config::General(
			-ConfigFile				=> $config_file,
			-LowerCaseNames			=> 1,
			-UseApacheInclude		=> 1,
			-IncludeRelative		=> 1,
			-DefaultConfig			=> \%default,
			-MergeDuplicateBlocks	=> 1,
			-AllowMultiOptions		=> 1,
			-MergeDuplicateOptions	=> 1,
			-AutoTrue				=> 1,
		);
	print "Reading configuration file\n" if $OPT{verbose};
	my %config = $conf->getall;

	# Force default values for dodgy user configuration options
	$config{frequency} = $default{frequency} unless $config{frequency} =~ /^\d+$/;
	$config{lastsafepid} = isnumeric($config{lastsafepid}) || $default{lastsafepid};

	return %config;
}





########################################
# Subroutines

=pod

=item isnumeric()

An evil bastard fudge to ensure that we're only dealing with numerics when
necessary, from the config file and Proc::ProcessTable scan.

=cut

sub isnumeric {
        local $_ = shift || '';
        if (/^\s*(\-?[\d\.]+)\s*/) { return $1; }
        return undef;
}

=pod

=item daemonize()

Launches the process in to the background. Checks to see if there is already an
instance running.

=cut

# Daemonize self
sub daemonize {
	my $pidfile = shift;
	# Check that we're not already running, and quit if we are
	if (-f $pidfile) {
		unless (open(PID,$pidfile)) {
			$msg->Log('LOG_CRIT', "Unable to open file handle PID for file '$pidfile': $!\n");
			exit 5;
		}
		my $pid = <PID>;
		close(PID) || $msg->Log('LOG_WARNING', "Unable to close file handle PID for file '$pidfile': $!\n");
		print `ls -al /proc/$pid/stat` if DEBUG;
		if (-f "/proc/$pid/stat") {
			open(FH,"/proc/$pid/stat") || $msg->Log('LOG_WARNING', "Unable to open file handle FH for file '/proc/$pid/stat': $!\n");
			my $line = <FH>;
			close(FH) || $msg->Log('LOG_WARNING', "Unable to close file handle FH for file '/proc/$pid/stat': $!\n");
			if ($line =~ /\d+[^(]*\((.*)\)\s*/) {
				my $process = $1;
				if ($process =~ /^$SELF$/) {
					$msg->Log('LOG_NOTICE', "$SELF already running at PID $pid; exiting.\n") unless exists $OPT{cron};
					$msg->closelog();
					exit 0;
				}
			}
		} else {
			$msg->Log('LOG_NOTICE', "Removing stale PID file.\n");
			unlink($pidfile);
		}
	}

	# Daemon parent about to spawn
	if (my $pid = fork) {
		$msg->Log('LOG_NOTICE', "Forking background daemon, process $pid.\n");
		$msg->closelog();
		exit 0;

	# Child daemon process that was spawned
	} else {
		# Fork a second time to get rid of any attached terminals
		if (my $pid = fork) {
			$msg->Log('LOG_NOTICE', "Forking second background daemon, process $pid.\n");
			$msg->closelog();
			exit 0;
		} else {
			unless (defined $pid) {
				$msg->Log('LOG_CRIT', "Cannot fork: $!\n");
				exit 6;
			}
			close(STDOUT); close(STDERR); chdir '/';
			unless (open(FH,">$pidfile")) {
				$msg->Log('LOG_CRIT', "Unable to open file handle FH for file '$pidfile': $!\n");
				exit 7;
			}
			print FH $$;
			close(FH) || $msg->Log('LOG_WARNING', "Unable to close file handle FH for file '$pidfile': $!\n");
		}
	}
}

=pod

=item display_version()

Displays complete version, author and license information.

=back

=cut

# Display version information
sub display_version {
	my $rtn = shift;
	print "$SELF $VERSION\n";
	print "$VERSION\n";
	print "Written by Nicola Worthington, <nicolaw\@cpan.org>.\n\n";
	print "Copyright (C) 2002,2003,2004,2005 Nicola Worthington.\n\n";
	print <<EOL;
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
EOL
        exit($rtn) if defined $rtn;
}




 
=pod

=head1 BUGS

Hopefully none. ;-) Send any bug reports to me at nicolaw@cpan.org
along with any patches and details of how to replicate the problem.
Please only send reports for bugs which can be replicated in the
I<latest> version of the software. The latest version can always be
found at http://search.cpan.org/~nicolaw/

=head1 TODO

The following functionality will be added soon:

=over 4

=item Code cleanup

The code needs to be cleaned up and made more efficient. The bulk of the
code will be moved to a separate module, and psmon as you know it now will
become a much smaller and simpler wrapper script.

=item Apply contributed patches

Users of psmon have sent me various patches for additional functionality.
These will be incorporated in to the next major release of psmon once the
code has been properly abstracted.

=item killperprocessname directive

Will accept a boolean value. If true, only 1 process per process scope
will ever be killed, instead of all process IDs matching kill rules.
This should be used in conjunction with the new killcmd directive. For
example, you may define that a database daemon may never take up more
than 90% CPU time, and it runs many children processes. If it exceeds
90% CPU time, you want to issue ONE restart command in order to stop and
then start all the database processes in one go.

=item time period limited rules

Functionality to limit validity of process scopes to only be checked
between defined time periods. For example, only check that httpd is running
between the hours of 8am and 5pm on Mondays and Tuesdays.

=back

=head1 SEE ALSO

nsmon

=head1 LICENSE

Written by Nicola Worthington, <nicolaw@cpan.org>.
Copyright (C) 2002,2003,2004,2005 Nicola Worthington.

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

=head1 AUTHOR

Nicola Worthington <nicolaw@cpan.org>

http://search.cpan.org/~nicolaw/

http://www.nicolaworthington.com

=cut

1;







package PSMon::Logging;

use strict;
use warnings;

use Carp qw(croak carp confess);
use POSIX ();
use Net::SMTP ();
use Unix::Syslog ();




sub new {
	ref(my $class = shift) && croak 'Class name required';
	croak 'Odd number of elements passed when even number was expected' if @_ % 2;
	my $self = { @_ };
	bless($self,$class);

	# Open default syslog facility with TTY output
	print "Opening default syslog facility\n" if exists $self->{options}->{verbose};
	Unix::Syslog::openlog($self->{SELF},
				Unix::Syslog::LOG_PID | Unix::Syslog::LOG_PERROR,
				$self->logfacility()
			);

	return $self;
}

sub closelog {
	my $self = shift;
	Unix::Syslog::closelog();
}

sub openlog {
	my $self = shift;
	my $facility = $self->logfacility(shift);

	Unix::Syslog::openlog($self->{SELF},
				Unix::Syslog::LOG_PID,
				$facility
			);
}

=pod

=item loglevel()

Accepts a syslog loglevel keyword and returns the associated constant integer.

=cut

sub loglevel {
	my $self = shift;
	local $_ = shift || '';
	return $_ if /^\d+$/;
	{
		no strict 'refs';
		return exists &{"Unix::Syslog::$_"} ? &{"Unix::Syslog::$_"} : Unix::Syslog::LOG_NOTICE;
	}
}

=pod

=item logfacility()

Accepts a syslog facility keyword and returns the associated constant integer.

=cut

sub logfacility {
	my $self = shift;
	local $_ = shift || '';
	return $_ if /^\d+$/;
	{
		no strict 'refs';
		return exists &{"Unix::Syslog::$_"} ? &{"Unix::Syslog::$_"} : Unix::Syslog::LOG_DAEMON;
	}
}

=pod

=item alert()

Logs a message to syslog using Log() and sends a notification email using
sendmail().

=cut

# Report something to user and syslog
sub alert {
	my $self = shift;
	my ($LOG_TYPE,$mailto,$subject,@ary) = @_;

	$subject ||= 'undef alert message';
	$subject .= ' [DRYRUN]' if exists $self->{options}->{dryrun};
	$self->Log($LOG_TYPE, $subject);
	$msg->sendmail(from=>$self->{config}->{notifyemailfrom},to=>$mailto,subject=>$subject,body=>@ary) if $mailto;
}

=pod

=item Log()

Logs messages to DAEMON facility in syslog. Accepts a log
level and message array. Will terminate the process if it is
asked to log a message of a log level 2 or less (LOG_EMERG,
LOG_ALERT, LOG_CRIT).

=cut

sub Log {
	my $self = shift;
	my ($loglevel,@msg) = @_;

	$loglevel = $self->loglevel($loglevel);
	@msg = '' unless @msg;
	unshift @msg,'Process exiting!' if $loglevel <= 2;
	{ # Unix::Syslog gets unhappy for it's sprintf stuff otherwise :)
		(my $syslogmsg = "@msg") =~ s/%/%%/g;
		Unix::Syslog::syslog $loglevel, $syslogmsg;
	}
}

=pod

=item sendmail()

Sends email notifications of syslog messages, called by alert().
Accepts sending email address, recipient email address, short
message subject and an optional detailed message body array.

=cut

# Send an email
sub sendmail {
	my $self = shift;
	my $param = { @_ };

	# TODO - Abstract this out in to the call to sendmail itself, not inside it here
	$param->{to} = $self->{options}->{adminemail} if exists $self->{options}->{adminemail};

	# Define the email body
	my @body = ref($param->{body}) eq 'ARRAY' ? @{$param->{body}} : ($param->{subject});
	$param->{subject} = sprintf("[%s/%s] %s",$self->{SELF},(POSIX::uname())[1],$param->{subject});
	unshift @body, "Subject: $param->{subject}\n";
	unshift @body, "To: \"$param->{to}\" <$param->{to}>";
	unshift @body, "From: \"$param->{from}\" <$param->{from}>";

	# Use sendmail by default with failover to SMTP
	if (exists $self->{config}->{defaultemailmethod} && $self->{config}->{defaultemailmethod} !~ /smtp/i) {
		unless ($self->_sendmail_sendmail($param,@body)) {
			$self->Log('LOG_WARNING', "Unable to send email using sendmail command $self->{config}->{sendmailcmd}; attempting SMTP connection to $self->{config}->{smtphost} instead");
			$self->_sendmail_smtp($param,@body);
		}

	# Otherwise SMTP with failover to sendmail
	} else {
		unless ($self->_sendmail_smtp($param,@body)) {
			$self->Log('LOG_WARNING', "Unable to establish SMTP connection with $self->{config}->{smtphost}; attempting sendmail pipe instead");
			$self->_sendmail_sendmail($param,@body);
		}
	}
}

sub _sendmail_sendmail {
	my ($self,$param,@body) = @_;
	if (open(PH,"|$self->{config}->{sendmailcmd}")) {
		print PH $_ for @body;
		if (close(PH)) {
			return 1;
		} else {
			$self->Log('LOG_WARNING', "Unable to close pipe handle PH for command '|$self->{config}->{sendmailcmd}': $!");
			return 0;
		}
	} else {
		$self->Log('LOG_WARNING', "Unable to open pipe handle PH for command '|$self->{config}->{sendmailcmd}': $!");
		return 0;
	}
}

sub _sendmail_smtp {
	my ($self,$param,@body) = @_;
	my $smtp = Net::SMTP->new(
						$self->{config}->{smtphost},
						Timeout	=> $self->{config}->{smtptimeout},
						Hello	=> (POSIX::uname())[1],
					);
	if ($smtp) { 
		$smtp->mail($param->{from});
		$smtp->to($param->{to});
		$smtp->data(join("\n",@body));
		$smtp->dataend();
		return 1;
	} else {
		$self->Log('LOG_WARNING', "Unable to establish SMTP connection with $self->{config}->{smtphost}");
		return 0;
	}
}

1;


__END__



