stas 2003/05/29 22:24:52
Modified: lib/Apache SizeLimit.pm
. Changes
Log:
Add Win32 support to Apache::SizeLimit
Submitted by: Perrin Harkins <[EMAIL PROTECTED]>
Revision Changes Path
1.11 +71 -3 modperl/lib/Apache/SizeLimit.pm
Index: SizeLimit.pm
===================================================================
RCS file: /home/cvs/modperl/lib/Apache/SizeLimit.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- SizeLimit.pm 30 May 2003 05:23:34 -0000 1.10
+++ SizeLimit.pm 30 May 2003 05:24:51 -0000 1.11
@@ -125,6 +125,11 @@
Uses BSD::Resource::getrusage() to determine process size. Not sure if the
shared memory calculations will work or not. AIX users?
+=item Win32
+
+Uses Win32::API to access process memory information. Win32::API can be
+installed under ActiveState perl using the supplied ppm utility.
+
=back
If your platform is not supported, and if you can tell me how to check for
@@ -146,7 +151,7 @@
use strict;
use vars qw($VERSION $HOW_BIG_IS_IT $MAX_PROCESS_SIZE
$REQUEST_COUNT $CHECK_EVERY_N_REQUESTS
- $MIN_SHARE_SIZE $MAX_UNSHARED_SIZE $START_TIME);
+ $MIN_SHARE_SIZE $MAX_UNSHARED_SIZE $START_TIME $WIN32);
$VERSION = '0.03';
$CHECK_EVERY_N_REQUESTS = 1;
@@ -154,6 +159,7 @@
$MAX_PROCESS_SIZE = 0;
$MIN_SHARE_SIZE = 0;
$MAX_UNSHARED_SIZE = 0;
+$WIN32 = 0;
BEGIN {
@@ -170,6 +176,13 @@
} else {
die "you must install BSD::Resource for Apache::SizeLimit to work on your
platform.";
}
+ } elsif ($Config{'osname'} eq 'MSWin32') {
+ $WIN32 = 1;
+ if (eval("require Win32::API")) {
+ $HOW_BIG_IS_IT = \&win32_size_check;
+ } else {
+ die "you must install Win32::API for Apache::SizeLimit to work on your
platform.";
+ }
} else {
die "Apache::SizeLimit not implemented on your platform.";
}
@@ -200,6 +213,53 @@
return (&BSD::Resource::getrusage())[2,3];
}
+sub win32_size_check {
+ # get handle on current process
+ my $GetCurrentProcess = new Win32::API('kernel32',
+ 'GetCurrentProcess',
+ [],
+ 'I');
+ my $hProcess = $GetCurrentProcess->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 $pProcessMemoryCounters = pack($pmem_struct, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+
+ # GetProcessMemoryInfo is in "psapi.dll"
+ my $GetProcessMemoryInfo = new Win32::API('psapi',
+ 'GetProcessMemoryInfo',
+ ['I', 'P', 'I'],
+ 'I');
+
+ my $bool = $GetProcessMemoryInfo->Call($hProcess,
+ $pProcessMemoryCounters,
+ length($pProcessMemoryCounters));
+
+ # unpack ProcessMemoryCounters structure
+ my ($cb,
+ $PageFaultCount,
+ $PeakWorkingSetSize,
+ $WorkingSetSize,
+ $QuotaPeakPagedPoolUsage,
+ $QuotaPagedPoolUsage,
+ $QuotaPeakNonPagedPoolUsage,
+ $QuotaNonPagedPoolUsage,
+ $PagefileUsage,
+ $PeakPagefileUsage) = unpack($pmem_struct, $pProcessMemoryCounters);
+
+ # only care about peak working set size
+ my $size = int($PeakWorkingSetSize / 1024);
+
+ return ($size, 0);
+}
+
+
sub exit_if_too_big {
my $r = shift;
return DECLINED if ($CHECK_EVERY_N_REQUESTS &&
@@ -216,13 +276,18 @@
($MAX_UNSHARED_SIZE && ($size - $share) > $MAX_UNSHARED_SIZE)) {
# wake up! time to die.
- if (getppid > 1) { # this is a child httpd
+ if ($WIN32 || (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 " if ($share);
$msg .= " REQUESTS=$REQUEST_COUNT LIFETIME=$e seconds";
error_log($msg);
- $r->child_terminate;
+
+ if ($WIN32) {
+ CORE::exit(-2); # child_terminate() is disabled in win32 Apache
+ } else {
+ $r->child_terminate();
+ }
} else { # this is the main httpd, whose parent is init?
my $msg = "main process too big, SIZE=$size KB ";
@@ -277,5 +342,8 @@
Doug Steinwand and Perrin Harkins <[EMAIL PROTECTED]>: added support
for shared memory and additional diagnostic info
+
+Matt Phillips <[EMAIL PROTECTED]> and Mohamed Hendawi
+<[EMAIL PROTECTED]>: Win32 support
=cut
1.669 +3 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.668
retrieving revision 1.669
diff -u -r1.668 -r1.669
--- Changes 30 May 2003 05:23:34 -0000 1.668
+++ Changes 30 May 2003 05:24:51 -0000 1.669
@@ -10,6 +10,9 @@
=item 1.27_01-dev
+Add Win32 support to Apache::SizeLimit [Matt Phillips
+<[EMAIL PROTECTED]> and Mohamed Hendawi <[EMAIL PROTECTED]>]
+
Change Apache::SizeLimit to not push a cleanup handler if already in
the cleanup handler phase, and adjust docs to show that cleanup
handler is the preferred phase to use [Perrin Harkins
