97 lines
2.2 KiB
Perl
97 lines
2.2 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
|
||
|
|
package Apache::DebateSuicide;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use Apache::Constants qw(:common);
|
||
|
|
|
||
|
|
use vars qw($gtop);
|
||
|
|
our %known_parent;
|
||
|
|
our $ppid;
|
||
|
|
|
||
|
|
# oh btw, this is totally linux-specific. gtop didn't work, so so much for portability.
|
||
|
|
sub handler
|
||
|
|
{
|
||
|
|
my $r = shift;
|
||
|
|
return OK if $r->main;
|
||
|
|
return OK unless $LJ::HAVE_GTOP && $LJ::SUICIDE;
|
||
|
|
|
||
|
|
my $meminfo;
|
||
|
|
return OK unless open (MI, "/proc/meminfo");
|
||
|
|
$meminfo = join('', <MI>);
|
||
|
|
close MI;
|
||
|
|
|
||
|
|
my %meminfo;
|
||
|
|
while ($meminfo =~ m/(\w+):\s*(\d+)\skB/g) {
|
||
|
|
$meminfo{$1} = $2;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $memfree = $meminfo{'MemFree'} + $meminfo{'Cached'};
|
||
|
|
return OK unless $memfree;
|
||
|
|
|
||
|
|
my $goodfree = $LJ::SUICIDE_UNDER{$LJ::SERVER_NAME} || $LJ::SUICIDE_UNDER || 150_000;
|
||
|
|
return OK if $memfree > $goodfree;
|
||
|
|
|
||
|
|
unless ($ppid) {
|
||
|
|
my $self = pid_info($$);
|
||
|
|
$ppid = $self->[3];
|
||
|
|
}
|
||
|
|
|
||
|
|
my $pids = child_info($ppid);
|
||
|
|
my @pids = keys %$pids;
|
||
|
|
|
||
|
|
$gtop ||= GTop->new;
|
||
|
|
|
||
|
|
my %stats;
|
||
|
|
my $sum_uniq = 0;
|
||
|
|
foreach my $pid (@pids) {
|
||
|
|
my $pm = $gtop->proc_mem($pid);
|
||
|
|
$stats{$pid} = [ $pm->rss - $pm->share, $pm ];
|
||
|
|
$sum_uniq += $stats{$pid}->[0];
|
||
|
|
}
|
||
|
|
|
||
|
|
@pids = (sort { $stats{$b}->[0] <=> $stats{$a}->[0] } @pids, 0, 0);
|
||
|
|
|
||
|
|
my $my_pid = $$;
|
||
|
|
if (grep { $my_pid == $_ } @pids[0,1]) {
|
||
|
|
my $my_use_k = $stats{$$}[0] >> 10;
|
||
|
|
$r->log_error("Suicide [$$]: system memory free = ${memfree}k; i'm big, using ${my_use_k}k") if $LJ::DEBUG{'suicide'};
|
||
|
|
Apache::LiveJournal::db_logger($r) unless $r->pnotes('did_lj_logging');
|
||
|
|
$r->child_terminate;
|
||
|
|
}
|
||
|
|
|
||
|
|
return OK;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub pid_info {
|
||
|
|
my $pid = shift;
|
||
|
|
|
||
|
|
open (F, "/proc/$pid/stat") or next;
|
||
|
|
$_ = <F>;
|
||
|
|
close(F);
|
||
|
|
my @f = split;
|
||
|
|
return \@f;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub child_info {
|
||
|
|
my $ppid = shift;
|
||
|
|
opendir(D, "/proc") or return undef;
|
||
|
|
my @pids = grep { /^\d+$/ } readdir(D);
|
||
|
|
closedir(D);
|
||
|
|
|
||
|
|
my %ret;
|
||
|
|
foreach my $p (@pids) {
|
||
|
|
next if (defined $known_parent{$p} &&
|
||
|
|
$known_parent{$p} != $ppid);
|
||
|
|
my $ary = pid_info($p);
|
||
|
|
my $this_ppid = $ary->[3];
|
||
|
|
$known_parent{$p} = $this_ppid;
|
||
|
|
next unless $this_ppid == $ppid;
|
||
|
|
$ret{$p} = $ary;
|
||
|
|
}
|
||
|
|
return \%ret;
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|