tools/ipcl

   1 #!/usr/bin/perl
   2
   3 #
   4 # Copyright 1995. Michael Veksler.
   5 #
   6
   7 $IPC_RMID=0;
   8 $USER=$ENV{USER};
   9
  10 open(IPCS,"ipcs|");
  11
  12 #
  13 # The following part is OS dependant, it works under linux only.
  14 # To make it work under other OS
  15 # You should fill in @shm, @sem, @msq lists, with the relevent IPC
  16 # keys.
  17
  18 #
  19 # This code was written to be as much as possible generic, but...
  20 # It works for Linux and ALPHA. I had no BSD machine to test it.
  21 # (As I remember, AIX will work also).
  22
  23 while(<IPCS>) {
  24     split;
  25
  26     # try to find out the IPC-ID, assume it is the first number.
  27     foreach (@_) {
  28         $_ ne int($_) && next;  # not a decimal number
  29         $num=$_;
  30         last;
  31     }
  32     if (/mem/i .. /^\s*$/ ) {
  33         index($_,$USER)>=0 || next;
  34         push(@shm,$num);
  35     }
  36     if (/sem/i .. /^\s*$/ ) {
  37         index($_,$USER)>=0 || next;
  38         push(@sem,$num);
  39     }
  40     if (/mes/i .. /^\s*$/ ) {
  41         index($_,$USER)>=0 || next;
  42         push(@msq,$num);
  43     }
  44 }
  45
  46
  47 #
  48 # This is the end of OS dependant code.
  49 #
  50
  51 @shm && print "shmid ", join(":",@shm),"\n";
  52 @sem && print "semid ", join(":",@sem),"\n";
  53 @msq && print "msqid ", join(":",@msq),"\n";
  54 foreach (@shm) {
  55     shmctl($_, $IPC_RMID,0);
  56 }
  57 foreach (@sem) {
  58     semctl($_, 0, $IPC_RMID,0);
  59 }
  60 foreach (@msq) {
  61     msgctl($_, $IPC_RMID,0);
  62 }