Perl 脚本不会杀死 tcl 进程

Question

我有一个 perl 脚本。它不会终止我的 tcl 进程。这是我的流程：

UID 14439 10897 0 13:55:44 pts/26 0:00 /prod/bin/wish /prod/bin/q

这是我的 perl 脚本：

#!/usr/bin/env perl
#
# Simple kill script that allows users to kill specific processes
# using sudo

use BPub::Platform qw(solaris);

# Assume a taint mode type environment
$ENV{PATH} = '/opt/csw/bin:/usr/bin:/bin';

use strict;
use Getopt::Long;

if (!@ARGV) {
    print "Usage: bkill [-9] pid <pid...>\n";
    exit 1;
}

my $dashnine;
GetOptions('9' => $dashnine);

# If the process name isn't in this hash, then you don't get to kill
# it
my %allowed_process_names = (
    'dtsession'  => 1,
    'wish'          => 1,
    'compose'    => 1,
);

# True if the given process name is one that we can kill
sub allowed_to_kill {
    return $allowed_process_names{$_[0]};
}

# Takes a pid and returns the process name
sub process_name {
    my ($pid) = @_;


    my $out = `/usr/ucb/ps -c $pid | /bin/grep $pid | /bin/cut -b 25-1000`;
    if ($?) {
        print "Error running ps command: $!\n";
        exit 2;
    }

    chomp($out);

    return $out;
}

foreach my $pid (@ARGV) {

    # tainted, remember?
    if ($pid =~ /^(\d+)$/) {
        my $safe_pid = ;

        my $name = process_name($safe_pid);

        if (allowed_to_kill($name)) {
            my @cmd = "/usr/bin/kill";
            push (@cmd, '-9') if $dashnine;
            push @cmd, $pid;

            print "@cmd\n";
            print "Killing $name ($pid)\n";
            system(@cmd);
        } else {
            print "Not allowed to kill $safe_pid: $name.\n";
        }
    } else {
        print "Invalid pid: must be a number: $pid\n";
    }
}

当我运行脚本使用sudo bkill PID。我收到一条错误消息：

bpub-xserver7-prod^UID118-> sudo bkill 14439
Password:
Not allowed to kill 14439: wish8.0.

我可以在这个脚本中做些改进吗？我如何解决这个问题，我正在摆脱 tcl 进程。

Answer 1

# If the process name isn't in this hash, then you don't get to kill
# it
my %allowed_process_names = (
    'dtsession'  => 1,
    'wish'          => 1,
    'compose'    => 1,
);
...
    my $out = `/usr/ucb/ps -c $pid | /bin/grep $pid | /bin/cut -b 25-1000`;
...
Not allowed to kill 14439: wish8.0.

您的 ps 管道将进程标识为 wish8.0 而不是 wish 或 /prod/bin/wish。您需要将 "wish8.0" 的条目添加到此 %allowed_process_names 哈希，以便使用此 perl 脚本终止此进程。

如果您查看 /prod/bin/wish，您可能会发现它是一个名为 wish8.0.

的文件的符号 link

Answer 2

您发出的错误消息的程序名称是 wish8.0。所以最简单（也是最严格）的修复是将 'wish8.0' => 1 添加到 %allowed_process_names.

或者您可以通过以下方式降低搜索的严格程度：

my @allowed_process_names = qw(dtsession wish compose)
sub allowed_to_kill {
    return scalar grep { index($_[0], $_) == 0 } @allowed_process_names
}

这将找到以任何允许的进程名称开头的任何字符串。（更改为 >= 0 或 != -1 以允许它匹配任何地方）

您也可以改用正则表达式。以下将匹配以提供的程序名称开头的任何程序。如果您删除前导插入符，它会匹配字符串中的任何位置。

my $allowed_process_names = qr/^(?:dtsession|wish|compose)/;
sub allowed_to_kill {
    return $_[0] =~ /$allowed_process_names/;
}

或者如果您想以编程方式构建正则表达式：

my @allowed_process_names = qw(dtsession wish compose)
my $allowed_process_names = join('|', map quotemeta, @allowed_process_names);
$allowed_process_names = qr/^(?:$allowed_process_names)/;

Perl 脚本不会杀死 tcl 进程

Perl script is not kill tcl process

perl

solaris