I'm using Term::ReadLine::Gnu and have run into a problem with signal handling. Given the script below and a TERM signal sent to the script, the handler for the TERM signal is not triggered until after the enter key is pressed. Using Term::ReadLine:Perl this does not occur.
I've read that Term::ReadLine::Gnu has its own internal signal handlers, but frankly I'm at a loss as to how to work with them.
I've reviewed http://search.cpan.org/~hayashi/Term-ReadLine-Gnu-1.20/Gnu.pm#Term::ReadLine::Gnu_Variables tried setting the rl_catch_signals variable to 0, but that didn't help. Ideally, I'd like to work with the Gnu signal handlers, but I'll settle for disabling them too.
To be absolutely specific, I need the TERM handler to trigger after the signal is received instead of waiting for the enter key to be pressed.
Any help or advice is certainly appreciated!
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadLine;
$SIG{TERM} = sub { print "I got a TERM\n"; exit; };
my $term = Term::ReadLine->new('Term1');
$term->ornaments(0);
my $prompt = 'cmd> ';
while ( defined (my $cmd = $term->readline($prompt)) ) {
$term->addhistory($cmd) if $cmd !~ /\S||\n/;
chomp($cmd);
if ($cmd =~ /^help$/) {
print "Help Menu\n";
}
else {
print "Nothing\n";
}
}
This is due to perl's default paranoid handling of signals - behind the scenes, perl blocks SIGTERM before starting the readline call and restores it when it's finished. See Deferred Signals in perlipc for the details.
Term::ReadLine::Perl uses perl's IO, which knows about these issues and deals with them, so you don't see this bug with it. Term::ReadLine::Gnu uses the C library, which doesn't, so you do.
You can work around this with one of two methods:
set the environment variable PERL_SIGNALS to unsafe before running the script, as in:
bash$ PERL_SIGNALS=unsafe perl readline-test.pl
Note, BEGIN { $ENV{PERL_SIGNALS} = "unsafe"; } isn't enough, it needs to be set before perl itself starts.
Use POSIX signal functions:
#~ $SIG{TERM} = sub { print "I got a TERM\n"; exit; };
use POSIX;
sigaction SIGTERM, new POSIX::SigAction sub { print "I got a TERM\n"; exit; };
Both the above seem to work in Linux; can't speak for Windows or other unices. Also, both of the above come with risks - see perlipc for the details.
Related
Certain builtins like system and exec (as well as backticks) will use the shell (I think sh by default) if passed a single argument containing shell metacharacters. If I want to write a portable program that avoids making any assumptions about the underlying shell, is there a pragma or some other option I can use to either disable shell access or trigger a fatal error immediately?
I write about this extensively in Mastering Perl. The short answer is to use system in it's list form.
system '/path/to/command', #args;
This doesn't interpret any special characters in #args.
At the same time, you should enable taint checking to help catch bad data before you pass it to the system. See the perlsec documentation for details.
There are limited options to do this, keep in mind that these are core routines and completely disabling them may have some unexpected consequences. You do have a few options.
Override Locally
You can override system and exec locally by using the subs pragma, this will only effect the package into which you have imported the sub routine:
#!/usr/bin/env perl
use subs 'system';
sub system { die('Do not use system calls!!'); }
# .. more code here, note this will runn
my $out = system('ls -lah'); # I will die at this point, but not before
print $out;
Override Globally
To override globally, in the current perl process, you need to import your function into the CORE::GLOBAL pseudo-namespace at compile time:
#!/usr/bin/env perl
BEGIN {
*CORE::GLOBAL::system = sub {
die('Do not use system calls.');
};
*CORE::GLOBAL::exec = sub {
die('Do not use exec.');
};
*CORE::GLOBAL::readpipe = sub {
die('Do not use back ticks.');
};
}
#...
my $out = system('ls -lah'); # I will die at this point, but not before
print $out;
Prevent anything form running if in source
If you want to prevent any code running before getting to a system call you can include the following, note this is fairly loose in it's matching, I've written it to be easy to modify or update:
package Acme::Noshell;
open 0 or print "Can't execute '$0'\n" and exit;
my $source = join "", <0>;
die("Found back ticks in '$0'") if($source =~ m/^.*[^#].*\`/g);
die("Found 'exec' in '$0'") if($source =~ / exec\W/g);
die("Found 'system' in '$0'") if($source =~ / system\W/g);
1;
Which can be used as follows:
#!/usr/bin/env perl
use strict;
use warnings;
use Acme::Noshell;
print "I wont print because of the call below";
my $out = system('ls -lah');
BEGIN {
while (1) {
print "hi\n";
}
}
END {
print "end is called\n";
}
in shell:
kill <pid>
OUTPUT:
hi
hi
hi
hi
hi
hi
hi
hi
hi
Terminated
The end block didnt get called when i killed it via kill or ctrl-c.
Is there something equivalent that will always get called before program exits
Ctrl C sends a SIGINT to your program. You can 'catch' this with a signal handler by setting the appropriate entry in %SIG. I would note - I don't see why you're using BEGIN that way. BEGIN is a special code block that's called at compile time - at the very first opportunity. That means it's triggered when you run perl -c to validate your code, and as such is really a bad idea to set as an infinite loop. See: perlmod
E.g.
#!/usr/bin/perl
use strict;
use warnings;
$SIG{'INT'} = \&handle_kill;
my $finished = 0;
sub handle_kill {
print "Caught a kill signal\n";
$finished++;
}
while ( not $finished ) {
print "Not finished yet\n";
sleep 1;
}
END {
print "end is called\n";
}
But there's a drawback - some signals you can't trap in this way. See perlipc for more details.
Some signals can be neither trapped nor ignored, such as the KILL and STOP (but not the TSTP) signals. Note that ignoring signals makes them disappear. If you only want them blocked temporarily without them getting lost you'll have to use POSIX' sigprocmask.
By default if you send a kill, then it'll send a SIGTERM. So you may want to override this handler too. However it's typically considered bad to do anything other than exit gracefully with a SIGTERM - it's more acceptable to 'do something' and resume when trapping SIGHUP (Hangup) and SIGINT.
You should note that Perl does 'safe signals' though - and so some system calls won't be interrupted, perl will wait for it to return before processing the signal. That's because bad things can happen if you abort certain operations (like close on a file where you're flushing data might leave it corrupt). Usually that's not a problem, but it's something to be aware of.
put the proper signal handler in your code:
$SIG{INT} = sub { die "Caught a sigint $!" };
the control-c sends the SIGINT signal to the script, who is catched by this handler
I'm running a command line application from within the perl script(using system()) that sometimes doesn't return, to be precise it throws exception which requires the user input to abort the application. This script is used for automated testing of the application I'm running using the system() command. Since, it is a part of automated testing, sytem() command has to return if the exception occurs and consider the test to be fail.
I want to write a piece of code that runs this application and if exception occurs it has to continue with the script considering the this test to be failed.
One way to do this is to run the application for certain period of time and if the system call doesn't return in that period of time we should terminate the system() and continue with the script.
(How can I terminate a system command with alarm in Perl?)
code for achieving this:
my #output;
eval {
local $SIG{ALRM} = sub { die "Timeout\n" };
alarm 60;
return = system("testapp.exe");
alarm 0;
};
if ($#) {
print "Test Failed";
} else {
#compare the returned value with expected
}
but this code doesn't work on windows i did some research on this and found out that SIG doesn't work for windows(book programming Perl).
could some one suggest how could I achieve this in windows?
I would recommend looking at the Win32::Process module. It allows you to start a process, wait on it for some variable amount of time, and even kill it if necessary. Based on the example the documentation provides, it looks quite easy:
use Win32::Process;
use Win32;
sub ErrorReport{
print Win32::FormatMessage( Win32::GetLastError() );
}
Win32::Process::Create($ProcessObj,
"C:\\path\\to\\testapp.exe",
"",
0,
NORMAL_PRIORITY_CLASS,
".")|| die ErrorReport();
if($ProcessObj->Wait(60000)) # Timeout is in milliseconds
{
# Wait succeeded (process completed within the timeout value)
}
else
{
# Timeout expired. $! is set to WAIT_FAILED in this case
}
You could also sleep for the appropriate number of seconds and use the kill method in this module. I'm not exactly sure if the NORMAL_PRIORITY_CLASS creation flag is the one you want to use; the documentation for this module is pretty bad. I see some examples using the DETACHED_PROCESS flag. You'll have to play around with that part to see what works.
See Proc::Background, it abstracts the code for both win32 and linux, the function is timeout_system( $seconds, $command, $arg, $arg, $arg )
I have a perl script, using standard-as-dirt Net::HTTP code, and perl 5.8.8.
I have come across an error condition in which the server returns 0 bytes of data when I call:
$_http_connection->read_response_headers;
Unfortunately, my perl script dies, because the Net::HTTP::Methods module has a "die" on line 306:
Server closed connection without sending any data back at
/usr/lib/perl5/vendor_perl/5.8.8/Net/HTTP/Methods.pm line 306
And lines 305-307 are, of course:
unless (defined $status) {
die "Server closed connection without sending any data back";
}
How can I have my script "recover gracefully" from this situation, detecting the die and subsequently going into my own error-handling code, instead of dieing itself?
I'm sure this is a common case, and probably something simple, but I have not come across it before.
Using eval to catch exceptions can occasionally be problematic, especially pre 5.14. You can use Try::Tiny.
You can use eval { } to catch die() exceptions. Use $# to inspect the thrown value:
eval {
die "foo";
};
print "the block died with $#" if $#;
See http://perldoc.perl.org/functions/eval.html for details.
Customizing the die to mean something else is simple:
sub custom_exception_handler { ... } # Define custom logic
local $SIG{__DIE__} = \&custom_exception_handler; # Won't die now
# Calls custom_exception_handler instead
The big advantage of this approach over eval is that it doesn't require calling another perl interpreter to execute the problematic code.
Of course, the custom exception handler should be adequate for the task at hand.
I have the following perl code on windows activestate perl 5.8
$SIG{INT}=\&clean;
...
sub clean {
print 'cleaning...';
...
...
exit 0;
}
but when i try to close my program by Ctrl^c it didn't enter the sub clean at all could someone help why did i miss something ?
It seems that Windows doesn't provide signals as in Unix.
From man perlwin32:
Signal handling may not behave as on Unix platforms (where it doesn't
exactly "behave", either :). For instance, calling "die()" or "exit()"
from signal handlers will cause an exception, since most implementations
of "signal()" on Win32 are severely crippled. Thus, signals may
work only for simple things like setting a flag variable in the handler.
Using signals under this port should currently be considered
unsupported.
I'd say no. I can't see anything wrong with what you're doing. I wrote a test program that actually runs:
#!/usr/bin/perl
use strict;
use warnings;
$SIG{INT}=\&clean;
sub clean {
print 'caught';
}
sleep 10;
Tested on Linux, this works as expected, but I don't have AS perl handy to try it. Try it yourself on your machine.
Also, print to STDERR to ensure it's not something very odd going on with print buffering.
I found that the script given by #ijw (modified to be what it is below) does not work under Active State Perl version v5.10.1:
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 2 registered patches, see perl -V for more detail)
My modification below adds the autoflush calls (as otherwise the sleep
below would not show the print statement output at all while
sleeping):
#!/usr/bin/perl
use IO;
use strict;
use warnings;
# Set autoflushing on to stdout and stderr. Otherwise, system() call and stdout output does not show up in proper sequence,
# especially on Windows:
STDOUT->autoflush(1);
STDERR->autoflush(1);
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
print "before sleep\n";
sleep 100;
print "after sleep and then exiting\n";
exit (0);
When I commented out the following lines in that script above:
$SIG{INT}=\&clean;
sub clean {
print "caught\n";
exit (0);
}
And then hitting CTRL-C during the sleep, the script does terminate and show this message:
Terminating on signal SIGINT(2)
Hence it must actually still be true (well, for ActiveState Perl v5.10.1) what man perlwin32 states:
... most implementations of "signal()" on Win32 are severely crippled. ...
For future reference:
perlmonks refers to the use of Win32::API to setup a call to the SetConsoleCtrlHandler Win32 function.
All about SetConsoleCtrlHandler.