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 st...@apache.org on 2004/12/02 01:04:08 UTC
svn commit: r109401 - /perl/modperl/trunk/lib/Apache/Resource.pm /perl/modperl/trunk/t/conf/modperl_extra.pl /perl/modperl/trunk/t/modules/apache_resource.t /perl/modperl/trunk/todo/release
Author: stas
Date: Wed Dec 1 16:04:07 2004
New Revision: 109401
URL: http://svn.apache.org/viewcvs?view=rev&rev=109401
Log:
port Apache::Resource
Added:
perl/modperl/trunk/lib/Apache/Resource.pm
perl/modperl/trunk/t/modules/apache_resource.t
Modified:
perl/modperl/trunk/t/conf/modperl_extra.pl
perl/modperl/trunk/todo/release
Added: perl/modperl/trunk/lib/Apache/Resource.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/lib/Apache/Resource.pm?view=auto&rev=109401
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/lib/Apache/Resource.pm Wed Dec 1 16:04:07 2004
@@ -0,0 +1,149 @@
+# Copyright 2003-2004 The Apache Software Foundation
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+
+package Apache::Resource;
+
+use strict;
+use warnings FATAL => 'all';
+
+use mod_perl 1.99;
+
+use Apache::Module ();
+
+use BSD::Resource qw(setrlimit getrlimit get_rlimits);
+
+use Apache::Const -compile => qw(OK);
+
+$Apache::Resource::VERSION = '1.72';
+
+our $Debug;
+
+$Debug ||= 0;
+
+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 $@;
+ }
+
+ Apache::OK;
+}
+
+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>\n";
+ }
+
+ 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->server->push_handlers(
+ PerlChildInitHandler => \&default_handler);
+ }
+
+ Apache::Status->menu_item(rlimit => "Resource Limits",
+ \&status_rlimit)
+ if Apache::Module::loaded("Apache::Status");
+}
+
+# perl Apache/Resource.pm
+++$Debug, default_handler unless caller();
+
+1;
+
+__END__
+
Modified: perl/modperl/trunk/t/conf/modperl_extra.pl
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/conf/modperl_extra.pl?view=diff&rev=109401&p1=perl/modperl/trunk/t/conf/modperl_extra.pl&r1=109400&p2=perl/modperl/trunk/t/conf/modperl_extra.pl&r2=109401
==============================================================================
--- perl/modperl/trunk/t/conf/modperl_extra.pl (original)
+++ perl/modperl/trunk/t/conf/modperl_extra.pl Wed Dec 1 16:04:07 2004
@@ -47,6 +47,8 @@
test_apache_status();
+test_apache_resource();
+
test_perl_ithreads();
@@ -163,6 +165,23 @@
}
) if Apache::Module::loaded('Apache::Status');
}
+
+sub test_apache_resource {
+ ### Apache::Resource tests
+
+ # load first for the menu
+ require Apache::Status;
+
+ # uncomment for local tests
+ #$ENV{PERL_RLIMIT_DEFAULTS} = 1;
+ #$Apache::Resource::Debug = 1;
+
+ # requires optional BSD::Resource
+ return unless eval { require BSD::Resource };
+
+ require Apache::Resource;
+}
+
sub test_perl_ithreads {
# this is needed for TestPerl::ithreads
Added: perl/modperl/trunk/t/modules/apache_resource.t
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/modules/apache_resource.t?view=auto&rev=109401
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/modules/apache_resource.t Wed Dec 1 16:04:07 2004
@@ -0,0 +1,25 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+plan tests => 1, need qw[BSD::Resource],
+ { "CGI.pm (2.93 or higher) or Apache::Request is needed" =>
+ !!(eval { require CGI && $CGI::VERSION >= 2.93 } ||
+ eval { require Apache::Request })};
+
+{
+ # Apache::Status menu inserted by Apache::Resource
+ my $url = '/status/perl?rlimit';
+ my $body = GET_BODY_ASSERT $url;
+ ok $body =~ /RLIMIT_CPU/;
+}
+
+# more tests would be nice, but I'm not sure how to write those w/o
+# causing problems to the rest of the test suite.
+# we could enable $ENV{PERL_RLIMIT_DEFAULTS} = 1; before loading
+# Apache::Resource, which sets certain default values (works for me)
+# but it's not guaranteed that it'll work for others (since it's very
+# OS specific)
Modified: perl/modperl/trunk/todo/release
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/todo/release?view=diff&rev=109401&p1=perl/modperl/trunk/todo/release&r1=109400&p2=perl/modperl/trunk/todo/release&r2=109401
==============================================================================
--- perl/modperl/trunk/todo/release (original)
+++ perl/modperl/trunk/todo/release Wed Dec 1 16:04:07 2004
@@ -58,8 +58,6 @@
=> Ideally the tools should work transparently with threaded and
non-threaded mpms, but how?
-* Apache::Resource
-
* It'd be nice to have PAUSE and the clients support packages with
several versions, like mod_perl 1.0 and mod_perl 2.0, since once we
release it any dependency on mod_perl will be resolved as mod_perl