Perl: IPC semaphores to process table listing.

While looking into Apache problems with IPC semaphores, I needed a decent report of what processes were associated with which semaphore ids. This script is the result.

I've only tested this on Linux. It certainly won't work on HP-UX or AIX because of different ipcs output and options.

use warnings;
use strict;

my @out = qx{ ipcs -s };
my @filtered_out = grep { /^0/ } @out;

# Example output of: ipcs -s
#
# ------ Semaphore Arrays --------
# key        semid      owner      perms      nsems
# 0x00000000 393216     root      600        1
# 0x01fe101f 819201     root      600        1

# Grab the 2nd column of ipcs -a output.
my @semids = map {(split(/\s+/, $_))[1]} @filtered_out;

# Key = semaphore id. Value = array of associated PIDs.
my %semid2pids;

# Example output of: ipcs -si 393216
#
# Semaphore Array semid=393216
# uid=0    gid=0   cuid=0  cgid=0
# mode=0600, access_perms=0600
# nsems = 1
# otime = Not set
# ctime = Sat Feb 25 19:12:34 2012
# semnum     value      ncount     zcount     pid
# 0          0          1          0          3869

# Find the list of PIDs associated with each semaphore id.
for my $semid (@semids) {
    my @out = qx{ ipcs -si $semid 2>&1 };

    if (grep { /Identifier removed/ } @out) {
        $semid2pids{$semid} = ['Identifier removed'];
    }
    else {
        # Grab all the lines that contain PIDs.
        my @lines = grep {/\d+(\s+\d+){4}/} @out;
        # Grab just the PIDs from the lines.
        my @pids = map {(split(/\s+/, $_))[4]} @lines;
        $semid2pids{$semid} = \@pids;
    }
}

# List the process table info for each PID associated with each semaphore id.
for my $semid (keys %semid2pids) {
    print "semid: $semid\n";
    for my $pid (@{$semid2pids{$semid}}) {
        my $out;
        if ($pid =~ /Identifier removed/) {
            $out = "Identifier removed.\n";
        }
        else {
            $out = qx{ ps --no-headers -o user,pid,args -p $pid};
        }
        print $out;
    }
}