File Coverage

blib/lib/Mojolicious/Plugin/SizeLimit.pm

Criterion	Covered	Total	%
statement	59	85	69.4
branch	13	32	40.6
condition	3	8	37.5
subroutine	13	19	68.4
pod	1	1	100.0
total	89	145	61.3

package Mojolicious::Plugin::SizeLimit;

use Mojo::Base 'Mojolicious::Plugin';

use Mojo::IOLoop;
use Time::HiRes ();

our $VERSION = '0.005';

our $LifeTime;

my $PKG = __PACKAGE__;

if ($^O eq 'solaris') {
    # do not consider version number, cos it prolly does more harm than help
    *check_size = \&_solaris_size_check;
}
elsif ($^O eq 'linux') {
    *check_size = eval { require Linux::Smaps } && Linux::Smaps->new($$) ?
        \&_linux_smaps_size_check : \&_linux_size_check;
}
elsif ($^O eq 'netbsd') {
    die "$PKG is not implemented on $^O.\n";
}
elsif ($^O =~ /(?:bsd|aix)/i) {
    # on OSX, getrusage() is returning 0 for proc & shared size.
    _load('BSD::Resource');
    *check_size = \&_bsd_size_check;
}
elsif ($^O =~ /darwin/i) {
    _load('BSD::Resource');

    my ($ver) = (qx(sw_vers -productVersion) || 0) =~ /^10\.(\d+)\.\d+$/;

    # OSX 10.9+ has no concept of rshrd in top
    *check_size = $ver >= 9 ? \&_bsd_size_check : \&_darwin_size_check;
}
else {
    die "$PKG is not implemented on $^O.\n";
}


sub register {
    my ($self, $app, $conf) = @_;
    my ($total) = check_size($app->log);

    die "OS ($^O) not supported by $PKG: Can not determine memory usage.\n"
        unless $total;

    $app->log->info(__PACKAGE__ . '::VERSION = ' . $VERSION);

    my %conf = %$conf;

    $conf{report_level} = 'debug' unless exists $conf->{report_level};

    # ... a sub that is true every $check_interval requests
    *_count_requests = _make_count_requests(\%$conf);
    # ... a sub that is true if memory consumption exceeds conf values
    *_limits_are_exceeded = _make_limits_are_exceeded(\%conf);

    Mojo::IOLoop->singleton->next_tick(sub { $LifeTime = Time::HiRes::time })
        if $conf{report_level};

    $app->hook(after_dispatch => sub {
        my $c = shift;
        my ($count, $check) = _count_requests();
        $check and _limits_are_exceeded($c->app->log, $count)
            or return;

        $c->res->headers->connection('close');
        Mojo::IOLoop->singleton->stop_gracefully;
    });
}

# rss is in KB but ixrss is in BYTES.
# This is true on at least FreeBSD & OpenBSD
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 _darwin_size_check {
    my ($size) = _bsd_size_check();
    my ($shared) = (`top -e -l 1 -stats rshrd -pid $$ -s 0`)[-1];
    $shared =~ s/^(\d+)M.*/$1 * 1024 * 1024/e
        or
    $shared =~ s/^(\d+)K.*/$1 * 1024/e
        or
    $shared =~ s/^(\d+)B.*/$1/;
    no warnings 'numeric';
    return ($size, int($shared));
}

sub _linux_smaps_size_check {
    my $s = Linux::Smaps->new($$)->all;
    return ($s->size, $s->shared_clean + $s->shared_dirty);
}

sub _linux_size_check {
    my ($size, $share) = (0, 0);

    if (open my $fh, '<', '/proc/self/statm') {
        ($size, $share) = (split /\s/, scalar <$fh>)[0,2];
        close $fh;
    }
    else {
        $_[0]->error("Couldn't access /proc/self/statm");
    }

    # linux on intel x86 has 4KB page size...
    return ($size * 4, $share * 4);
}

sub _load {
    my $mod = shift;

    eval "require $mod"
        or die "You must install $mod for $PKG to work on your platform.";
}

sub _make_count_requests {
    my $conf = shift;

    return sub { state $count = 0; return (++$count, 1) }
        if ($conf->{check_interval} // 1) == 1;

    return eval <<"_SUB_";
        sub {
            state \$count = 0;
            return (\$count, ++\$count % $conf->{check_interval} == 0);
        };
_SUB_
}

sub _make_limits_are_exceeded {
    my $conf = shift;
    my $report = $conf->{report_level};
    my ($f, $s);

    if ($report) {
        $f = q{_report($log, $count, $size, $shared, '%s')};
        eval <<"_SUB_";
sub _report {
    my (\$log, \$count, \$size, \$shared, \$s) = \@_;
    my \$m = "SizeLimit: Exceeding limit \$s KB. PID = \$\$, SIZE = \$size KB";
    \$m .= ", SHARED = \$shared KB, UNSHARED = " . (\$size - \$shared) . " KB"
        if \$shared;
    \$m .= sprintf ", REQUESTS = %u, LIFETIME = %5.3f s",
                    \$count, Time::HiRes::time - \$LifeTime;
    \$log->$report(\$m);
    return 1;
}
_SUB_
    }
    else {
        $f = '1';
    }

    my $sub = <<'_SUB_';
sub {
    my ($log, $count) = @_;
    my ($size, $shared) = check_size($log);
_SUB_

    if ($s = $conf->{max_process_size}) {
        $sub .= '    return ' . sprintf($f, "max_process_size = $s") .
                " if \$size > $s;\n";
    }

    $sub .= <<'_SUB_';
    return 0 unless $shared;
_SUB_

    if ($s = $conf->{min_shared_size}) {
        $sub .= '    return ' . sprintf($f, "min_shared_size = $s") .
                " if \$shared < $s;\n";
    }

    if ($s = $conf->{max_unshared_size}) {
        $sub .= '    return ' . sprintf($f, "max_unshared_size = $s") .
                " if \$size - \$shared > $s;\n";
    }

    $sub .= <<'_SUB_';
    return 0;
};
_SUB_

    return eval $sub;
}

sub _solaris_size_check {
    my $size = -s '/proc/self/as'
        or $_[0]->error("/proc/self/as doesn't exist or is empty");

    # Convert size from B to KB. Return 0 for share to avoid undef warnings.
    return (int($size / 1024), 0);
}

1;

__END__