home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / perl / scripts-convex / skill < prev    next >
Encoding:
Text File  |  1991-08-09  |  7.5 KB  |  337 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # zap  -- blow away (or renice) processes
  4. # tom christiansen -- tchrist@convex.com
  5. #
  6. # currently configured for BSD
  7. #
  8. # Patterned after an idea from K&P, an old script
  9. # of mine, and Jeff Forys's humungous C program, skill. :-)
  10. #
  11. #
  12. # some defaults... look out for the first one!
  13.  
  14. ($PRIO_MIN, $PRIO_MAX) = (-64, 64);     # from sys/resource.h
  15. $signal   = 'TERM';
  16. $priority = +4;
  17.  
  18. ###############################################################
  19.  
  20. setpriority(0, $$, $PRIO_MIN);      # faster faster faster
  21. $SIG{HUP} = IGNORE;
  22.  
  23. $| = 1;
  24.  
  25. &init;
  26. &parse_args;
  27. &usage unless @cmd || @tty || @pid || @regexp || @user;
  28. &dump_values if $flag{'d'};
  29. &start_ps;
  30. &kill_procs;
  31. exit $status;
  32.  
  33. #####################################################################
  34.  
  35. sub parse_args {
  36.     local($numarg, $type, $signals);  # include *targets and die
  37.  
  38.     while ($_ = shift @ARGV) {
  39.     if (/^[-+](\d+)$/) { 
  40.         $numarg = $_;   # signal or numeric
  41.     } 
  42.     elsif (s/^-//) {
  43.         if (defined $signame{$_}) { 
  44.         if ($mode eq 'nice') {
  45.             warn "$0: can't mix signals with niceties, ignoring -$_\n";
  46.         } else {
  47.             $signal = $_; 
  48.         }
  49.         } 
  50.         elsif (s/^([cputr])(.*)//) {
  51.         *targets = $targptr{$type = $abbrev{$1}};
  52.         $_ = $2 || shift @ARGV;
  53.         unless (&targets($_)) {
  54.             die "$0: $_: invalid $type" unless $type eq 'regexp';
  55.             die "$0: $@\n";
  56.         }
  57.         push(@targets, $_);
  58.         } 
  59.         else {     # these can be anywhere
  60.         $flag{$1}++ while s/^([ildvNna])//; 
  61.         if (/[cputr]/) { s/^/-/; redo; }   # bad hack
  62.         if ($_ ne '') {
  63.             warn "$0: unknown option -$_\n";
  64.             &usage;
  65.         }
  66.         if ($flag{'l'}) {
  67.             $signals = "@signum";
  68.             write; # see format at end of file
  69.             exit;
  70.         } 
  71.         } 
  72.     } 
  73.     else {                     # time to guess
  74.         if ( s!^/dev/!! || &tty($_)) {
  75.         *targets = $targptr{'tty'};
  76.         } elsif (&user($_)) {
  77.         *targets = $targptr{'user'};
  78.         } elsif (&pid($_)) {
  79.         *targets = $targptr{'pid'};
  80.         } elsif (s!^/(.*)/?$!$1!) {
  81.         die "$0: $@\n" unless ®exp($_);
  82.         *targets = $targptr{'regexp'};
  83.         } else {
  84.         *targets = $targptr{'cmd'};
  85.         } 
  86.         push(@targets,$_);
  87.     } 
  88.     } 
  89.  
  90.     $mode = 'nice' if $flag{'N'};
  91.  
  92.     if (defined $numarg) {
  93.     if ($mode eq 'kill') {
  94.         $numarg =~ s/^[-+]//;
  95.         $signal = $numarg ? $signum[$numarg] : 0; #  perl hates 'ZERO'
  96.     } else {
  97.         undef $signal;
  98.         $priority = $numarg;
  99.         $priority = $PRIO_MIN     if $priority < $PRIO_MIN;
  100.         $priority = $PRIO_MAX     if $priority > $PRIO_MAX;
  101.     } 
  102.     }
  103.  
  104. } 
  105.  
  106.  
  107. #####################################################################
  108.  
  109. sub uid2name {
  110.     local($uid) = @_;
  111.     unless (defined $name{$uid}) {
  112.     local($name) = (getpwuid($uid))[0];
  113.     $uid{$name} = $uid;
  114.     $name{$uid} = $name;
  115.     }
  116.     $name{$uid};
  117. } 
  118.  
  119. sub name2uid {
  120.     local($name) = @_;
  121.     unless (defined $uid{$name}) {
  122.     local($uid) = (getpwnam($name))[2];
  123.     $uid{$name} = $uid;
  124.     $name{$uid} = $name;
  125.     }
  126.     $uid{$name};
  127. } 
  128.  
  129. ######################################################################
  130. # magic names here -- touch these and you are apt to be surprised
  131.  
  132. sub pid {
  133.     local($pid) = @_;
  134.     $pid =~ /^\d+$/;
  135. }
  136.  
  137. sub tty {
  138.     local($tty) = @_;
  139.     $tty =~ /^tty/ && -c "/dev/$tty";
  140. } 
  141.  
  142. sub user { 
  143.     local($who) = @_;
  144.     local($ok) = &name2uid($who); 
  145.     defined $ok;
  146. } 
  147.  
  148. sub cmd {
  149.     1;   
  150. } 
  151.  
  152. sub regexp {
  153.     local($pat) = @_;
  154.     eval "m$pat";
  155.     $@ =~ s/at \(eval\).*\n//;
  156.     $@ eq '';
  157. } 
  158.  
  159. ######################################################################
  160.  
  161. sub init {
  162.  
  163. #    run either as skill or as snice; this tells whether -5 is a 
  164. #    signal or a priority
  165.  
  166.     $mode = 'kill';
  167.     $mode = 'nice' if $0 =~ /nice/;
  168.  
  169. #   generate signal names ; comment out signames assignment
  170. #   to run kill -l instead to figure it out
  171.  
  172.     $signames = <<__EOLIST__;  # comment out for dynamic determination
  173.     HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM
  174.     TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF
  175.     WINCH LOST USR1 USR2
  176. __EOLIST__
  177.  
  178.     local($signal);
  179.     $signum[0] = 'ZERO';
  180.     for (split(' ', $signames ? $signames : `kill -l`)) { 
  181.     $signame{$_} = ++$signal; 
  182.     $signum[$signal] = $_;
  183.     }
  184.  
  185. #   set up pointers and single-char abbrev for our 4 target arrays
  186. #   if you change one of strings, all idents of this name, including
  187. #   the subroutines, must change also.  be VERY CAREFUL.
  188.  
  189.     for ('cmd', 'pid', 'user', 'tty', 'regexp') {
  190.     $abbrev{(/^(.)/)[0]} = $_;
  191.     $targptr{$_} = eval "*$_";
  192.     } 
  193.  
  194. #   some defaults
  195.  
  196. }
  197.  
  198. #####################################################################
  199.  
  200. sub dump_values {
  201.     print "signal is $signal -$signame{$signal}\n" if $mode eq 'kill';
  202.     print "will renice targets to $priority\n" if $mode eq 'nice';
  203.  
  204.     for (keys %targptr) {
  205.     *targ = $targptr{$_};
  206.     next unless defined @targ;
  207.     print "$_ targets are ", join(', ', @targ), "\n";
  208.     } 
  209.  
  210.     @flags = keys %flag;
  211.     grep(s/^/-/, @flags);
  212.     print "option flags are @flags\n";
  213. }
  214.  
  215. #####################################################################
  216.  
  217. sub usage {
  218.      die <<EOF;
  219. Usage:
  220.      skill [-signal] [-Nildvna] {tty user command pid regexp}
  221.      snice [(-|+)priority] [-Nildvna] {tty user command pid regexp}
  222.  
  223.      -i    interactive
  224.      -v    show candidates
  225.      -n    like -v but don't really do it
  226.      -a    all procs are candidates
  227.      -N    nice mode 
  228.      -d    enable debugging
  229.  
  230.      Uniquely identify {...} args with leading -t, -u, -c, -p, -r
  231.      Or use a leading slash for a regexp.
  232. EOF
  233.     exit 1;
  234. } 
  235.  
  236. ######################################################################
  237.  
  238. sub start_ps {
  239.     $ps = 'ps l';
  240.     $ps .= 'w';
  241.  
  242.     grep($pid{$_}++, @pid);
  243.     grep($user{&name2uid($_)}++, @user);
  244.     grep($tty{$_}++, @tty);
  245.     grep($cmd{$_}++, @cmd);
  246.     $regexp = join('|', @regexp);
  247.  
  248.     $ps .= 'w' if $regexp;
  249.     $ps .= 'ax' if  $> == 0      ||
  250.             $flag{'a'}  ||
  251.             @user > 1     || 
  252.             (@user == 1 && &name2uid($user[0]) != $>);
  253.     
  254.     if (! $pattern && @cmd && !grep(m!^/!, @cmd)) { $ps .= 'c'; } 
  255.  
  256.     if (@tty == 1) {  # faster
  257.     $tty[0] =~ /^tty(..)/;
  258.     $ps .= "t$1";
  259.     } 
  260.  
  261.     print "ps command is $ps\n" if $flag{'d'};
  262.  
  263.     defined($kid_pid = open(PS, "$ps |")) ||   die  "can't run ps: $!";
  264.     if (<PS> !~ /UID/) {
  265.     warn "Something's wrong with ps";
  266.     kill 'TERM', $kid_pid;
  267.     exit 2;
  268.     } 
  269.  
  270.     $dad_pid = getppid();
  271. } 
  272.  
  273. ######################################################################
  274.  
  275. sub kill_procs {
  276.     while (<PS>) {
  277.     ($user, $pid) = /^\s*[a-f\d]+\s+(\d+)\s*(\d+)/i;
  278.  
  279.     next if $pid == $$;
  280.     next if $pid == $kid_pid;
  281.     next if $pid == $dad_pid && $mode eq 'kill';
  282.     
  283.     next if @user && !$user{$user};
  284.     next if @pid  && !$pid{$pid};
  285.  
  286.     ($tty, $cmd) = /\s*(\S*)\s*\d+:\d+\s+(.*)$/;
  287.     $tty = "tty$tty" unless $tty =~ /\?/;
  288.  
  289.     next if @tty  && !$tty{$tty};
  290.     next if @regexp && $cmd !~ m$regexpo;
  291.  
  292.     if (@cmd) {
  293.         ($cmdname) = ($cmd =~ /^(\S+)/);
  294.         $cmdname =~ s!.*/!!;
  295.         next if !$cmd{$cmd} && !$cmd{$cmdname};
  296.     }
  297.  
  298.     printf "%5d  %-8s %-5s  %s ", $pid, &uid2name($user), $tty, $cmd
  299.         if $flag{'v'} || $flag{'i'} || $flag{'n'};
  300.  
  301.     if ($flag{'i'}) {
  302.         $_ = <STDIN>;
  303.         defined     || exit;
  304.         /^\s*y/i     || next;
  305.     }
  306.  
  307.     $hits++;
  308.  
  309.     unless ($flag{'n'}) {
  310.         $! = 0;
  311.         if ($mode eq 'kill') {
  312.         kill $signal, $pid;
  313.         } else {
  314.         setpriority(0, $pid, $priority);
  315.         } 
  316.         if ($!) { 
  317.         warn (($mode eq 'kill' ? 'kill' : 'setpriority')
  318.             .   " $pid: $!\n");
  319.         $status = 1;
  320.         next;
  321.         }
  322.     }
  323.  
  324.     print "\n" if $flag{'v'} || $flag{'n'};
  325.     } 
  326.     close PS || die "something happened to your $ps";
  327.     warn "$0: no target processes found\n" unless $hits;
  328. } 
  329.  
  330. ######################################################################
  331.  
  332. format STDOUT = 
  333. Any of the following signals are valid, or their numeric equivalents:
  334. ~~   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  335.       $signals
  336. .
  337.