| # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*- |
| # Licensed to the Apache Software Foundation (ASF) under one or more |
| # contributor license agreements. See the NOTICE file distributed with |
| # this work for additional information regarding copyright ownership. |
| # The ASF licenses this file to You 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 Apache2::Resource; |
| |
| use strict; |
| use warnings FATAL => 'all'; |
| |
| use mod_perl2; |
| |
| use Apache2::Module (); |
| |
| use BSD::Resource qw(setrlimit getrlimit get_rlimits); |
| |
| use Apache2::Const -compile => qw(OK); |
| |
| $Apache2::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 "Apache2::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 $@; |
| } |
| |
| Apache2::Const::OK; |
| } |
| |
| sub default_handler { |
| while (my ($k, $v) = each %Apache2::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 ($soft, $hard) = getrlimit($lim->{$res}); |
| (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>Apache2::Resource $Apache2::Resource::VERSION</small>"; |
| |
| return \@retval; |
| } |
| |
| if ($ENV{MOD_PERL}) { |
| if ($ENV{PERL_RLIMIT_DEFAULTS}) { |
| require Apache2::ServerUtil; |
| Apache2::ServerUtil->server->push_handlers( |
| PerlChildInitHandler => \&default_handler); |
| } |
| |
| Apache2::Status->menu_item(rlimit => "Resource Limits", |
| \&status_rlimit) |
| if Apache2::Module::loaded("Apache2::Status"); |
| } |
| |
| # perl Apache2/Resource.pm |
| ++$Debug, default_handler unless caller(); |
| |
| 1; |
| |
| __END__ |
| |