I have a perl script. It's not killing my tcl process. Here is what my process looks like:
UID 14439 10897 0 13:55:44 pts/26 0:00 /prod/bin/wish /prod/bin/q
Here is my perl script:
#!/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 = $1;
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";
}
}
When I run the script using sudo bkill PID. I get an error message saying:
bpub-xserver7-prod^UID118-> sudo bkill 14439
Password:
Not allowed to kill 14439: wish8.0.
Is there somethings that i can better in this script? How can i fix this problem that i am having getting rid of tcl process.
The program name your error message is emitting is wish8.0. So the simplest fix (and most strict) is to add 'wish8.0' => 1 to %allowed_process_names.
Or you could make your search less strict by doing something like:
my #allowed_process_names = qw(dtsession wish compose)
sub allowed_to_kill {
return scalar grep { index($_[0], $_) == 0 } #allowed_process_names
}
Which will find any string that starts with any of the allowed process names. (change to >= 0 or != -1 to allow it to match anywhere)
You could also use a regular expression instead. The following ones will match any program that starts with the provided program names. If you remove the leading caret, it would instead match them anywhere in the string.
my $allowed_process_names = qr/^(?:dtsession|wish|compose)/;
sub allowed_to_kill {
return $_[0] =~ /$allowed_process_names/;
}
or if you want to build up the regular expression programmatically:
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)/;
# 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.
Your ps pipeline is identifying the process as wish8.0 instead of wish or /prod/bin/wish. You will need to add an entry for "wish8.0" to this %allowed_process_names hash in order to use this perl script to kill this process.
If you were to look at /prod/bin/wish, you might find that it's a symbolic link to a file named wish8.0.
Related
I've got a perl wrapper script for taskwarrior's task command that runs perfectly fine on macos.
I've ported it to a docker container running alpine. When I run the script, I get this weird error:
> # bin/task_wrapper.pl task list
Wrapper command: command task list
Can't exec "command": No such file or directory at bin/task_wrapper.pl line 61.
On my mac, it works just fine, no error.
which command reports: command: shell built-in command on both mac and on docker alpine.
I can run command task list directly from the command line in docker container and works fine.
Here's the whole script:
#! /usr/bin/env perl
use strict;
use warnings;
my $context;
my $runsub = shift #ARGV;
my #show_cmds = qw( done delete add modify );
{ no strict 'refs';
&${runsub}(#ARGV) if $runsub;
}
# my #tw_cmds = qw ( add annotate append calc config context count delete denotate done duplicate edit execute export help import log logo modify prepend purge start stop synchronize undo version );
my #descriptors = qw ( due: dep: depends: attribute: status: priority: pri: due: after: start: before: end: );
sub _parse {
my #bits = #_;
# find the first element that contains a command
my $count = 0;
my #ids;
my #rest = #bits;
foreach my $b (#bits) {
if ( $b =~ /([[a-f][0-9]]{8}),*/ ) {
push #ids, $1;
shift #rest;
next;
}
if ( $b =~ /(\d[\d\-]*),*/ ) {
push #ids, $1;
shift #rest;
next;
}
last;
}
return \#ids, \#rest;
}
sub task {
my $args = $_[0] || '';
my $filter = '';
my $subcmd = '';
if (ref $args) {
$filter = %$args{'filter'} || '';
$subcmd = %$args{'subcmd'} || '';
shift #_;
}
my #args = #_;
my #a = qw ( command task );
$context = $ENV{FLEXIBLE_CONTEXT} if !$context;
if ($context && $args ne 'sync') {
push #a, 'rc.context=' . $context;
}
if ($args =~ /sync/) {
exec 'command task sync';
} else {
print "Wrapper command: #a $filter $subcmd #args \n";
################ ERROR ON LINE BELOW
system("#a $filter $subcmd #args");
################
}
# show updated list of tasks
my $show;
$show = grep { $subcmd eq $_ } #show_cmds if $subcmd;
if ($show) {
my #sub_args;
push #sub_args, 'limit:3' if !$context;
push (#sub_args, '+st') if $context && $context !~ /\+sn|\+st/;
task ({}, #sub_args);
}
#print #a;
#print $ENV{FLEXIBLE_CONTEXT};
return;
}
sub ta {
task ({subcmd => 'add' }, #_ );
}
sub tm {
my ($ids, $rest) = _parse(#_);
task ({subcmd => 'modify', filter => "#$ids"}, #$rest);
}
# delete task
sub tdel {
my ($ids, $rest) = _parse(#_);
task ({subcmd => 'delete', filter => "#$ids"}, #$rest);
}
# done task
sub td {
task ('done', #_);
}
sub tl {
task ('next', "\\($ENV{'PU'} or +qst\\)", "-BLOCKED", #_);
}
sub tai {
task ('add', $ENV{'PU'}, 'due:1h', #_);
}
You say you're using zsh, and zsh does have a builtin named command, but you're not using zsh. You're using /bin/sh since
system( SHELL_CMD )
is effectively short for
system( '/bin/sh', '-c', SHELL_CMD )
(It's technically the value returned by perl -V:sh, not /bin/sh. But that value is /bin/sh.)
If you want to issue a zsh command, you will need to run zsh instead of /bin/sh.
system( 'zsh', '-c', SHELL_CMD )
Note that "#a $filter $subcmd #args" is not the proper way to build a shell command. It suffers from code injection bugs. You should use String::ShellQuote's shell_quote.
So the script is something like this:
use strict;
use warnings;
use Term::ReadLine;
$SIG{'INT'} = 'INT_handler';
sub INT_handler {
print "[+] Abording\n";
home();
}
my $term = Term::ReadLine->new('Simple Perl calc');
sub home {
my $prompt = "\$> ";
my $OUT = $term->OUT || \*STDOUT;
while ( defined ($_ = $term->readline($prompt)) ) {
my $com = $_;
print $com."\n";
if ($com eq 'exit') {
exit;
}
option(); # another subroutine when the input is transferred to
}
}
home();
what I get:
$>
[+] Abording
$> # I pushed CRTL C but nothing shows
$> # same here
What I want to achieve is to be able to go to home() without exiting, and keep the $SIG{'INT'} working.
I have tried some other methods ( labels, using if statement ), but it will take too long cause the input is used in long processes
You should not call home() in your signal handler.
Just set a flag that you check in your input loop. When $term->readline() returns, because it was interrupted by CTRL-C, check that the flag was set, reset it and continue to loop.
Here is your updated code:
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadLine;
$SIG{'INT'} = 'INT_handler';
my $interrupted;
sub INT_handler {
$interrupted++;
}
my $term = Term::ReadLine->new('Simple Perl calc');
sub home {
my $prompt = "\$> ";
my $OUT = $term->OUT || \*STDOUT;
while ( defined ($_ = $term->readline($prompt)) || $interrupted ) {
if ($interrupted) {
$interrupted = 0;
print "\n[+] Aborting\n";
next;
}
my $com = $_;
print $com."\n";
if ($com eq 'exit') {
exit;
}
}
}
home();
exit 0;
Test output:
$ perl dummy.pl
$> test
test
$> ^C
[+] Aborting
$> ^C
[+] Aborting
$> sdasd^C
[+] Aborting
$> exit
exit
NOTE: there seems to be one issue still: you need to press return to get the prompt back. Probably something to do with how Term::Readline works.
I am trying to implement a routine which will take in a "command" and associated "timeout".
If the command completes within the specified time, it should return the output.
Or else - it should kill the process.
sub runWithTimeout {
my ($pCommand,$pTimeOut) = #_;
my (#aResult);
print "Executing command [$pCommand] with timeout [$pTimeOut] sec/s \n";
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $pTimeOut;
#aResult = `$pCommand`;
alarm 0;
};
if ($#) {
print("Command [$pCommand] timed out\n");
# Need to kill the process.However I don't have the PID here.
# kill -9 pid
} else {
print "Command completed\n";
#print Dumper(\#aResult);
}
}
Sample Invocation :
&runWithTimeout('ls -lrt',5);
Executing command [ls -lrt] with timeout [5] sec/s
Command completed
&runWithTimeout('sleep 10;ls -lrt',5);
Executing command [sleep 10;ls -lrt] with timeout [5] sec/s
Command [sleep 10;ls -lrt] timed out
Guess if I have the PID with me - I can use "kill" on the PID in the if block.
Any pointer on how can I get the PID(or any other better approach) - it would be a great help.
Don't run the command with backticks, and use open instead. For bonus points - use IO::Select and can_read to see if you've got any output:
use IO::Select;
my $pid = open ( my $output_fh, '-|', 'ls -lrt' );
my $select = IO::Select -> new ( $output_fh );
while ( $select -> can_read ( 5 ) ) {
my $line = <$output_fh>;
print "GOT: $line";
}
##timed out after 5s waiting.
kill 15, $pid;
When I pipe stuff into my program, it does not seem to get any character like 0x4 to indicate EOF.
$ echo "abc" | map 'cat'
saw a: \x61
saw b: \x62
saw c: \x63
saw
: \x0A
zzzbc
^C
I have to press Ctrl+C to quit, but I'm not really sure what the Ctrl+C is acting on. It's probably having the shell send a SIGINT to the pipeline? I don't know how pipelines work on that level.
Here is my program map:
#!/usr/bin/env perl
use strict;
use warnings;
use IO::Pty::Easy;
use Term::ReadKey;
use Encode;
$#ARGV % 2 and die "Odd number of args required.\n";
if ($#ARGV == -1) {
warn ("No args provided. A command must be specified.\n");
exit 1;
}
# be sure to enter the command as a string
my %mapping = #ARGV[-#ARGV..-2];
my $interactive = -t STDIN;
# my %mapping = #ARGV;
# my #mapkeys = keys %mapping;
# warn #mapkeys;
if ($interactive) {
print "Spawning command in pty: #ARGV\n"
# print "\nContinue? (y/n)";
# my $y_n;
# while (($y_n = <STDIN>) !~ /^(y|n)$/) {
# print '(y/n)';
# }
# exit if $y_n eq "n\n";
}
my $pty = IO::Pty::Easy->new();
my $spawnret = $pty->spawn("#ARGV")."\n";
print STDERR "Spawning has failed: #ARGV\n" if !$spawnret;
ReadMode 4;
END {
ReadMode 0; # Reset tty mode before exiting
}
my $i = undef;
my $j = 0;
{
local $| = 1;
while (1) {
myread();
# responsive to key input, and pty output may be behind by 50ms
my $key = ReadKey(0.05);
# last if !defined($key) || !$key;
if (defined($key)) {
my $code = ord($key); # this byte is...
if ($interactive and $code == 4) {
# User types Ctrl+D
print STDERR "Saw ^D from term, embarking on filicide with TERM signal\n";
$pty->kill("TERM", 0); # blocks till death of child
myread();
$pty->close();
last;
}
printf("saw %s: \\x%02X\n", $key, $code);
# echo translated input to pty
if ($key eq "a") {
$pty->write("zzz"); # print 'Saw "a", wrote "zzz" to pty';
} else {
$pty->write($key); # print "Wrote to pty: $key";
}
}
}
}
sub myread {
# read out pty's activity to echo to stdout
my $from_pty = $pty->read(0);
if (defined($from_pty)) {
if ($from_pty) {
# print "read from pty -->$from_pty<--\n";
print $from_pty;
} else {
if ($from_pty eq '') {
# empty means EOF means pty has exited, so I exit because my fate is sealed
print STDERR "Got back from pty EOF, quitting\n" if $interactive;
$pty->close();
last;
}
}
}
}
That would explain why it produced "zzzbc".
Now my question is how can I get map to be able to know about echo "abc" having reached the end of input? cf. echo "abc" | cat completes on its own. ReadKey does not seem to provide API for determining this situation.
Similarly I am not sure how to do the same to pass along the EOF to the child in the pty. I am thinking this might cause issues when a command is to write to a file or something, because EOF vs sending a kill signal is the difference between writing the file correctly and not exiting cleanly.
Try reading from STDIN and not that $pty object. The pipe you create via the shell passes the data to your STDIN file descriptor 0, which in perl is your handle .
The $pty, I assume that's your terminal. That's why the script just hangs (I guess).
I just wrote a perl script that is restarting a list of services on a linux server. It's intended to run as a cron job. when I execute the script though, I keep getting this error;
root#www:~/scripts# ./ws_restart.pl
* Stopping web server apache2 [ OK ]
sh: Syntax error: "(" unexpected
* Stopping MySQL database server mysqld [ OK ]
sh: Syntax error: "(" unexpected
The call that is being used to do this is;
system("/etc/init.d/apache2 stop");
system("/etc/init.d/mysql stop");
I can paste the entire script code if needed, but I figured that this is the source of the problem and just need to know how to stop it.
Any ideas?
Here's the entire script;
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my $old_pids = {};
my $post_stop_ids = {};
my #services = qw/apache2 mysql solr/;
my $app_dir = '/home/grip/apps/eventfinder';
# collect existing pids then kill services
foreach my $service (#services) {
# gather up existing pids
$old_pids->{$service} = [ get_pids_by_process($service) ];
# issue stop command to each service
set_service_state($service, 'stop');
# attempt to regather same ids
$post_stop_ids->{$service} = [ get_pids_by_process($service) ];
# kill any rogue ids left over
kill_rogue_procs($post_stop_ids->{$service});
# give each kill time to finish
sleep(5);
}
# attempt to restart killed services
foreach my $service (#services) {
# issue start command to each service
set_service_state($service, 'start');
# Let's give each service enough time to crawl outta bed.
# I know how much I hate waking up
sleep(5);
}
# wait for it!...wait for it! :P
# Pad an extra 5 seconds to give solr enough time to come up before we reindex
sleep(5);
# start the reindexing process of solr
system("cd $app_dir ; RAILS_ENV=production rake reindex_active");
# call it a day...phew!
exit 0;
sub kill_rogue_procs {
my #ids = shift;
# check if we still have any rogue processes that failed to die
# if so, kill them now.
if(scalar #ids) {
foreach my $pid (#ids) {
system("kill $pid");
}
}
}
sub set_service_state {
my ($proc, $state) = #_;
if($proc eq 'apache2') {
system("/etc/init.d/apache2 $state");
} elsif($proc eq 'mysql') {
system("/etc/init.d/mysql $state");
} elsif($proc eq 'solr') {
system("cd $app_dir ; RAILS_ENV=production rake sunspot:solr:$state");
}
}
sub get_pids_by_process {
my $proc = shift;
my #proc_ids = ();
open(PSAE, "/bin/ps -ae | grep $proc |") || die("Couldn't run command");
while(<PSAE>) {
push #proc_ids, $_ =~ /(\d{1,5})/;
}
close PSAE;
return #proc_ids;
}
Actually, I'd be more suspicious of what's in #ids in kill_rogue_procs. It's the result of a ps followed by a grep, so might have bogus values if ps doesn't return any results or if the pid isn't 5 digits long.
This is wrong:
sub kill_rogue_procs {
my #ids = shift;
# check if we still have any rogue processes that failed to die
# if so, kill them now.
if(scalar #ids) {
From what you're passing to this sub, #ids will always contain a single array reference, so (scalar #ids) will always be true. It also means you end up passing something like the following to sh:
kill ARRAY(0x91b0768)
You want something like (if the arrayref is empty, there's nothing to loop over anyway):
my $ids = shift;
...
for my $pid (#$ids) {
kill SIGTERM => $pid;
Or instead of the loop:
kill SIGTERM => #$ids;
Also, there is no need to call system to kill a process.
To this, I'd add the last line, so you don't grep the grep process itself:
sub get_pids_by_process {
my $proc = shift;
$proc =~ s/^(.)/[$1]/;
As sh is raising the errors, I'm pretty sure one of the parameters to system is being expanded to something unexpected. I'd print all parameters just prior to passing them to system for a quick debug.