#!/usr/bin/perl -w
# $Id: reniced,v 1.5 2005/04/17 10:36:01 mitch Exp $
#
# reniced - renice running processes based on regular expressions
#
# 2005 (C) by Christian Garbs <mitch@cgarbs.de>
# Licensed under GNU GPL.  See COPYING for details.

use strict;

=head1 NAME

reniced - renice running processes based on regular expressions

=head1 SYNOPSIS

B<reniced>
S<[B<-h>]>
S<[B<-v>]>
S<[I<configfile>]>

=head1 OVERVIEW

reniced takes a list of regular expressions, looks for processes
matching them and renices the processes to given values.

=head1 DESCRIPTION

On start, reniced reads a configuration file.  It consists of nice
values and regular expressions.

It then scans the process table using `ps -A`.  Whenever a process
name from the CMD column matches a regular expression, that process is
reniced to the given value.  If a process matches multiple regular
expressions, only the first one encountered is executed.

When run as root, reniced will scan all processes.  When run as a
user, renice only scans the user's processes.

=head2 Switches

=over 5

=item B<-h>

This prints the version number and a short help text.

=item B<-v>

This activates verbose mode.  Some statistics and all renice actions
are printed to stdout.

=item I<configfile>

This reads the regular expressions from an alternate configfile.

The default location of the configfile is /etc/reniced.conf if reniced
is run as root, ~/.reniced otherwise.

=back

=head2 Configuration file format

The configuration file is composed of single lines.  Empty lines and
lines starting with a B<#> are ignored.

Every line must consist of a decimal value (the nice value) followed
by a whitespace and a Perl regular expression.

=head1 MODULES NEEDED

 use BSD::Resource;

This module can be obtained from L<http://www.cpan.org>.

=head1 BUGS

reniced can run without the BSD::Resource module.  In this case, the
PRIO_PROCESS is set to 0.  This works on Linux 2.6.11 i686 but it
could break on other systems.  Installing BSD::Resource is the safer
way.

Please report bugs to <F<mitch@cgarbs.de>>.

=head1 AUTHOT

reniced was written by Christian Garbs <F<mitch@cgarbs.de>>.

=head1 AVAILABILITY

Look for updates ad L<http://www.cgarbs.de/stuff.en.html>.

=head1 COPYRIGHT

reniced is licensed under the GNU GPL

=cut


### Global settings


# default values for rulefile position
my $rulefile_root = '/etc/reniced.conf';
my $rulefile_user = '~/.reniced';
# default debug value
my $debug = 0;

# are we root?
my $root = $> == 0;
# a dynamically calculated constant :-)
my $PRIO_PROCESS;


### Subroutines


sub show_help()
# print options
{
    print << 'EOF';
Usage:
   reniced [-h] [-v] [configfile]

Options:
     -h           print help
     -v           be verbose
     configfile   read alternative configuration file
                  default: /etc/reniced.conf for root
                           ~/.reniced for others

Configuration file format:
   # is a comment
   numeric_nicelevel perl_regular_expression

Version:
   $Id: reniced,v 1.5 2005/04/17 10:36:01 mitch Exp $
EOF
    ;
}

sub debug(@)
# print debug messages
{
    print "@_\n" if $debug;
}

sub get_prio_process()
# get the numerical value for PRIO_PROCESS
{
    # Check for BSD::Resource which has the constant
    eval { require BSD::Resource; };
    if (not $@) {
	$PRIO_PROCESS = $PRIO_PROCESS;
	debug "PRIO_PROCESS set via BSD::Resource";
    } else {
	# dirty fallback, works for my Linux 2.6.11 i686 GNU/Linux
	# see setpriority(2) and /usr/include/bits/resource.h
	$PRIO_PROCESS = 0;
	debug "PRIO_PROCESS fallback";
    }
}

sub parse_options()
# check if "-v" is given
{
    while (@ARGV) {
	if ($ARGV[0] eq '-v') {
	    shift @ARGV;
	    $debug = 1;
	    next;
	}
	if ($ARGV[0] eq '-h') {
	    shift @ARGV;
	    show_help();
	    exit 0;
	}
	last;
    }
}

sub find_rulefile()
# find rulefile
{
    my $rulefile;

    if ($root) {
	$rulefile = $rulefile_root;
    } else {
	$rulefile = $rulefile_user;
    }
    if ($ARGV[0]) {
	$rulefile = shift @ARGV;
    }
    $rulefile =~ s/^~/$ENV{HOME}/;

    debug "rulefile: $rulefile";
    return $rulefile;
}

sub read_rulefile()
# read rules
{
    my $rulefile = find_rulefile();
    my @rule;

    open RULES, "<$rulefile" or die "can't open `$rulefile': $!";
    while (my $line = <RULES>) {
	chomp $line;
	next if ($line =~ /^\s*$/);
	next if ($line =~ /^#/);
	if ($line =~ /\s*(-?\d+)\s+(.+)/) {
	    push @rule, { REGEXP => $2, NICE => $1 };
	} else {
	    warn "rules line #$. skipped: `$line'\n";
	}
    }
    close RULES or die "can't close `$rulefile': $!";
    
    debug scalar @rule . " rules read";
    return \@rule;
}

sub generate_ps_command()
# generate ps commandline
{
    my $cmdline = 'ps';

    if ($root) {
	$cmdline .= ' -A';
    } else {
	$cmdline .= " --user $>";
    }

    return $cmdline;
}

sub read_processes()
# read processes
{
    my @proc;
    my $cmdline = generate_ps_command();

    open PS, "$cmdline|" or die "can't open `$cmdline': $!";
    {
	my $line = <PS>; # skip first line
	while ($line = <PS>) {
	    chomp $line;
	    my $pid = substr($line, 0, 5 )+ 0;
	    my $cmd = substr($line, 24 );
	    push @proc, { PID => $pid, CMD => $cmd };
	}
    }
    close PS or die "can't close `$cmdline': $!";

    debug scalar @proc . " processes read";
    return \@proc;
}

sub renice_processes($$)
# renice
{
    my $rules = shift;
    my $procs = shift;

    foreach my $proc (@{$procs}) {
	foreach my $rule (@{$rules}) {
	    if ($proc->{CMD} =~ /$rule->{REGEXP}/) {
		debug "renicing to $rule->{NICE}: $proc->{PID}/$proc->{CMD}";
		setpriority $PRIO_PROCESS, $proc->{PID}, $rule->{NICE};
		last;
	    }
	}
    }
}


### Main program


parse_options();
$PRIO_PROCESS=get_prio_process();
my $rules = read_rulefile();
exit unless @{$rules};
my $procs = read_processes();
exit unless @{$procs};
renice_processes($rules, $procs);
exit 0;
