Re: Determine if a proc spawned under screen's control

#!/local/perl-5.8/bin/perl -w

use strict;
use integer;
use Proc::ProcessTable;
use Mail::Mailer; 

chomp (my $hostname = `hostname`); # set hostname
chomp (my $uname    = `uname`   ); # set uname
chomp (my $uptime   = `uptime`  ); # set uptime

#                                  load average: 0.00, 0.01, 0.12
$uptime                        =~ /load average:\s+(\d+)\.(\d+),\s+(\d+)\.(\d+),\s+(\d+)\.(\d+)$/;

my $load_1                     = ($1 * 100) + $2 +0; # 100 * load last  1 minute 
my $load_5                     = ($3 * 100) + $4 +0; # 100 * load last  5 minutes
my $load_15                    = ($4 * 100) + $5 +0; # 100 * load last 15 minutes

my $ttynum_notty               = 0;  # on solaris -1 on linux 0
my $verschiekonstante          = 0;  # time is on linux in microseconds and on sunos in seconds
my $lsof_binary                = ""; # Where to find my lsof?

if      ($uname eq 'SunOS') {
	$verschiekonstante = 60;
	$ttynum_notty = -1;
	$lsof_binary = '/local/++GENERIC++/.arch.os.sun4.sos5/bin/lsof-5.9';

} elsif ($uname eq 'Linux') {
	$verschiekonstante = 1000 * 60;
	$ttynum_notty =  0;
	$lsof_binary = '/usr/sbin/lsof';

} else {
	die("unsupported operating system: $!");
}

my $time_between_term_and_kill = 2;   # in seconds
my $max_minutes                = 60;  # how many minutes a user process can stay on cpu?
my $max_minutes_trouble_maker  = 5;   # how many cpu minutes can have a trouble maker?
my $max_inetsocks              = 10;  # how many open inet sockets?
my $pctcpu_limit               = 90;  # more than 90 % CPU?
my $cpu_limit                  = 10;  # cpu time limit in minutes
my $troublemaker_cpu           = 29;  # more than 29 % CPU
my $rss_limit                  = 100; # more than Mbytes of RSS RAM ... grep for special rules ...
my @hosts_with_2_cpus          = qw( faui04a faui04b faui04c faui04d faui00 ); # machines with 2 cpus
my @hosts_with_4_cpus          = qw( faui07 faui02 faui06 );  # machines with 4 cpus
my $min_uid                    = 103; # uids under or equal min_uid are ignored
my @allow_users                = qw( sitowert@faui00i sistsigw@faui00h www@faui02 oracle@faui02 sijoange@faui00i sichkell@faui00i simadraf@faui00i sidosche@faui00i ); # allowed users
my @allow_groups               = qw( root icipguru ); # allowed groups
my @allow_daemons              = qw( screen-3.9.11 screen sshd ); # allowed processes without tty eg. daemons
my @process_names_2_kill       = qw( ping eggdrop john seti dnetc sockd mldonkey mldonkey_gui donkey donkey_s ed2k_gui rd jftpgw gtk-gnutella limewire ); # processnames to kill
my @trouble_makers             = qw( netscape kdeinit scm vim xemacs ark kvt ); # troublemaker to kill
my @allowed_games              = qw( /local/et /local/quake /local/rune /usr/games /proj/i9lib/packages/maya-4.5 ); # works only under Linux: Specify the start of the beginning path
my @never_ever_kill            = qw( /usr/sbin/rpc.rusersd );
my @servers                    = qw( faui0cons faui07 faui06 faui05 mephisto faui03 faui01 ); # I do _not_ run on servers
my $from                       = 'Process checker <[email protected]>';
my $cc                         = 'Process checker <[email protected]>';

my $to_sithglan                = ""; # gather listens and connections and report them to sithglan

my @allow_uids                 = resolve_allowed_uids(\@allow_users, \@allow_groups); # turn allowed users and groups into uids

my %lsof_listens               = (); # key=pid values=array with open LISTENS
my %lsof_connections           = (); # key=pid values=array with open network connections
my %killed_uids                = (); # key=uid values=array with killed pids
my %killed_reason              = (); # key=pid value=reason
my %killed_method              = (); # key=pid values=TERM|KILL|FAIL
my %killed_cmndline            = (); # key=pid values=commandline

if (grep("$hostname" eq "$_", @hosts_with_2_cpus)) {
	$pctcpu_limit     /= 2;
	$troublemaker_cpu /= 2;
}

if (grep("$hostname" eq "$_", @hosts_with_4_cpus)) {
	$pctcpu_limit     /= 4;
	$troublemaker_cpu /= 4;
}

if ($hostname =~ /^faui0[05][a-z]$/) {
	$rss_limit *= 5;
}

if ($hostname =~ /^faui0[678][a-z]$/) {
	$rss_limit *= 4;
}

# I don't run on servers
if (grep("$hostname" eq "$_", @servers)) {
	exit;
}

# Gather lsof information
# open(LSOF, "$lsof_binary -u^root,^daemon,^smmsp -i |") || die "Can't start $lsof_binary: $!";

# FIXME LSOF is 64 bit on solaris

#while (0 && <LSOF>) {
#	if ($. == 1) {
#		next;
#	}
#
#	chomp;
#
#	# Match Solaris listens
#	if      (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(TCP|UDP)\s+([^>]*)$/) {
#		$to_sithglan .= "List: <$1> <$2> <$3> <$4> <$5> <$6> <$7> <$8> <$9>\n";
#		push(@{$lsof_connections{$2}}, $9);
#
#	# Match Solaris connections
#	} elsif (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(TCP|UDP)\s+(.*)$/) {
#		$to_sithglan .= "Conn: <$1> <$2> <$3> <$4> <$5> <$6> <$7> <$8> <$9>\n";
#		push(@{$lsof_listens{$2}}, $9);
#
#	# Match Linux listens
#	} elsif (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(TCP|UDP)\s+([^>]*)$/) {
#		$to_sithglan .= "List: <$1> <$2> <$3> <$4> <$5> <$6> <$7> <$8>\n";
#		push(@{$lsof_connections{$2}}, $8);
#
#	# Match Linux connections
#	} elsif (/^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(TCP|UDP)\s+(.*)$/) {
#		$to_sithglan .= "Conn: <$1> <$2> <$3> <$4> <$5> <$6> <$7> <$8>\n";
#		push(@{$lsof_listens{$2}}, $8);
#
#	# can't match ... should not happen
#	} else {
#		$to_sithglan .= "MATC: $_\n";
#	}
#}
# close(LSOF);

# send report if I have to
if (0 && $to_sithglan) {
	my $mailer = Mail::Mailer->new("sendmail");
	$mailer->open({ From => $from, To => 'sithglan@cip', Subject => "CONN: $hostname" });

	print $mailer $to_sithglan;

	$mailer->close();
}

my $tobj = new Proc::ProcessTable;

foreach my $process (@{$tobj->table}) {
	next if (($process->uid() <= $min_uid)
              || ($process->pid() == $$)
              || ($process->state() eq 'defunct')
              || allowed_uid($process->uid())
	);

	if (process_name_2_kill($process->fname())) {
		kill_proc($process, 'prohibited process');
		next;
	}

	# check for too many inet sockets
	#if ($max_inetsocks < get_inetsocks($process->pid())) {
	#	kill_proc($process, "> $max_inetsocks INET sockets");
	#	next;
	#}
	
	# no tty + older than one day
	if (!hangingontty_or_allowed_daemon($process)
	 && olderthan($process, 1) && !not_kill($process)) {
		kill_proc($process, 'background process');
		next;
	}

	# tty + older than seven days
	if (olderthan($process, 7) && !not_kill($process)) {
		kill_proc($process, '> 7 days tty process');
		next;
	}

	if ($process->rss > $rss_limit * 1024 * 1024) {
		kill_proc($process, "> $rss_limit Megabyte RSS RAM");
		next;
	}

	# tm when 5 min CPU && troublemaker_cpu % perm cpu
	if (($process->time() > ($max_minutes_trouble_maker * $verschiekonstante))
	 && troublemaker($process->fname())
	 && toomuchcpu($process->pctcpu, $troublemaker_cpu)
	) {
		kill_proc($process, 'known troublemaker');
		next;
	}

	# only proceed if load higher than one
	next if ($load_5 < 100);

	# pctcpu_limit % cpu + cpu_limit min cputime
	if (toomuchcpu($process->pctcpu, $pctcpu_limit)
	 && ($process->time() > ( $cpu_limit * $verschiekonstante))
	 && !game($process->exec()) && !not_kill($process)
	   ) {
		kill_proc($process, "permanent > $pctcpu_limit % CPU");
		next;
	}

	if ($process->time() > ($max_minutes * $verschiekonstante)
	 && !game($process->exec()) && !not_kill($process)
	   ) {
		kill_proc($process, "> $max_minutes CPU min");
		next;
	}

}

foreach my $uid (keys(%killed_uids)) {

	my $subject ='';
	( my $to, my $gcos) = (getpwuid($uid))[0,6];
	my $name = (split (/,/, $gcos))[0];

	$to = $name . ' <' . $to . '>';

	# plural
	if (1 < @{$killed_uids{$uid}}) {
		$subject = @{ $killed_uids{$uid} } . " removed processes on $hostname";
	} else {
		$subject = "One removed process on $hostname";
	}

	my $mailer = Mail::Mailer->new("sendmail");
	$mailer->open({ From => $from, To => $to, 'X-User' => $to, Cc => $cc, Subject => $subject});
	print $mailer "Dear $name,\n";

	# plural
	if (1 < @{$killed_uids{$uid}}) {
		print $mailer @{ $killed_uids{$uid} } . " processes on $hostname have been removed for the following reasons.\n\n";
	} else {
		print $mailer "one process on $hostname has been removed for the following reason.\n\n";
	}
	
	print $mailer sprintf("%5s %4s %20s | %44s\n", 'PID', 'METH', 'reason', 'command line');
	print $mailer '-' x 80 . "\n";

	foreach my $pid (@{$killed_uids{$uid}}) {
		print $mailer sprintf("%5d %4s %20s | %.44s\n", $pid, $killed_method{$pid}, $killed_reason{$pid}, $killed_cmndline{$pid});
	}

	print $mailer "\n--\n" . '$Id: process_checker,v 1.142 2004/01/07 11:10:30 sithglan Exp $' . "\n";

	$mailer->close();
}

#-[get_listens]----------------------------------------------------------------
# returns the open connections of pid
sub get_inetsocks
{
	my $pid = $_[0];
	
	return (get_connections($pid) + get_listens($pid));
}

#-[get_listens]----------------------------------------------------------------
# returns the number of listens of pid
sub get_listens
{
	my $pid = $_[0];

	if (!defined(@{$lsof_listens{$pid}})) {
		return(0);	
	} else {
		return (@{$lsof_connections{$pid}});
	}
}

#-[get_connections]------------------------------------------------------------
# returns the number of open connections of pid
sub get_connections
{
	my $pid = $_[0];

	if (!defined(@{$lsof_listens{$pid}})) {
		return(0);	

	} else {
		return (@{$lsof_listens{$pid}});
	}
}

#-[olderthan]------------------------------------------------------------------
# This functions checks if the process is older than days
sub olderthan
{
	if ((time() - $_[0]->start) > ($_[1] * 24 * 3600)) {
		return 1;
	} else {
		return 0;
	}
}

#-[hangingontty_or_allowed_daemon]----------------------------------------------
# This function checks if user hangs on a tty or is allowed daemon
sub hangingontty_or_allowed_daemon
{
	if ($_[0]->ttynum != $ttynum_notty) {
		return 1;
	}
	# FIXME tg: Der Mechanismus funktioniert nicht unter Sun
	return grep($_[0]->fname =~ /^$_$/, @allow_daemons); 
}

#-[toomuchcpu]-----------------------------------------------------------------
# This function is needed because pctcpu can come in numeric and alpha context
sub toomuchcpu
{
	my $pctcpu = $_[0];
	my $pctcpu_limit = $_[1];

	# sanity check
	if ($pctcpu eq "nan") {
		$pctcpu = 0;
	}

	if ($pctcpu > $pctcpu_limit) {
		return 1;
	} else {
		return 0;
	}
}

#-[kill_proc]------------------------------------------------------------------
# kills process && saves uid, gid, cmndline and method
sub kill_proc 
{
	( my $process, my $reason ) = @_;

	# append pid to uid
	push(@{$killed_uids{$process->uid()}}, $process->pid());

	# save reason
	$killed_reason{$process->pid()} = $reason;

	# save cmndline or full qualified path
	if ( $process->cmndline() eq '' ) {
		$killed_cmndline{$process->pid()} = $process->exec();
	} else {
		$killed_cmndline{$process->pid()} = $process->cmndline();
	}

	#default
	$killed_method{$process->pid()} = 'FAIL';

	if (kill('TERM', $process->pid())) { 
		$killed_method{$process->pid()} = 'TERM';
	}

	sleep $time_between_term_and_kill;

	if (kill('KILL',$process->pid())) {
		$killed_method{$process->pid()} = 'KILL';
	}
}
#-[game]---------------------------------------------------------------------
# works only under Linux. Looks if executable starts with allowed path
sub game 
{
	return grep($_[0] =~ /^$_/i, @allowed_games);
}

#-[not_kill]------------------------------------------------------------------
sub not_kill
{
	if ( $uname ne 'Linux' ) {
		return 0;
	} else {
		return grep($_[0]->exec() =~ /^$_/i, @never_ever_kill);
	}
}

#-[troublemaker]--------------------------------------------------------------
# same like process_name_2_kill but for troublemaker
sub troublemaker
{
	return grep($_[0] =~ /^$_$/i, @trouble_makers);
}

#-[process_name_2_kill]-------------------------------------------------------
# if argv[0] eq @process_names_2_kill 1 is returned else 0
sub process_name_2_kill
{
	return grep($_[0] =~ /^$_$/i, @process_names_2_kill);
}

#-[allowed_uid]----------------------------------------------------------------
# if uid2check contained in @allow_uids 1 is return else 0
sub allowed_uid
{ 
	return grep($_[0] == $_,@allow_uids);
}

#-[resolve_allowed_uids]-------------------------------------------------------
# resolves members of allow_groups and allow_users and returnes there userids
sub resolve_allowed_uids
{
	my ( $my_users, $my_groups ) = @_;

	my @return_array = ();

	# Add members of allow_groups to allow_user
	foreach my $group (@$my_groups) {
		(my $name, my $passwd, my $gid, my $members) = getgrnam($group);
		push(@$my_users, split (/\s/,$members));
	}

	# Resolve usernames into uids allow_user -> allow_uid;
	foreach my $user (@$my_users){
		if ($user=~ m/\@/ ) {
			if ((split(/\@/,$user,2))[1] eq $hostname) {
				push (@return_array,
					(getpwnam((split(/\@/,$user,2))[0]))[2]);
			}

		} else {
			push (@return_array, (getpwnam($user))[2]);
		}
	}

	return @return_array;
}