#!/usr/bin/perl
#
# Generate a dotty graph for processes and pipes between them.  Useful
# for figuring out which processes are talking to the debconf backend.

my %pipes;
my %pidinfo;

my $pidshape = "box";
my $pipeshape = "hexagon";
my $linkcolor = "springgreen";

for my $f (</proc/[0-9]*/fd/*>) {
    my ($pid, $fd) = $f =~ m%/proc/(\d+)/fd/(\d+)%;
    my $link = readlink($f);
    if ($link =~ m/^pipe:\[(\d+)\]/) {
        my $pipeid = $1;
        if (exists $pipes{$1}) {
            push(@{$pipes{$1}}, $pid);
        } else {
            $pipes{$1} = [$pid];
        }
        my $info = `cat /proc/$pid/cmdline`;
        chomp $info;
        my @f = split(/\0/, $info);
        $pidinfo{$pid} = join(" ", @f[0..1]);
    }
}

print <<EOF;
digraph packages {
  rankdir=LR;
  concentrate=true;
EOF
my %pids;
for my $pipeid (keys %pipes) {
    print "\"$pipeid\" [shape=$pipeshape];\n";
    for my $pid (@{$pipes{$pipeid}}) {
        my $pidinfo = $pidinfo{$pid};
        unless (exists $pids{$pid}) {
            print "  \"$pidinfo\" [shape=$pidshape];\n";
            $pids{$pid} = 1;
        }
        print "  \"$pidinfo\" -> \"$pipeid\"\[color=$linkcolor\]\n";
        print "  \"$pipeid\" -> \"$pidinfo\"\[color=$linkcolor\]\n";
    }
}
print <<EOF;
}
EOF
