Commit | Line | Data |
e477c0bb |
1 | package FCGI::ProcManager::Constrained; |
2 | use strict; |
3 | use warnings; |
4 | use Carp qw/ confess /; |
5 | use base 'FCGI::ProcManager'; |
6 | use Config; |
e477c0bb |
7 | |
8 | sub new { |
9 | my $proto = shift; |
10 | my $self = $proto->SUPER::new(@_); |
11 | $self->{max_requests} = $ENV{PM_MAX_REQUESTS} || 0 unless defined $self->{max_requests}; |
12 | $self->{sizecheck_num_requests} = $ENV{PM_SIZECHECK_NUM_REQUESTS} || 0 unless defined $self->{sizecheck_num_requests}; |
13 | $self->{max_size} = $ENV{PM_MAX_SIZE} || 0 unless defined $self->{max_size}; |
14 | if ($self->{sizecheck_num_requests} && ! _can_check_size()) { |
15 | confess "Cannot load size check modules for your platform: sizecheck_num_requests > 0 unsupported"; |
16 | } |
17 | return $self; |
18 | } |
19 | |
20 | sub max_requests { shift->pm_parameter('max_requests', @_); } |
21 | |
22 | sub sizecheck_num_requests { shift->pm_parameter('sizecheck_num_requests', @_); } |
23 | |
24 | sub max_size { shift->pm_parameter('max_size', @_); } |
25 | |
26 | sub handling_init { |
27 | my $self = shift; |
28 | $self->SUPER::handling_init(); |
29 | $self->{_request_counter} = 0; |
30 | } |
31 | |
32 | sub pm_post_dispatch { |
33 | my $self = shift; |
34 | if ($self->max_requests > 0 && ++$self->{_request_counter} == $self->max_requests) { |
4ee37e76 |
35 | $self->pm_exit("safe exit after max_requests (" . $self->{_request_counter} . ")"); |
e477c0bb |
36 | } |
37 | if ($self->sizecheck_num_requests |
38 | and $self->{_request_counter} # Not the first request |
39 | and $self->{_request_counter} % $self->sizecheck_num_requests == 0 |
40 | ) { |
4ee37e76 |
41 | $self->exit("safe exit due to memory limits exceeded after " . $self->{_request_counter} . " requests") |
e477c0bb |
42 | if $self->_limits_are_exceeded; |
43 | } |
44 | $self->SUPER::pm_post_dispatch(); |
45 | } |
46 | |
47 | sub _limits_are_exceeded { |
48 | my $self = shift; |
49 | |
50 | my ($size, $share, $unshared) = $self->_check_size(); |
51 | |
52 | return 1 if $self->max_size && $size > $self->max_size; |
53 | return 0 unless $share; |
54 | # FIXME |
55 | # return 1 if $self->min_share_size && $share < $self->min_share_size; |
56 | # return 1 if $self->max_unshared_size && $unshared > $self->max_unshared_size; |
57 | |
58 | return 0; |
59 | } |
60 | |
61 | # The following code is wholesale is nicked from Apache::SizeLimit::Core |
62 | |
63 | sub _check_size { |
64 | my $class = shift; |
65 | |
66 | my ($size, $share) = $class->_platform_check_size(); |
67 | |
68 | return ($size, $share, $size - $share); |
69 | } |
70 | |
71 | sub _load { |
72 | my $mod = shift; |
73 | eval { require($mod); 1; } |
74 | } |
75 | our $USE_SMAPS; |
76 | BEGIN { |
77 | my ($major,$minor) = split(/\./, $Config{'osvers'}); |
78 | if ($Config{'osname'} eq 'solaris' && |
79 | (($major > 2) || ($major == 2 && $minor >= 6))) { |
80 | *_can_check_size = sub () { 1 }; |
81 | *_platform_check_size = \&_solaris_2_6_size_check; |
82 | *_platform_getppid = \&_perl_getppid; |
83 | } |
84 | elsif ($Config{'osname'} eq 'linux' && _load('Linux::Pid')) { |
85 | *_platform_getppid = \&_linux_getppid; |
86 | *_can_check_size = sub () { 1 }; |
87 | if (_load('Linux::Smaps') && Linux::Smaps->new($$)) { |
88 | $USE_SMAPS = 1; |
89 | *_platform_check_size = \&_linux_smaps_size_check; |
90 | } |
91 | else { |
92 | $USE_SMAPS = 0; |
93 | *_platform_check_size = \&_linux_size_check; |
94 | } |
95 | } |
96 | elsif ($Config{'osname'} =~ /(?:bsd|aix)/i && _load('BSD::Resource')) { |
97 | # on OSX, getrusage() is returning 0 for proc & shared size. |
98 | *_can_check_size = sub () { 1 }; |
99 | *_platform_check_size = \&_bsd_size_check; |
100 | *_platform_getppid = \&_perl_getppid; |
101 | } |
102 | else { |
103 | *_can_check_size = sub () { 0 }; |
104 | } |
105 | } |
106 | |
107 | sub _linux_smaps_size_check { |
108 | my $class = shift; |
109 | |
110 | return $class->_linux_size_check() unless $USE_SMAPS; |
111 | |
112 | my $s = Linux::Smaps->new($$)->all; |
113 | return ($s->size, $s->shared_clean + $s->shared_dirty); |
114 | } |
115 | |
116 | sub _linux_size_check { |
117 | my $class = shift; |
118 | |
119 | my ($size, $share) = (0, 0); |
120 | if (open my $fh, '<', '/proc/self/statm') { |
121 | ($size, $share) = (split /\s/, scalar <$fh>)[0,2]; |
122 | close $fh; |
123 | } |
124 | else { |
125 | $class->_error_log("Fatal Error: couldn't access /proc/self/status"); |
126 | } |
127 | |
128 | # linux on intel x86 has 4KB page size... |
129 | return ($size * 4, $share * 4); |
130 | } |
131 | |
132 | sub _solaris_2_6_size_check { |
133 | my $class = shift; |
134 | |
135 | my $size = -s "/proc/self/as" |
136 | or $class->_error_log("Fatal Error: /proc/self/as doesn't exist or is empty"); |
137 | $size = int($size / 1024); |
138 | |
139 | # return 0 for share, to avoid undef warnings |
140 | return ($size, 0); |
141 | } |
142 | |
143 | # rss is in KB but ixrss is in BYTES. |
144 | # This is true on at least FreeBSD, OpenBSD, & NetBSD |
145 | sub _bsd_size_check { |
146 | |
147 | my @results = BSD::Resource::getrusage(); |
148 | my $max_rss = $results[2]; |
149 | my $max_ixrss = int ( $results[3] / 1024 ); |
150 | |
151 | return ($max_rss, $max_ixrss); |
152 | } |
153 | |
154 | sub _win32_size_check { |
155 | my $class = shift; |
156 | |
157 | # get handle on current process |
158 | my $get_current_process = Win32::API->new( |
159 | 'kernel32', |
160 | 'get_current_process', |
161 | [], |
162 | 'I' |
163 | ); |
164 | my $proc = $get_current_process->Call(); |
165 | |
166 | # memory usage is bundled up in ProcessMemoryCounters structure |
167 | # populated by GetProcessMemoryInfo() win32 call |
168 | my $DWORD = 'B32'; # 32 bits |
169 | my $SIZE_T = 'I'; # unsigned integer |
170 | |
171 | # build a buffer structure to populate |
172 | my $pmem_struct = "$DWORD" x 2 . "$SIZE_T" x 8; |
173 | my $mem_counters |
174 | = pack( $pmem_struct, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ); |
175 | |
176 | # GetProcessMemoryInfo is in "psapi.dll" |
177 | my $get_process_memory_info = new Win32::API( |
178 | 'psapi', |
179 | 'GetProcessMemoryInfo', |
180 | [ 'I', 'P', 'I' ], |
181 | 'I' |
182 | ); |
183 | |
184 | my $bool = $get_process_memory_info->Call( |
185 | $proc, |
186 | $mem_counters, |
187 | length $mem_counters, |
188 | ); |
189 | |
190 | # unpack ProcessMemoryCounters structure |
191 | my $peak_working_set_size = |
192 | (unpack($pmem_struct, $mem_counters))[2]; |
193 | |
194 | # only care about peak working set size |
195 | my $size = int($peak_working_set_size / 1024); |
196 | |
197 | return ($size, 0); |
198 | } |
199 | |
200 | sub _perl_getppid { return getppid } |
201 | sub _linux_getppid { return Linux::Pid::getppid() } |
202 | |
203 | 1; |
204 | |