#!/usr/bin/perl # # Copyright 1995. Michael Veksler. # $IPC_RMID=0; $USER=$ENV{USER}; open(IPCS,"ipcs|"); # # The following part is OS dependant, it works under linux only. # To make it work under other OS # You should fill in @shm, @sem, @msq lists, with the relevent IPC # keys. # # This code was written to be as much as possible generic, but... # It works for Linux and ALPHA. I had no BSD machine to test it. # (As I remember, AIX will work also). while() { split; # try to find out the IPC-ID, assume it is the first number. foreach (@_) { $_ ne int($_) && next; # not a decimal number $num=$_; last; } if (/mem/i .. /^\s*$/ ) { index($_,$USER)>=0 || next; push(@shm,$num); } if (/sem/i .. /^\s*$/ ) { index($_,$USER)>=0 || next; push(@sem,$num); } if (/mes/i .. /^\s*$/ ) { index($_,$USER)>=0 || next; push(@msq,$num); } } # # This is the end of OS dependant code. # @shm && print "shmid ", join(":",@shm),"\n"; @sem && print "semid ", join(":",@sem),"\n"; @msq && print "msqid ", join(":",@msq),"\n"; foreach (@shm) { shmctl($_, $IPC_RMID,0); } foreach (@sem) { semctl($_, 0, $IPC_RMID,0); } foreach (@msq) { msgctl($_, $IPC_RMID,0); }