#! /usr/local/bin/perl
package Apache::Resource;

use strict;
use vars qw($Debug);
use BSD::Resource qw(setrlimit getrlimit get_rlimits);

$Debug ||= 0;
$Apache::Resource::VERSION = '1.71';

sub MB ($) { 
    my $num = shift;
    return ($num < (1024 * 1024)) ?  $num*1024*1024 : $num;
}

sub BM ($) { 
    my $num = shift;
    return ($num > (1024 * 1024)) ?  '(' . ($num>>20) . 'Mb)' : '';
}

sub DEFAULT_RLIMIT_DATA  () { 64 } #data (memory) size in MB
sub DEFAULT_RLIMIT_AS    () { 64 } #address space (memory) size in MB
sub DEFAULT_RLIMIT_CPU   () { 60*6 } #cpu time in seconds
sub DEFAULT_RLIMIT_CORE  () { 0  } #core file size (MB)
sub DEFAULT_RLIMIT_RSS   () { 16 } #resident set size (MB)
sub DEFAULT_RLIMIT_FSIZE () { 10 } #file size  (MB)
sub DEFAULT_RLIMIT_STACK () { 20 } #stack size (MB)

my %is_mb = map {$_,1} qw{DATA RSS STACK FSIZE CORE MEMLOCK AS};

sub debug { print STDERR @_ if $Debug }

sub install_rlimit ($$$) {
    my($res, $soft, $hard) = @_;

    my $name = $res;

    my $cv = \&{"BSD::Resource::RLIMIT_${res}"};
    eval { $res = $cv->() };
    return if $@;

    unless ($soft) { 
	my $defval = \&{"DEFAULT_RLIMIT_${name}"};
	if(defined &$defval) {
	    $soft = $defval->();
	}
	else {
	    warn "can't find default for `$defval'\n";
	}
    }

    $hard ||= $soft;

    debug "Apache::Resource: PID $$ attempting to set `$name'=$soft:$hard ...";

    ($soft, $hard) = (MB $soft, MB $hard) if $is_mb{$name};

    return setrlimit $res, $soft, $hard;
}

sub handler {
    while(my($k,$v) = each %ENV) {
	next unless $k =~ /^PERL_RLIMIT_(\w+)$/;
	$k = $1;
	next if $k eq "DEFAULTS";
	my($soft, $hard) = split ":", $v, 2; 
	$hard ||= $soft;

	my $set = install_rlimit $k, $soft, $hard;
	debug "not " unless $set;
	debug "ok\n";
	debug $@ if $@;
    }

    0;
}

sub default_handler {
    while(my($k,$v) = each %Apache::Resource::) {
	next unless $k =~ s/^DEFAULT_/PERL_/;
	$ENV{$k} = "";
    }
    handler();
}

sub status_rlimit {
    my $lim = get_rlimits();
    my @retval = ("<table border=1><tr>", 
		  (map "<th>$_</th>", qw(Resource Soft Hard)),
		  "</tr>");

    for my $res (keys %$lim) {
	my $val = eval "&BSD::Resource::${res}()";
	my ($soft,$hard) = getrlimit $val;
	(my $limit = $res) =~ s/^RLIMIT_//;
	($soft, $hard) = ("$soft " . BM($soft),"$hard ". BM($hard))
	  if $is_mb{$limit};
	push @retval, 
	"<tr>",
	(map { "<td>$_</td>" } $res, $soft, $hard),
	"</tr>";
    }

    push @retval, "</table><P>";
    push @retval, "<SMALL>Apache::Resource $Apache::Resource::VERSION</SMALL>";

    return \@retval;
}

if($ENV{MOD_PERL}) {
    if($ENV{PERL_RLIMIT_DEFAULTS}) {
	Apache->push_handlers(PerlChildInitHandler => \&default_handler);
    }

    Apache::Status->menu_item(rlimit => "Resource Limits", 
			    \&status_rlimit)
      if Apache->module("Apache::Status");
}

#perl Apache/Resource.pm
++$Debug, default_handler unless caller();

1;

__END__

=head1 NAME

Apache::Resource - Limit resources used by httpd children

=head1 SYNOPSIS

 PerlModule Apache::Resource
 #set child memory limit in megabytes
 #default is 64 Meg
 PerlSetEnv PERL_RLIMIT_DATA 32:48

 #linux does not honor RLIMIT_DATA
 #RLIMIT_AS (address space) will work to limit the size of a process
 PerlSetEnv PERL_RLIMIT_AS 32:48

 #set child cpu limit in seconds
 #default is 360 seconds
 PerlSetEnv PERL_RLIMIT_CPU 120

 PerlChildInitHandler Apache::Resource

=head1 DESCRIPTION

B<Apache::Resource> uses the B<BSD::Resource> module, which 
uses the C function C<setrlimit> to set limits on
system resources such as memory and cpu usage.

Any B<RLIMIT> operation available to limit on your system can be set
by defining that operation as an environment variable with a C<PERL_>
prefix.  See your system C<setrlimit> manpage for available resources
which can be limited.

The following limit values are in megabytes: C<DATA>, C<RSS>, C<STACK>,
C<FSIZE>, C<CORE>, C<MEMLOCK>; all others are treated as their natural unit.

If the value of the variable is of the form C<S:H>, C<S> is treated as
the soft limit, and C<H> is the hard limit.  If it is just a single
number, it is used for both soft and hard limits.

=head1 DEFAULTS

To set reasonable defaults for all RLIMITs, add this to your httpd.conf:

 PerlSetEnv PERL_RLIMIT_DEFAULTS On
 PerlModule Apache::Resource

=head1 AUTHOR

Doug MacEachern

=head1 SEE ALSO

BSD::Resource(3), setrlimit(2)

=cut