CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Intermediate:
Using Sys::AlarmCall in threads

 



flanque
New User

Jan 14, 2009, 2:12 PM

Post #1 of 1 (497 views)
Using Sys::AlarmCall in threads Can't Post

Hello,

I'm using Sys::AlarmCall in a threaded script and am experiencing behaviour that I cannot figure out. Basically whenever the Sys::AlarmCall times out for a thread I get the text "Alarm clock" appearing on the terminal and it appears the entire thread is exited.

Here's the code:


Code
#!/usr/bin/perl 

use strict;
use warnings;

use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;
use URI::Split qw(uri_split);

use Sys::AlarmCall;
use threads;

#use LWP::Debug qw(+);

use constant true => 1;
use constant false => 0;

use constant debug => false;

# --------------------------------------------------------------------
# User configurable browser settings
my $sURI_Retrieve = "https://www.google.com";
my $iURI_Timeout = 5;
my $sProxy_PAC_File = "";
my $sProxy_HTTP_Host = "proxy.myhome.local";
my $iProxy_HTTP_Port = 8080;
my $iProxy_HTTP_UN = "sample_username";
my $iProxy_HTTP_PW = "sample_password";
my $sProxy_HTTPS_Host = "proxy.myhome.localt";
my $iProxy_HTTPS_Port = 8080;
my $iProxy_HTTPS_UN = "sample_username";
my $iProxy_HTTPS_PW = "sample_password";

my $sHTTPAuth_Realm = "";
my $sHTTPAuth_UN = "";
my $sHTTPAuth_PW = "";
# --------------------------------------------------------------------

# @arRequestData elements are as follows:
# The omission of a value disables it. e.g. If either HTTP proxy host
# or HTTP proxy port are missing, then no HTTP proxy value is used.
# 0 = URI request
# 1 = URI request timeout in seconds
# 2 = Proxy PAC file
# 3 = HTTP proxy host
# 4 = HTTP proxy port
# 5 = HTTP proxy username
# 6 = HTTP proxy password
# 7 = HTTPS proxy host
# 8 = HTTPS proxy port
# 9 = HTTPS proxy username
# 10 = HTTPS proxy password
# 11 = HTTP authentication realm
# 12 = HTTP authentication username
# 13 = HTTP authentication password
#
my @arRequestData = (
$sURI_Retrieve,
$iURI_Timeout,
$sProxy_PAC_File,
$sProxy_HTTP_Host,
$iProxy_HTTP_Port,
$iProxy_HTTP_UN,
$iProxy_HTTP_PW,
$sProxy_HTTPS_Host,
$iProxy_HTTPS_Port,
$iProxy_HTTPS_UN,
$iProxy_HTTPS_PW,
$sHTTPAuth_Realm,
$sHTTPAuth_UN,
$sHTTPAuth_PW );

my @arRequestData2 = (
$sURI_Retrieve,
$iURI_Timeout,
$sProxy_PAC_File,
"",
$iProxy_HTTP_Port,
$iProxy_HTTP_UN,
$iProxy_HTTP_PW,
"",
$iProxy_HTTPS_Port,
$iProxy_HTTPS_UN,
$iProxy_HTTPS_PW,
$sHTTPAuth_Realm,
$sHTTPAuth_UN,
$sHTTPAuth_PW );



#my $thRequest1 = threads->new(\&thWorkerThread, @arRequestData);
my $thRequest2 = threads->new(\&thWorkerThread, @arRequestData2);

foreach my $tmpthr (threads->list()) { $tmpthr->join(); }

sub thWorkerThread {
my @arWorkerThreadData = @_;
my $iStartTicks = localtime();

my $lwpRequestURIResults = alarm_call(15, 'lwpRequestURI', @arWorkerThreadData);

if( $lwpRequestURIResults eq $Sys::AlarmCall::TIMEOUT ) {
print "Timed out\n";
} else {
print "Success\n";
}
}

# --------------------------------------------------------------------------
# lwpRequestURI(@TestData)
#
# Input:
# @arRequestData Array holding the request data.
#
# Output / Return:
# -1 <MSG> If some non LWP error occurs. e.g. bad URL, etc
# <MSG> will be textual description of problem.
#
# $RESPONSE LWP response object of the request.
# --------------------------------------------------------------------------
sub lwpRequestURI {
# Collect all the data required to perform the query.
my $RequestData_URI = $_[0];
my $RequestData_URI_Timeout = $_[1];
my $RequestData_PAC_File = $_[2];
my $RequestData_HTTP_Proxy_Host = $_[3];
my $RequestData_HTTP_Proxy_Port = $_[4];
my $RequestData_HTTP_Proxy_UN = $_[5];
my $RequestData_HTTP_Proxy_PW = $_[6];
my $RequestData_HTTPS_Proxy_Host = $_[7];
my $RequestData_HTTPS_Proxy_Port = $_[8];
my $RequestData_HTTPS_Proxy_UN = $_[9];
my $RequestData_HTTPS_Proxy_PW = $_[10];
my $RequestData_HTAuth_Realm = $_[11];
my $RequestData_HTAuth_UN = $_[12];
my $RequestData_HTAuth_PW = $_[13];

# Output the values handed to the routine if in debug mode.
print "Started lwpRequestURI\n" if debug;
print "RequestData_URI:\t\t$RequestData_URI\n" if debug;
print "RequestData_URI_Timeout:\t$RequestData_URI_Timeout\n" if debug;
print "RequestData_PAC_File:\t\t$RequestData_PAC_File\n" if debug;
print "RequestData_HTTP_Proxy_Host:\t$RequestData_HTTP_Proxy_Host\n" if debug;
print "RequestData_HTTP_Proxy_Port:\t$RequestData_HTTP_Proxy_Port\n" if debug;
print "RequestData_HTTP_Proxy_UN:\t$RequestData_HTTP_Proxy_UN\n" if debug;
print "RequestData_HTTP_Proxy_PW:\t$RequestData_HTTP_Proxy_PW\n" if debug;
print "RequestData_HTTPS_Proxy_Host:\t$RequestData_HTTPS_Proxy_Host\n" if debug;
print "RequestData_HTTPS_Proxy_Port:\t$RequestData_HTTPS_Proxy_Port\n" if debug;
print "RequestData_HTTPS_Proxy_UN:\t$RequestData_HTTPS_Proxy_UN\n" if debug;
print "RequestData_HTTPS_Proxy_PW:\t$RequestData_HTTPS_Proxy_PW\n" if debug;
print "RequestData_HTAuth_Realm:\t$RequestData_HTAuth_Realm\n" if debug;
print "RequestData_HTAuth_UN:\t\t$RequestData_HTAuth_UN\n" if debug;
print "RequestData_HTAuth_PW:\t\t$RequestData_HTAuth_PW\n" if debug;

# Build the HTTP and HTTPS proxy strings.
my $sHTTP_Proxy = "http://$RequestData_HTTP_Proxy_UN:$RequestData_HTTP_Proxy_PW\@$RequestData_HTTP_Proxy_Host:$RequestData_HTTP_Proxy_Port";
my $sHTTPS_Proxy = "http://$RequestData_HTTPS_Proxy_Host:$RequestData_HTTPS_Proxy_Port";


# Split the URI into its components (e.g. http, www.google.com, etc).
my @sURIComponents = uri_split($RequestData_URI);

my $sProtocol = $sURIComponents[0];
my $sFQDN = $sURIComponents[1];
my $sFQDNnPort;

# Check the protocol is acceptable, either http or https.
if (!($sProtocol =~ /^http$|^https$/i)) {
return "-1 Unknown URI protocol. Only accept http or https.";
}

# Check if the FQDN has it's own port.
# Create $sFQDNnPort with $sFQDN:<port> if not.
if ($sFQDN =~ /:\d+/ ) {
$sFQDNnPort = $sFQDN;
} else {
if ($sProtocol =~ /^http$/i ) { $sFQDNnPort = $sFQDN . "\:80"; }
if ($sProtocol =~ /^https$/i ) { $sFQDNnPort = $sFQDN . "\:443"; }
}

# Create a UserAgent object instance and configure it as needed.
my $BROWSER = LWP::UserAgent->new();

# Define the Agent name.
my $sBrowserAgent = "TestPerlBrowser/1.0.0";
$BROWSER->agent($sBrowserAgent);

# Define the allowed protocols.
$BROWSER->protocols_allowed( ['http', 'https'] );

# Set browser timeout for how long to wait for page to be downloaded, in seconds.
$BROWSER->timeout($RequestData_URI_Timeout);

# Set the .htaccess style authentication credentials.
if (!($RequestData_HTAuth_UN eq "") && !($RequestData_HTAuth_PW eq "")) {
$BROWSER->credentials(
$sFQDNnPort,
$RequestData_HTAuth_Realm,
$RequestData_HTAuth_UN => $RequestData_HTAuth_PW
);
}

# Define the HTTP proxy settings, if required.
if ($RequestData_HTTP_Proxy_Host && $RequestData_HTTP_Proxy_Port) {
print "sHTTP_Proxy:\t\t\t$sHTTP_Proxy\n" if debug;
$BROWSER->proxy('http', $sHTTP_Proxy);
}

# Define the HTTPS proxy settings, if required.
if ($RequestData_HTTPS_Proxy_Host && $RequestData_HTTPS_Proxy_Port) {
print "sHTTPS_Proxy:\t\t\t$sHTTPS_Proxy\n" if debug;
$ENV{HTTPS_PROXY} = $sHTTPS_Proxy;
$ENV{HTTPS_PROXY_USERNAME} = $RequestData_HTTPS_Proxy_UN;
$ENV{HTTPS_PROXY_PASSWORD} = $RequestData_HTTPS_Proxy_PW;
}

# Create a request for the user agent.
my $REQUEST = HTTP::Request->new("GET" => $RequestData_URI);
my $RESPONSE = $BROWSER->request($REQUEST);

print $RESPONSE->content;

# Undefine the HTTPS proxy settings.
if ($RequestData_HTTPS_Proxy_Host && $RequestData_HTTPS_Proxy_Port) {
$ENV{HTTPS_PROXY} = "";
$ENV{HTTPS_PROXY_USERNAME} = "";
$ENV{HTTPS_PROXY_PASSWORD} = "";
}


print "Ended lwpRequestURI\n" if debug;
return $RESPONSE;
}


You'll notice the that I am trying to retrieve a website (www.google.com) and that I have two arrays defined with the second essentially removing the HTTPS proxy host. My environment requires a proxy to be used to access the Internet.


Code
#my $thRequest1 = threads->new(\&thWorkerThread, @arRequestData);  
my $thRequest2 = threads->new(\&thWorkerThread, @arRequestData2);


When a proxy is defined it obviously works and we're all set.
When a proxy is not defined, then even though I set a timeout of 5 seconds the LWP library doesn't timeout and thus I am trying to use Sys::AlarmCall to ensure that it does in fact timeout.

This may or may not be the best way to do it, so alternative recommendations are appreciated specifically on this point.

The call to use Sys::AlarmCall is at this line of code, and it does indeed timeout after 15 seconds, however it's at this point where I get the text "Alarm clock" on the terminal and my evaluation code afterwards does not get executed:


Code
        my $lwpRequestURIResults = alarm_call(15, 'lwpRequestURI', @arWorkerThreadData); 


if( $lwpRequestURIResults eq $Sys::AlarmCall::TIMEOUT ) {
print "Timed out\n";
} else {
print "Success\n";
}


Can someone please explain why this is occuring? Again if you can think of a better way to enforce the retrieval timeout that is thread safe then please also let me know.


Thank you in advance.


PS. Please disregard the pac file code. This is being removed but I haven't had the chance yet to do it.

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives