#!/usr/bin/perl

# kill-defunctd.pl -- A daemon to monitor defunct processes, log and
# then mercilessly kill them.
#
# Copyright 2005 Joshua Pollack.
#

use strict;
use Sys::Syslog;
use Data::Dumper;
$Data::Dumper::Indent = 0;

# This whole thing is in a nice while loop, we do logging to syslog,
# configurable through /etc/kill-defunctd.conf, should it exist.

my $p = {
    "for_real"          => 1,
    "syslog_facility"   => "local1",
    "refresh"           => 60, # in seconds
};

for my $conf ("/etc/kill-defunctd.conf") {
    $p = do $conf if (-r $conf);
    die "Can't parse $conf: $@" if ($@);
}

# First, setup logging
openlog ($0, "pid", $p->{"syslog_facility"}) or die "openlog failed: $!";

# Get an initial pidtable
my $ipidtable = getpids ();

# Our strategy is this: Get a list of all processes into $npidtable.
# Comparing $npidtable to $ipidtable, kill the parent of those that
# exist in both, and that are defunct.  Make a record of this, then
# replace $ipidtable with $npidtable.

while (sleep ($p->{"refresh"})) {
    
  my $npidtable = getpids ();

  foreach my $pid (keys (%{$npidtable})) {

      if ((exists ($ipidtable->{$pid}))
	  and ($ipidtable->{$pid}->{"stat"}->{"state"} eq "Z")
	  and ($npidtable->{$pid}->{"stat"}->{"state"} eq "Z")) {
	  
	  my $ppid = $npidtable->{$pid}->{"stat"}->{"ppid"};

	  syslog ("notice", "Killing zombied process ${pid}\'s parent $ppid.");
#	  syslog ("info", "$pid stats: %s", Dumper ($npidtable->{$pid}));
#	  Syslog ("info", "$ppid stats: %s", Dumper ($npidtable->{$ppid}));
	  
	  kill 9, $ppid if ($p->{"for_real"});
	  
      }

  }

  $ipidtable = $npidtable;

}
    
sub getpids {

    # Rah!  This is actually the bulk of the work.  Since this is for
    # fun, lets do it in Pure Perl.

    # First, get all the pids.  Yay proc!
    opendir (PROC, "/proc") or die "Cannot open /proc filesystem: $!";
    my @pidnums = grep { /^\d+$/ } readdir (PROC);
    closedir (PROC);

    # Next, iterating through each pid, populate our return structure.
    my $ret = {};
    foreach my $pid (@pidnums) {
	my @tstat = split (/\s+/, slurp ("/proc/$pid/stat"));
	$ret->{$pid} = {
	    %{getlinks ("/proc/$pid")},
	    "cmdline" => [ split (/\000/, slurp ("/proc/$pid/cmdline")) ],
	    "environ" => { map { s/^([^=]+)=/$1\000/; split /\000/ }
			   split (/\000/, slurp ("/proc/$pid/environ")) },
	    "fd"      => getlinks ("/proc/$pid/fd"),
	    "maps"    => [ split (/\n/, slurp ("/proc/$pid/maps")) ],
	    "stat"    => {},
	    "statm"   => {}
	};
	@{$ret->{$pid}->{"stat"}}{"pid", "comm", "state", "ppid", "pgrp",
				  "session", "tty_nr", "tpgid", "flags",
				  "minflt", "cminflt", "majflt", "cmagflt",
				  "utime", "stime", "cutime", "cstime",
				  "priority", "nice", "0", "itrealvalue",
				  "starttime", "vsize", "rss", "rlim", 
				  "startcode", "endcode", "startstack",
				  "kstkeep", "kstkeip", "signal", "blocked",
				  "sigignore", "sigcatch", "wchan", "nswap",
				  "cnswap", "exit_signal", "processor"} =
				      split (' ', slurp ("/proc/$pid/stat"));
	@{$ret->{$pid}->{"statm"}}{"size", "resident", "share", "trs",
				   "drs", "lrs", "dt"} =
				       split (' ', slurp ("/proc/$pid/statm"));
    }

    return $ret;

}


# Always thought this ought to exist, although I can see how it's a
# bit dangerous.  This will slurp up the whole file and return it.
sub slurp {

    my $fname = shift;

    local $/;
    open (F, $fname) or die "Cannot open $fname: $!";
    my $ret = <F>;
    close (F) or die "Cannot close $fname: $!";

    return $ret;
    
}

# Oh yeah code reuse.  This opens a directory, assumed to be populated
# with symlinks, and returns a hashref of their destinations.
sub getlinks {	

    my $dirname = shift;
    my $ret = {};

    opendir (DIR, $dirname) or return ($ret);
    my @entries = readdir (DIR);
    closedir (DIR);

    foreach my $ent (@entries) {
	my $dest = readlink ("$dirname/$ent");
	$ret->{$ent} = $dest if ($dest);
    }
    
    return $ret;

}