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 do open_pipe(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 }
  63
  64 exit(0);
  65
  66
  67
  68
  69
  70 sub open_pipe {
  71     local($pid);
  72     local($handle,@params)=@_;
  73     pipe($handle,WRITE) || die "can't pipe";
  74
  75     $pid=fork();
  76
  77     die "can't fork" if ($pid<0);
  78     if ($pid>0) {
  79         # whe are in the parent
  80         close(WRITE);
  81         waitpid($pid,0) || print "$params[0] exits status=$? ",$? >> 8, "\n";
  82     } else {
  83         # we are in the son.
  84         open(STDOUT,">&WRITE");
  85         open(STDERR, ">&WRITE");
  86         close($handle);
  87         close(WRITE);
  88         exec(@params);
  89         exit(-1);
  90     }
  91
  92 }