| #!/usr/bin/perl |
| |
| # |
| # Copyright 1995. Michael Veksler. |
| # |
| |
| $IPC_RMID=0; |
| $USER=$ENV{USER}; |
| |
| do open_pipe(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(<IPCS>) { |
| 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); |
| } |
| |
| exit(0); |
| |
| |
| |
| |
| |
| sub open_pipe { |
| local($pid); |
| local($handle,@params)=@_; |
| pipe($handle,WRITE) || die "can't pipe"; |
| |
| $pid=fork(); |
| |
| die "can't fork" if ($pid<0); |
| if ($pid>0) { |
| # whe are in the parent |
| close(WRITE); |
| waitpid($pid,0) || print "$params[0] exits status=$? ",$? >> 8, "\n"; |
| } else { |
| # we are in the son. |
| open(STDOUT,">&WRITE"); |
| open(STDERR, ">&WRITE"); |
| close($handle); |
| close(WRITE); |
| exec(@params); |
| exit(-1); |
| } |
| |
| } |