You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by pg...@apache.org on 2006/08/23 06:41:16 UTC
svn commit: r433889 - /perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm
Author: pgollucci
Date: Tue Aug 22 21:41:15 2006
New Revision: 433889
URL: http://svn.apache.org/viewvc?rev=433889&view=rev
Log:
keep only the 1.x target specific things
Modified:
perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm
Modified: perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm
URL: http://svn.apache.org/viewvc/perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm?rev=433889&r1=433888&r2=433889&view=diff
==============================================================================
--- perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm (original)
+++ perl/Apache-SizeLimit/trunk/lib/Apache/SizeLimit.pm Tue Aug 22 21:41:15 2006
@@ -20,51 +20,10 @@
use Apache::Constants qw(DECLINED OK);
use Config;
-use vars qw(
- $VERSION
- $REQUEST_COUNT
- $START_TIME
- $USE_SMAPS
-);
+use vars qw($VERSION);
$VERSION = '0.91-dev';
-__PACKAGE__->set_check_interval(1);
-
-$REQUEST_COUNT = 1;
-$USE_SMAPS = 1;
-
-use constant IS_WIN32 => $Config{'osname'} eq 'MSWin32' ? 1 : 0;
-
-
-use vars qw( $MAX_PROCESS_SIZE );
-sub set_max_process_size {
- my $class = shift;
-
- $MAX_PROCESS_SIZE = shift;
-}
-
-use vars qw( $MAX_UNSHARED_SIZE );
-sub set_max_unshared_size {
- my $class = shift;
-
- $MAX_UNSHARED_SIZE = shift;
-}
-
-use vars qw( $MIN_SHARE_SIZE );
-sub set_min_shared_size {
- my $class = shift;
-
- $MIN_SHARE_SIZE = shift;
-}
-
-use vars qw( $CHECK_EVERY_N_REQUESTS );
-sub set_check_interval {
- my $class = shift;
-
- $CHECK_EVERY_N_REQUESTS = shift;
-}
-
sub handler ($$) {
my $class = shift;
my $r = shift || Apache->request;
@@ -97,245 +56,6 @@
sub { $class->_exit_if_too_big(shift) } );
$r->pnotes( size_limit_cleanup => 1 );
}
-
-sub _exit_if_too_big {
- my $class = shift;
- my $r = shift;
-
- return DECLINED
- if ( $CHECK_EVERY_N_REQUESTS
- && ( $REQUEST_COUNT++ % $CHECK_EVERY_N_REQUESTS ) );
-
- $START_TIME ||= time;
-
- if ( $class->_limits_are_exceeded() ) {
- my ( $size, $share, $unshared ) = $class->_check_size();
-
- if ( IS_WIN32 || $class->_platform_getppid() > 1 ) {
- # this is a child httpd
- my $e = time - $START_TIME;
- my $msg = "httpd process too big, exiting at SIZE=$size KB";
- $msg .= " SHARE=$share KB UNSHARED=$unshared" if ($share);
- $msg .= " REQUESTS=$REQUEST_COUNT LIFETIME=$e seconds";
- $class->_error_log($msg);
-
- if (IS_WIN32) {
- # child_terminate() is disabled in win32 Apache
- CORE::exit(-2);
- }
- else {
- $r->child_terminate();
- }
- }
- else {
- # this is the main httpd, whose parent is init?
- my $msg = "main process too big, SIZE=$size KB ";
- $msg .= " SHARE=$share KB" if ($share);
- $class->_error_log($msg);
- }
- }
- return OK;
-}
-
-# REVIEW - Why doesn't this use $r->warn or some other
-# Apache/Apache::Log API?
-sub _error_log {
- my $class = shift;
-
- print STDERR "[", scalar( localtime(time) ),
- "] ($$) Apache::SizeLimit @_\n";
-}
-
-sub _limits_are_exceeded {
- my $class = shift;
-
- my ( $size, $share, $unshared ) = $class->_check_size();
-
- return 1 if $MAX_PROCESS_SIZE && $size > $MAX_PROCESS_SIZE;
-
- return 0 unless $share;
-
- return 1 if $MIN_SHARE_SIZE && $share < $MIN_SHARE_SIZE;
-
- return 1 if $MAX_UNSHARED_SIZE && $unshared > $MAX_UNSHARED_SIZE;
-
- return 0;
-}
-
-sub _check_size {
- my ( $size, $share ) = _platform_check_size();
-
- return ( $size, $share, $size - $share );
-}
-
-sub _load {
- my $mod = shift;
-
- eval "require $mod"
- or die "You must install $mod for Apache::SizeLimit to work on your platform.";
-}
-
-BEGIN {
- if ( $Config{'osname'} eq 'solaris'
- && $Config{'osvers'} >= 2.6 ) {
- *_platform_check_size = \&_solaris_2_6_size_check;
- *_platform_getppid = \&_perl_getppid;
- }
- elsif ( $Config{'osname'} eq 'linux' ) {
- _load('Linux::Pid');
-
- *_platform_getppid = \&_linux_getppid;
-
- if ( eval { require Linux::Smaps } && Linux::Smaps->new($$) ) {
- *_platform_check_size = \&_linux_smaps_size_check;
- }
- else {
- $USE_SMAPS = 0;
- *_platform_check_size = \&_linux_size_check;
- }
- }
- elsif ( $Config{'osname'} =~ /(?:bsd|aix)/i ) {
- # on OSX, getrusage() is returning 0 for proc & shared size.
- _load('BSD::Resource');
-
- *_platform_check_size = \&_bsd_size_check;
- *_platform_getppid = \&_perl_getppid;
- }
- elsif (IS_WIN32) {
- _load('Win32::API');
-
- *_platform_check_size = \&_win32_size_check;
- *_platform_getppid = \&_perl_getppid;
- }
- else {
- die "Apache::SizeLimit is not implemented on your platform.";
- }
-}
-
-sub _linux_smaps_size_check {
- my $class = shift;
-
- return $class->_linux_size_check() unless $USE_SMAPS;
-
- my $s = Linux::Smaps->new($$)->all;
- return ($s->size, $s->shared_clean + $s->shared_dirty);
-}
-
-sub _linux_size_check {
- my $class = shift;
-
- my ( $size, $share ) = ( 0, 0 );
-
- if ( open my $fh, '<', '/proc/self/statm' ) {
- ( $size, $share ) = ( split /\s/, scalar <$fh> )[0,2];
- close $fh;
- }
- else {
- $class->_error_log("Fatal Error: couldn't access /proc/self/status");
- }
-
- # linux on intel x86 has 4KB page size...
- return ( $size * 4, $share * 4 );
-}
-
-sub _solaris_2_6_size_check {
- my $class = shift;
-
- my $size = -s "/proc/self/as"
- or $class->_error_log("Fatal Error: /proc/self/as doesn't exist or is empty");
- $size = int( $size / 1024 );
-
- # return 0 for share, to avoid undef warnings
- return ( $size, 0 );
-}
-
-# rss is in KB but ixrss is in BYTES.
-# This is true on at least FreeBSD, OpenBSD, & NetBSD - Phil Gollucci
-sub _bsd_size_check {
- my @results = BSD::Resource::getrusage();
- my $max_rss = $results[2];
- my $max_ixrss = int ( $results[3] / 1024 );
-
- return ( $max_rss, $max_ixrss );
-}
-
-sub _win32_size_check {
- my $class = shift;
-
- # get handle on current process
- my $get_current_process = Win32::API->new(
- 'kernel32',
- 'get_current_process',
- [],
- 'I'
- );
- my $proc = $get_current_process->Call();
-
- # memory usage is bundled up in ProcessMemoryCounters structure
- # populated by GetProcessMemoryInfo() win32 call
- my $DWORD = 'B32'; # 32 bits
- my $SIZE_T = 'I'; # unsigned integer
-
- # build a buffer structure to populate
- my $pmem_struct = "$DWORD" x 2 . "$SIZE_T" x 8;
- my $mem_counters
- = pack( $pmem_struct, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
-
- # GetProcessMemoryInfo is in "psapi.dll"
- my $get_process_memory_info = new Win32::API(
- 'psapi',
- 'GetProcessMemoryInfo',
- [ 'I', 'P', 'I' ],
- 'I'
- );
-
- my $bool = $get_process_memory_info->Call(
- $proc,
- $mem_counters,
- length $mem_counters,
- );
-
- # unpack ProcessMemoryCounters structure
- my $peak_working_set_size =
- ( unpack( $pmem_struct, $mem_counters ) )[2];
-
- # only care about peak working set size
- my $size = int( $peak_working_set_size / 1024 );
-
- return ( $size, 0 );
-}
-
-sub _perl_getppid { return getppid }
-sub _linux_getppid { return Linux::Pid::getppid() }
-
-{
- # Deprecated APIs
-
- sub setmax {
- my $class = __PACKAGE__;
-
- $class->set_max_process_size(shift);
-
- $class->add_cleanup_handler();
- }
-
- sub setmin {
- my $class = __PACKAGE__;
-
- $class->set_min_shared_size(shift);
-
- $class->add_cleanup_handler();
- }
-
- sub setmax_unshared {
- my $class = __PACKAGE__;
-
- $class->set_max_unshared_size(shift);
-
- $class->add_cleanup_handler();
- }
-}
-
1;