view release on metacpan or  search on metacpan

lib/Apache2/SizeLimit.pm  view on Meta::CPAN

# 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::SizeLimit;

use strict;
use warnings;

use Config;

use APR::Pool ();

use Apache2::RequestUtil ();
use Apache2::MPM ();
use Apache2::Const -compile => qw (DECLINED OK);

use ModPerl::Util ();

die "Apache2::SizeLimit at the moment works only with non-threaded MPMs"
    if Apache2::MPM->is_threaded();

use constant IS_WIN32 => $Config{'osname'} eq 'MSWin32' ? 1 : 0;

# 2.x requires 5.6.x+ so 'our' is okay
our $VERSION = '0.98';

use Apache::SizeLimit::Core qw(
                             $MAX_PROCESS_SIZE
                             $MAX_UNSHARED_SIZE
                             $MIN_SHARE_SIZE
                             $CHECK_EVERY_N_REQUESTS
                             $START_TIME
                             $VERSION
                             $REQUEST_COUNT
                            );
our @ISA = qw(Apache::SizeLimit::Core);

__PACKAGE__->set_check_interval(1);

sub handler {
    my $r = shift || Apache2::RequestUtil->request();

    return Apache2::Const::DECLINED unless $r->is_initial_req();

    # we want to operate in a cleanup handler
    if (ModPerl::Util::current_callback() eq 'PerlCleanupHandler') {
        return __PACKAGE__->_exit_if_too_big($r);
    }
    else {
        __PACKAGE__->add_cleanup_handler($r);
    }

    return Apache2::Const::DECLINED;
}

sub add_cleanup_handler {
    my $class = shift;
    my $r = shift || Apache2::RequestUtil->request();

    return unless $r;
    return if $r->pnotes('size_limit_cleanup');

    # This used to use $r->post_connection but there's no good way to
    # test it, since apparently it does not push a handler onto the
    # PerlCleanupHandler phase. That means that there's no way to use
    # $r->get_handlers() to check the results of calling this method.
    # $r->get_handlers() SEGFAULTS at the moment in 2.x
    $r->pool->cleanup_register(sub { $class->_exit_if_too_big(shift) }, $r);

    $r->pnotes(size_limit_cleanup => 1);
}

sub _exit_if_too_big {
    my $class = shift;
    my $r = shift;

    return Apache2::Const::DECLINED
        if ($class->get_check_interval()
             && ($class->get_and_pinc_request_count % $class->get_check_interval()));