Current Path : /usr/local/lib/perl5/site_perl/5.8.9/mach/Apache/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/local/lib/perl5/site_perl/5.8.9/mach/Apache/Resource.pm |
#! /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