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


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::SizeLimit;
2              
3 1     1   597 use Mojo::Base 'Mojolicious::Plugin';
  1         2  
  1         11  
4              
5 1     1   230 use Mojo::IOLoop;
  1         12  
  1         11  
6 1     1   27 use Time::HiRes ();
  1         5  
  1         1003  
7              
8             our $VERSION = '0.006';
9              
10             our $LifeTime;
11              
12             my $PKG = __PACKAGE__;
13              
14             if ($^O eq 'solaris') {
15             # do not consider version number, cos it prolly does more harm than help
16             *check_size = \&_solaris_size_check;
17             }
18             elsif ($^O eq 'linux') {
19             *check_size = eval { require Linux::Smaps } && Linux::Smaps->new($$) ?
20             \&_linux_smaps_size_check : \&_linux_size_check;
21             }
22             elsif ($^O eq 'netbsd') {
23             die "$PKG is not implemented on $^O.\n";
24             }
25             elsif ($^O =~ /(?:bsd|aix)/i) {
26             # on OSX, getrusage() is returning 0 for proc & shared size.
27             _load('BSD::Resource');
28             *check_size = \&_bsd_size_check;
29             }
30             elsif ($^O =~ /darwin/i) {
31             _load('BSD::Resource');
32              
33             my ($ver) = (qx(sw_vers -productVersion) || 0) =~ /^10\.(\d+)\.\d+$/;
34              
35             # OSX 10.9+ has no concept of rshrd in top
36             *check_size = $ver >= 9 ? \&_bsd_size_check : \&_darwin_size_check;
37             }
38             else {
39             die "$PKG is not implemented on $^O.\n";
40             }
41              
42              
43             sub register {
44 1     1 1 766 my ($self, $app, $conf) = @_;
45 1         8 my ($total) = check_size($app->log);
46              
47 1 50       31 die "OS ($^O) not supported by $PKG: Can not determine memory usage.\n"
48             unless $total;
49              
50 1         6 $app->log->info(__PACKAGE__ . '::VERSION = ' . $VERSION);
51              
52 1         26 my %conf = %$conf;
53              
54 1 50       7 $conf{report_level} = 'debug' unless exists $conf->{report_level};
55              
56             # ... a sub that is true every $check_interval requests
57 1         6 *_count_requests = _make_count_requests(\%$conf);
58             # ... a sub that is true if memory consumption exceeds conf values
59 1         5 *_limits_are_exceeded = _make_limits_are_exceeded(\%conf);
60              
61 1     1   5757 Mojo::IOLoop->singleton->next_tick(sub { $LifeTime = Time::HiRes::time })
62 1 50       17 if $conf{report_level};
63              
64             $app->hook(after_dispatch => sub {
65 2     2   20626 my $c = shift;
66 2         68 my ($count, $check) = _count_requests();
67 2 100 66     13 $check and _limits_are_exceeded($c->app->log, $count)
68             or return;
69              
70 1         9 $c->res->headers->connection('close');
71 1         48 Mojo::IOLoop->singleton->stop_gracefully;
72 1         151 });
73             }
74              
75             # rss is in KB but ixrss is in BYTES.
76             # This is true on at least FreeBSD & OpenBSD
77             sub _bsd_size_check {
78 0     0   0 my @results = BSD::Resource::getrusage();
79 0         0 my $max_rss = $results[2];
80 0         0 my $max_ixrss = int ( $results[3] / 1024 );
81              
82 0         0 return ($max_rss, $max_ixrss);
83             }
84              
85             sub _darwin_size_check {
86 0     0   0 my ($size) = _bsd_size_check();
87 0         0 my ($shared) = (`top -e -l 1 -stats rshrd -pid $$ -s 0`)[-1];
88 0 0 0     0 $shared =~ s/^(\d+)M.*/$1 * 1024 * 1024/e
  0         0  
89             or
90 0         0 $shared =~ s/^(\d+)K.*/$1 * 1024/e
91             or
92             $shared =~ s/^(\d+)B.*/$1/;
93 1     1   8 no warnings 'numeric';
  1         2  
  1         870  
94 0         0 return ($size, int($shared));
95             }
96              
97             sub _linux_smaps_size_check {
98 3     3   247 my $s = Linux::Smaps->new($$)->all;
99 3         73994 return ($s->size, $s->shared_clean + $s->shared_dirty);
100             }
101              
102             sub _linux_size_check {
103 0     0   0 my ($size, $share) = (0, 0);
104              
105 0 0       0 if (open my $fh, '<', '/proc/self/statm') {
106 0         0 ($size, $share) = (split /\s/, scalar <$fh>)[0,2];
107 0         0 close $fh;
108             }
109             else {
110 0         0 $_[0]->error("Couldn't access /proc/self/statm");
111             }
112              
113             # linux on intel x86 has 4KB page size...
114 0         0 return ($size * 4, $share * 4);
115             }
116              
117             sub _load {
118 0     0   0 my $mod = shift;
119              
120 0 0       0 eval "require $mod"
121             or die "You must install $mod for $PKG to work on your platform.";
122             }
123              
124             sub _make_count_requests {
125 1     1   2 my $conf = shift;
126              
127 0     0   0 return sub { state $count = 0; return (++$count, 1) }
  0         0  
128 1 50 50     6 if ($conf->{check_interval} // 1) == 1;
129              
130 1     2   195 return eval <<"_SUB_";
  2         5  
  2         9  
131             sub {
132             state \$count = 0;
133             return (\$count, ++\$count % $conf->{check_interval} == 0);
134             };
135             _SUB_
136             }
137              
138             sub _make_limits_are_exceeded {
139 1     1   2 my $conf = shift;
140 1         3 my $report = $conf->{report_level};
141 1         3 my ($f, $s);
142              
143 1 50       4 if ($report) {
144 1         3 $f = q{_report($log, $count, $size, $shared, '%s')};
145 1 50   1   188 eval <<"_SUB_";
  1         5  
  1         11  
  1         8  
  1         20  
  1         8  
  1         44  
146             sub _report {
147             my (\$log, \$count, \$size, \$shared, \$s) = \@_;
148             my \$m = "SizeLimit: Exceeding limit \$s KB. PID = \$\$, SIZE = \$size KB";
149             \$m .= ", SHARED = \$shared KB, UNSHARED = " . (\$size - \$shared) . " KB"
150             if \$shared;
151             \$m .= sprintf ", REQUESTS = %u, LIFETIME = %5.3f s",
152             \$count, Time::HiRes::time - \$LifeTime;
153             \$log->$report(\$m);
154             return 1;
155             }
156             _SUB_
157             }
158             else {
159 0         0 $f = '1';
160             }
161              
162 1         8 my $sub = <<'_SUB_';
163             sub {
164             my ($log, $count) = @_;
165             my ($size, $shared) = check_size($log);
166             _SUB_
167              
168 1 50       5 if ($s = $conf->{max_process_size}) {
169 0         0 $sub .= ' return ' . sprintf($f, "max_process_size = $s") .
170             " if \$size > $s;\n";
171             }
172              
173 1         4 $sub .= <<'_SUB_';
174             return 0 unless $shared;
175             _SUB_
176              
177 1 50       5 if ($s = $conf->{min_shared_size}) {
178 0         0 $sub .= ' return ' . sprintf($f, "min_shared_size = $s") .
179             " if \$shared < $s;\n";
180             }
181              
182 1 50       3 if ($s = $conf->{max_unshared_size}) {
183 1         10 $sub .= ' return ' . sprintf($f, "max_unshared_size = $s") .
184             " if \$size - \$shared > $s;\n";
185             }
186              
187 1         3 $sub .= <<'_SUB_';
188             return 0;
189             };
190             _SUB_
191              
192 1 50   1   142 return eval $sub;
  1 50       31  
  1         5  
  1         65  
  1         29  
  0            
193             }
194              
195             sub _solaris_size_check {
196 0 0   0     my $size = -s '/proc/self/as'
197             or $_[0]->error("/proc/self/as doesn't exist or is empty");
198              
199             # Convert size from B to KB. Return 0 for share to avoid undef warnings.
200 0           return (int($size / 1024), 0);
201             }
202              
203             1;
204              
205             __END__