#!/usr/bin/env perl

# run as www-data (same as /run/hilis4/*.pid owner)
# perl script/kidreaper.pl <service> <MB>
# adapted from http://www.catalystframework.org/calendar/2007/18:
#   * changed kB to MB
#   * used IPC::System::Simple to capture ppid from service-name

# can be run as JUST_TESTING by omitting max_mem (ARGV[1])

#==============================================================================
my $JUST_TESTING = 0; # reports to command-line, doesn't kill processes
#==============================================================================

use lib '/home/raj/perl5/lib/perl5';
use IPC::System::Simple qw(capture);
use DateTime::Format::Strptime;
use Data::Printer;
use Modern::Perl;

my $service_names = $ARGV[0] or
    die "Usage: $0 <comma_delimited_service_names> [<ram_limit_in_MB>]\n";
my $max_mb = $ARGV[1]; # optional - if empty, switches to JUST_TESTING and sets default 1000

#==============================================================================
$JUST_TESTING = 1 if ! $max_mb; # warn $JUST_TESTING;
#==============================================================================

$max_mb ||= 1000; # warn $max_mb; warn $service_names;

my @services = split ',', $service_names; # p @services;

my $formatter = DateTime::Format::Strptime->new(pattern => '%F %T');

for my $service (@services) {
    my $ppid = capture("cat /run/hilis4/$service.pid") or die $!; # warn $ppid; exit;
    my $cmd  = sprintf '/bin/ps -o pid=,vsz= --ppid %s|', $ppid;

    if ( open (my $kids, $cmd) ) {
        my @goners = ();

        while (<$kids>) {
            chomp;
            my ($pid, $mem) = split; # p $mem;

            # ps shows KB.  we want MBytes.
            $mem /= 1024;

            if ($mem >= $max_mb) {
                push @goners, { name => $service, pid => $pid, mem => $mem };
                if ($JUST_TESTING) {
                    say sprintf "process %s mem [%s MB] > permitted [%s MB]",
                        $pid, $mem, $max_mb;
                }
            }
        }

        close($kids);

        if (@goners and not $JUST_TESTING) {
            # kill them slowly, so that they don't all suddenly die at once:
            foreach my $victim (@goners) { # p $victim;
                kill 'HUP', $victim->{pid}; # send Signal HangUp
                _log($victim);
                sleep 10;
            }
        }
    }
    else {
        my $time = _get_time();
        say "$time | can't get process list for $service [$ppid]: $!";
    }
}

sub _log { # kidreaper.log:
    my $data = shift;

    say sprintf '%s | %s process %s mem %sMB > permitted %sMB',
        _get_time(), uc $data->{name}, $data->{pid}, int $data->{mem}, $max_mb;
}

sub _get_time {
    my $time = DateTime->now;
    $time->set_formatter($formatter); # warn $time;
    return $time;
}