mod_perl script going in to a tight loop during 'use' processing - perl

I have a rather complex problem to describe. I'm looking for any suggestions for further debugging.
I'm trying to convert to mod_perl from regular cgi. I send an http request to a script that loads up a page, and on that page there are links to load images that are retrieved via further scripts (in other words, the images are loaded via a cgi script, not just a plain link). So when the page loads in the browser, the browser kicks off half a dozen more requests that run scripts to load the images.
The first script (initial page load) runs fine, but sometime after that the apache server goes into a tight loop (very high cpu usage and has to be killed) when processing the image load scripts. Sometimes one of the image load scripts runs fine but a further one loops, sometimes it's the first image load script that loops. strace doesn't show up anything during the loop.
I've started the apache server in single user mode (with -X) and run the interactive perl debugger with trace on to see where the loop starts. I've done this several times, and each time it starts in exactly the same place, during processing of the 'use' statements. I see piles and piles of 'use' and 'require' statements going by, along with other junk, but it always stops at:
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:97):
97: eval { local $SIG{__DIE__};
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:97):
97: eval { local $SIG{__DIE__};
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:98):
98: require XSLoader;
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:99):
99: XSLoader::load(__PACKAGE__, $VERSION);
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:102):
102: if($# eq "") {
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:103):
103: close(DATA);
Params::Classify::CODE(0x7f43b0b46dd8)(/usr/lib/perl5/Params/Classify.pm:130):
130: 1;
Data::Entropy::CODE(0x7f43b0b46dd8)(/usr/share/perl5/Data/Entropy.pm:46):
46: use Params::Classify 0.000 qw(is_ref);
Data::Entropy::CODE(0x7f43b0b46dd8)(/usr/share/perl5/Data/Entropy.pm:46):
46: use Params::Classify 0.000 qw(is_ref);
This section of 'use' processing is kicked off in my script with:
use Authen::Passphrase::BlowfishCrypt;
I've done some searches on Data::Entropy and Params::Classify and didn't find anything useful (which is what I expected - I doubt there is a bug with them).
This has the feel of memory corruption from previous script runs, but I'm not sure yet how to track it down. Since I'm new to mod_perl I thought I'd run it by some experts to see if they've run into something similar or have suggestions on how I can further debug this.
Running apache/2.2.22 mod_perl/2.0.5 perl/5.14.2.
Code is pretty basic, but here it is:
package Wii::Web;
use strict;
use warnings;
use base qw(Wii);
use Data::Dumper;
use Params::Validate qw(:all);
use Log::Log4perl qw(get_logger :easy);
use CGI;
use Carp qw(cluck);
use Email::Valid;
use Authen::Passphrase::BlowfishCrypt;
use Digest::SHA;
use Digest::HMAC;
use Time::HiRes qw(gettimeofday tv_interval);
use Wii::Web::View;
use Wii::Web::Register;
use Wii::Web::Login;
use Wii::Web::Session;
use Wii::Web::User;
use Wii::Web::Found;
$CGI::POST_MAX = 1024 * 5000;
BEGIN {
$SIG{__DIE__} = \&sigDie;
}
sub sigDie {
return if $^S; # we are in an eval block
# assume this is the first print
my ($error) = #_;
print "Status: 500\n";
print "Content-type: text/html\n\n";
print "<html><body>\n";
print "<h3>Whoops there was an error!</h3>\n";
print "<!-- $error -->\n";
print "Please try again later<br />\n";
print "<b>$error</b>\n";
print "</body></html>\n";
Wii::sigDie(#_);
return 1;
}
<snip>
There are other modules involved before this one, but this is the one that kicks off the problem.

Params::Classify::XS is not thread safe. Switch from using the XS to perl Perl version.

Related

perl - two stage conditional compilation

I have pretty big perl script executed quite frequently (from cron).
Most executions require pretty short & simple tests.
How to split single file script into two parts with "part two" compiled based on "part 1" decision?
Considered solution:
using BEGIN{ …; exit if …; } block for trivial test.
two file solution with file_1 using require to compile&execute file_2.
I would prefer single file solution to ease maintenance if the cost is reasonable.
First, you should measure how long the compilation really takes, to see if this "optimization" is even necessary. If it does happen to be, then since you said you'd prefer a one-file solution, one possible solution is using the __DATA__ section for code like so:
use warnings;
use strict;
# measure compliation and execution time
use Time::HiRes qw/ gettimeofday tv_interval /;
my $start;
BEGIN { $start = [gettimeofday] }
INIT { printf "%.06f\n", tv_interval($start) }
END { printf "%.06f\n", tv_interval($start) }
my $condition = 1; # dummy for testing
# conditionally compile and run the code in the DATA section
if ($condition) {
eval do { local $/; <DATA>.'; 1' } or die $#;
}
__DATA__
# ... lots of code here ...
I see two ways of achieving what you want. The simple one would be to divide the script in two parts. The first part will do the simple tests. Then, if you need to do more complicated tests you may "add" the second part. The way to do this is using eval like this:
<first-script.pl>
...
eval `cat second-script.pl`;
if( $# ) {
print STDERR $#, "\n";
die "Errors in the second script.\n";
}
Or using File::Slurp in a more robust way:
eval read_file("second-script.pl", binmode => ':utf8');
Or following #amon suggestion and do:
do "second-script.pl";
Only beware that do is different from eval in this way:
It also differs in that code evaluated with do FILE cannot see lexicals in the enclosing scope; eval STRING does. It's the same, however, in that it does reparse the file every time you call it, so you probably don't want to do this inside a loop.
The eval will execute in the context of the first script, so any variables or initializations will be available to that code.
Related to this, there is this question: Best way to add dynamic code to a perl application, which I asked some time ago (and answered myself with the help of the comments provided and some research.) I took some time to document everything I could think of for anyone (and myself) to refer to.
The second way I see would be to turn your testing script into a daemon and have the crontab bit call this daemon as necessary. The daemon remains alive so any data structures that you may need will remain in memory. On the down side, this will take resources in a continuos way as the daemon process will always be running.

Show error if pm library doesn't exist

"Interesting" dilemma this one.
To use a lib in perl, you obviously include "use lib x" command ... but what can you do if "x.pm" doesn't exist, (or more correctly per chance deleted by server admin)
In short, I 'hide' this file in with the .htaccess and other files in the root of my account, ie below the "public_html" folder - to keep it away from prying eyes. So I can set the path in the script such as "use /home/account/x" and all is well.
In the past, I think security measures mean this file sometimes gets removed. So when the script runs, the viewer sees a glorious "500 Error"
I tried:
If (-e 'use /home/account/x'){
use 'home/account/x';
...
}
else{
print "error";
}
But all that does is say it cannot find the use command on the line below "If"
Tried:
use 'home/account/x' || die ('cannot find file')
But that syntax is wrong. Is there any simple way around this?
This is to do with when the error can be 'noticed'. use happens at compile time. Thus - you can't do many of the normal program flow things that you'd do. (There are a few exceptions).
But what you can do instead, is require which loads things at run time - at a point where you can do the sort of tests you would want.
#!/usr/bin/env perl
use strict;
use warnings;
eval { require "Not_here.pm" };
warn "Couldn't load: $#" if $#;
print "fish";
Although, you may also need to import the routines you want, after requiring the module, because use does:
BEGIN { require Module; Module->import( LIST ); }
I use string eval to check if a module exists, if I can run without it.
our $have_unac = 0;
BEGIN {
eval "use Text::Unaccent::PurePerl";
$have_unac = 1 if (!$#);
}

Circumstances under which die() does not exit a Perl script?

I'm debugging a really weird problem with a long-running Perl script.
The problem is that the script does not exit on die() as expected. Instead the script just hangs without returning.
I've not defined any error handlers myself so I would assume that die() would lead to an immediate termination of the script.
This is the basic structure of the script and the modules used:
#!/usr/bin/perl
use strict;
use utf8;
use warnings;
use DBI; # with MySQL driver ("dbi:mysql:database=...")
use Geo::IP;
use POSIX;
use URI::Escape;
open(COMMAND, 'command_line |');
while (<COMMAND>) {
#
# .. stuff that can go wrong ..
#
die("I'm expecting the script to terminate here. It doesn't.") if ($gone_wrong);
}
close(COMMAND);
What could be the explanation to this behaviour? Is any of the modules used known to set up error handlers that could explain the script hanging on die()?
Well, END blocks and object destructors are still called after a die. If one of those hangs (or does something that takes a long time), the script won't exit immediately. But that should happen after printing the message from die (unless STDERR is buffered so you don't see the message immediately).
You mention DBI, so you probably have a database handle whose destructor is being called. (I'm not sure that's the problem, though.)

Problem with perl signal INT

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.

CGI script's message not rendring in browser?

I'm trying to copy some files from one network share to another using File::Copy.
This is my code:
#!C:/strawberry/perl/bin/perl.exe
use File::Copy;
print "Content-type: text/html\n\n";
print "<H1>Hello World</H1>\n";
copy("s:\\nl\\cover\\config.jsp", "s:\\temp\\config.jsp")
or die "File cannot be copied.";
print "this is not displayed";
Why is the 'die' message not rendering?
If you are running this under a web server (I cannot imagine why, you are sending a "Content-Type" header), any error messages you emit using die and warn will go to the server's error log.
Further, if you are invoking this as CGI, note that you are lying to the browser by claiming you are sending HTML and not sending HTML.
Especially if you are just learning Perl, you should make an effort to dot all your is and cross all your ts:
#!C:/strawberry/perl/bin/perl.exe
use strict; # every time
use warnings; # every time
use CGI qw(:cgi);
use CGI::Carp qw(fatalsToBrowser); # only during debugging
use File::Copy;
use File::Spec::Functions qw(catfile);
$| = 1;
# prefer portable ways of dealing with filenames
# see http://search.cpan.org/perldoc/File::Spec
my $source = catfile(qw(S: n1 cover config.jsp));
my $target = catfile(qw(S: temp config.jsp));
print header('text/plain');
if ( copy $source => $target ) {
print "'$source' was copied to '$target'\n";
}
else {
print "'$source' was not copied to '$target'\n";
# you can use die if you want the error message to
# go to the error log and an "Internal Server Error"
# to be shown to the web site visitor.
# die "'$source' was not copied to '$target'\n";
}
See CGI for the function oriented interface import lists.
Are you sending your stderr to the stdout stream as well? All your prints will got to stdout which is presumably connected to a browser, given your HTML output.
However, die writes to the stderr stream. This is likely to go, not to the browser window, but to an error log of some sort. As to where it's going, it depends on what Perl is running within.
One way to check is to print something instead of dieing in the or clause.
So, some questions:
How are you running it?
If on the command line, show us the exact command.
If in a web server of some sort, tell us which one so we can find the logs for you.
die sends messages to STDERR, which will wind up in the web server's error logs, not on the screen. There are some CGI modules that offer you greater control over error-handling, or you could install a $SIG{__DIE__} handler (if you don't know what that is, then don't worry -- you don't need to), but when I want a quick-and-dirty way to debug my CGI scripts, I put this at the top of the script:
#! /usr/bin/perl
$src = join'',<DATA>;
eval $src;
print "Content-type: text/plain\n\n$#\n" if $#;
__END__
... my cgi script starts here ...
This loads the script into a variable, uses eval to run the Perl interpreter on that variable's contents, and prints any errors to standard output (the browser window) with a valid header.
copy("s:\\nl\\cover\\config.jsp", "s:\\temp\\config.jsp")
or die "File cannot be copied.";
print "this is not displayed";
Only one of these messages should ever be displayed and it's unclear which you're asking about.
The question says you're wondering why the die message isn't being displayed; to me, that implies that you're not seeing the message "File cannot be copied." and the most obvious reason for this is that the copy operation is succeeding, but see also the previous responses about looking in the error log if you're running this under CGI.
The text of the messages, though, suggests that you actually mean you're not seeing the message "this is not displayed". (Why else would you mention that it isn't displayed?) In that case, the reason you're not seeing it is because die causes the program to exit. After the copy fails and the die executes, your program is dead. Terminated. It has shuffled off this mortal CPU and joined the stack eternal. It wouldn't print "this is not displayed" if you put four million volts through it. It is an ex-process.
After editing your code, it's apparent that your die is seen as a command and probably needs to be escaped. Note how it is rendered on Stack Overflow in blue (indicating that it is a keyword). Try switching to a synonym like "shutdown" instead.