I want my server to stop for a few seconds and then start again.
I am trying to use sleep(5).
Will this help?
I've tried with a Perl script containing:
if($mech=~ m/(Connection refused)/) {print "SLEEPING\n";sleep(5);redo;}
A server hosts web pages. A client connects to a server. A Perl script using WWW::Mechanize is a client.
I suspect you're trying to do the following:
my $retries = 3;
my $resp; # response goes here
while ( $retries-- > 0 ) {
$resp = $ua->get( "http://www.google.com/" );
if ( ! $resp->is_success ) {
warn( "Failed to get webpage: " . $resp->status_line );
sleep( 5 );
next; # continue the while loop
}
last; # success!
}
if ( $retries == 0 ) {
die( "Too many retries!" );
}
# old versions of LWP::UserAgent didn't have decoded_content()
my $content = $resp->can('decoded_content') ?
$resp->decoded_content : $resp->content;
print( $content );
UPDATE
Here is the code you supplied in a comment:
use WWW::Mechanize;
my $mech = new WWW::Mechanize;
eval {
$mech->get($url);
};
if($#) {
print STDERR "Burst\n";
print STDERR Dumper($mech);
# my $var=$mech;
# print STDERR "var $var\n";
# if($mech=~ m/(Connection refused)/)
# {
# print "SLEEPING\n";
# sleep(5);
# redo;
# }
From perdoc -f redo:
The "redo" command restarts the loop block without evaluating the conditional again. The "continue" block, if any, is not executed. If the LABEL is omitted, the command refers to the innermost enclosing loop.
Seeing as you haven't put your code in a loop the call to redo doesn't have any effect.
Related
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'm playing around with Mojolicious and websockets. I want to send the output of multiple external commands on the server to the webpage. I have no problems with connecting and receiving messages, but I also want to send a message back to the server to stop an external command while letting the others keep sending messages back to the client. I also want to stop checking the external command once it exits.
The external command is simply a one-liner that spits out an integer every few seconds. I have two websockets that display the numbers in separate divs. Clicking either of the stop buttons sends the message, but that's where I need to figure out how to shut down that websocket (and only that websocket) and shut down the external command.
When I connect the websocket, I run the external command and set up a Mojo::IOLoop->recurring to check if there's output.
When I want to stop, I figure that I should call Mojo::IOLoop->remove($id), but that doesn't seem to completely remove it and I get error messages like Mojo::Reactor::Poll: Timer failed: Can't call method "is_websocket" on an undefined value.
If I call finish on the controller object to shut down the websocket, it seems to stop everything.
I have the entire Mojolicious::Lite app as a gist, but here's the parts where I
use feature qw(signatures);
no warnings qw(experimental::signatures);
## other boilerplate redacted
websocket '/find' => sub ( $c ) {
state $loop = Mojo::IOLoop->singleton;
app->log->debug( "websocket for find" );
$c->inactivity_timeout( 50 );
my $id;
$c->on( message => sub ( $ws, $message ) {
my $json = decode_json( $message );
my $command = $json->{c};
my $name = $json->{n};
app->log->debug( "Got $command command for $name" );
if( $command eq "start" ) {
$id = run_command( $ws );
app->log->debug( "run_command for $name returned [$id]" );
}
elsif( $command eq "stop" ) {
app->log->debug( "stopping loop for $name [$id]" );
# XXX What should I do here?
# $ws->finish;
# $loop->remove( $id );
}
elsif( $command eq "open" ) {
app->log->debug( "opening websocket for $name" );
}
}
);
$c->on(
finish => sub ( $c, $code ) {
app->log->debug("WebSocket closed with status $code");
}
);
};
app->start;
sub run_command ( $ws ) {
app->log->debug( "In run_command: $ws" );
open my $fh, "$^X -le '\$|++; while(1) { print int rand(100); sleep 3 }' |";
$fh->autoflush;
my $id;
$id = Mojo::IOLoop->recurring( 1 => sub ($loop) {
my $m = <$fh>;
unless( defined $m ) {
app->log->debug( "Closing down recurring loop from the inside [$id]" );
# XXX: what should I do here?
close $fh;
return;
};
chomp $m;
app->log->debug( "Input [$m] for [$id] from $fh" );
$ws->send( encode_json( { 'm' => $m } ) );
});
return $id;
}
Other questions that may benefit from this answer:
Output command to socket without buffering using Mojo::IOLoop
I played around with this a bit. Logioniz's answer made me think that I shouldn't be polling or handling the filehandle details myself. I still don't know where it was hanging.
Instead, I used Mojo::Reactor's io to set a filehandle to monitor:
sub run_command ( $ws ) {
my $pid = open my $fh, "$^X -le '\$|++; print \$\$; while(1) { print int rand(100); sleep 3 }' |";
$fh->autoflush;
my $reactor = Mojo::IOLoop->singleton->reactor->io(
$fh => sub ($reactor, $writeable) {
my $m = <$fh>;
chomp $m;
$ws->send( encode_json( { 'm' => $m } ) );
}
);
return ( $fh, $pid );
}
When I'm done with that command, I can unwatch that filehandle and kill the process. I finish the websocket:
elsif( $command eq "stop" ) {
$loop->reactor->watch( $fh, 0, 0 );
kill 'KILL', $pid or app->log->debug( "Could not kill $pid: $!" );
$ws->finish;
}
I still don't know why remove($fh) doesn't work. I figure I'm leaking some IOLoop things doing it this way.
I think that you block event loop because your recurrent invoke every second and my $m = <$fh>; wait result about 2-3 second. So you block event loop.
I think so because when i run your app the event finish not call on inactivity timeout, but call event recurrent. finish event MUST call on inactivity timeout always.
I think that your code must be in separate process to avoid blocking event loop.
Try to use this module to execute in separate process.
I write small example.
Note: This is a test perl code to check if works.
I have problem with my perl script, I know there's a solution for that by adding
print "Your server is not ok, please check!\n";
die "- Server is not ok!\n";
But in my project after stop in die "- Server is not ok!\n"; continue the script, I use print to show if works.
Heres the code
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new( timeout => 1 );
$ua->agent("007");
my $req = HTTP::Request->new( GET => 'http://www.google.com.ph/' );
my $res;
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
die "- Server is not ok!\n"; # I want to stop if server is not ok and print last code. Or other solution to stop instead of using die.
}
sleep 1;
}
print "Your server is not ok, please check!\n"; # Why this print not showing if stop in "- Server is not ok!\n"?
See image...
Other solution to stop? Intead using die to continue the perl script.
I hope someone will fixed this little problem, thanks for all reply!
for ( 1 .. 10 ) {
$res = $ua->request($req);
if ( $res->is_success ) {
print "+ Server is ok!\n";
}
else {
print "- Server is not ok!\n";
last; #this statement causes to exit the loop
}
sleep 1;
}
# at this point everything is oke
print "Your server is ok!\n";
First let me state, clamd has been proven to respond correctly:
$ echo PING | nc -U /var/run/clamav/clamd.sock
PONG
the scanner was setup as follows:
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
and the whole script works fine on a Solaris 11 box. I'm running this on a Linux CentOS 5.3 (Final) I did have a problem installing File::VirusScan from CPAN, the latest version 0.102 won't compile and CPAN testers seems to confirm this as 435 fails out of 437. So I downloaded the prev 0.101 version from CPAN, the version I'm also running in Solaris and manually installed apparently ok
perl -v
This is perl, v5.8.8 built for x86_64-linux-thread-multi
sub scanner {
$|++; # buffer disabled
(my $path, my $logClean) = #_;
my $recurse = 5;
print color "yellow";
print "[i] Building file scan queue - recurse deepth $recurse \n";
print color "green";
print "SCAN QUEUE:0";
#Get list of files
if( $rootPath){
use File::Find::Rule;
my $finder = File::Find::Rule->maxdepth($recurse)->file->relative->start("$$path");
while( my $file = $finder->match() ){
$|++;
#$file = substr($file,length($rootPath)); #remove path bloat
push(#scanList,"/$file");
print "\rSCAN QUEUE:" .scalar(#scanList); #update screen
}
}else{
push(#scanList,"$$path");
}
print "\rSCANING:0";
#set up a Clamav scanner
use File::VirusScan;
use File::VirusScan::ResultSet;
my $scanner = File::VirusScan->new({
engines => {
'-Daemon::ClamAV::Clamd' => {
socket_name => '/var/run/clamav/clamd.sock',
},
},
});
#scan each file
my $scanning = 0;
my $complete = -1;
foreach $scanFile (#scanList){
$scanning++;
##################################################
#scan this file
$results = $scanner->scan($rootPath.$scanFile);
##################################################
#array of hashes
my $centDone = int(($scanning/scalar(#scanList))*100);
if($centDone > $complete){
$complete = $centDone;
}
if($centDone < 100){
#\r to clear/update line
$format = "%-9s %-60s %-15s %-5s";
printf $format, ("\rSCANING:", substr($scanFile,-50), "$scanning/".scalar(#scanList), "$centDone%");
}else{
print "\rSCAN COMPLETE ";
}
# array ref
foreach $result (#$results) {
#array of pointers to hashes
#print 'data:'
#print 'state:'
if($$result{state} ne "clean"){
if($$result{data} =~ /^Clamd returned error: 2/){
$$result{data} = "File too big to scan";
}
push(#scanResults,[$scanFile,$$result{state},$$result{data}]); # results
}elsif($$logClean){
push(#scanResults,[$scanFile,$$result{state},$$result{data}]);
}
unless($$result{state} eq "clean"){
print color "red";
print "\r$scanFile,$$result{state},$$result{data}\n";
print color "green";
print "\rSCANING: $scanning/".scalar(#scanList)." : $centDone%";
if($$result{state} eq "virus"){
push(#scanVirus,scalar(#scanResults)-1); #scanResuts index of virus
}elsif($$result{state} eq "error"){
push(#scanError,scalar(#scanResults)-1); #scanResuts index of Error
}
}
}
} print "\n";
}
Looking at the source code for the Clamd package the following script should approximate the call it is attempting and will hopefully give you a better idea of how it's failing. Try saving it to a separate file (like test.pl) and run it using "perl test.pl":
use IO::Socket::UNIX;
use IO::Select;
my $socket_name = '/var/run/clamav/clamd.sock';
my $sock = IO::Socket::UNIX->new(Peer => $socket_name);
if(!defined($sock)) {
die("Couldn't create socket for path $socket_name");
}
my $s = IO::Select->new($sock);
if(!$s->can_write(5)) {
$sock->close;
die("Timeout waiting to write PING to clamd daemon at $socket_name");
}
if(!$sock->print("SESSION\nPING\n")) {
$sock->close;
die('Could not ping clamd');
}
if(!$sock->flush) {
$sock->close;
die('Could not flush clamd socket');
}
if(!$s->can_read($self->{5})) {
$sock->close;
die("Timeout reading from clamd daemon at $socket_name");
}
my $ping_response;
if(!$sock->sysread($ping_response, 256)) {
$sock->close;
die('Did not get ping response from clamd');
}
if(!defined $ping_response || $ping_response ne "PONG\n") {
$sock->close;
die("Unexpected response from clamd: $ping_response");
}
It looks like the various antivirus engines need to be installed separately from the File::VirusScan base library. Does the following return an error?
perl -mFile::VirusScan::Engine::Daemon::ClamAV::Clamd -e ''
If it displays an error that it can't locate Clamd.pm, you need to install that engine module.
If it doesn't display an error, you'll need to post more details, such as the code you're actually using to perform the scan and/or the error output (if any).
I am trying to write a Perl script using WWW-Mechanize.
Here is my code:
use DBI;
use JSON;
use WWW::Mechanize;
sub fetch_companies_list
{
my $url = shift;
my $browser = WWW::Mechanize->new( stack_depth => 0 );
my ($content, $json, $parsed_text, $company_name, $company_url);
eval
{
print "Getting the companies list...\n";
$browser->get( $url );
# die "Can't get the companies list.\n" unless( $browser->status );
$content = $browser->content();
# die "Can't get companies names.\n" unless( $browser->status );
$json = new JSON;
$parsed_text = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode( $content );
foreach(#$parsed_text)
{
$company_name = $_->{name};
fetch_company_info( $company_name, $browser );
}
}
}
fetch_companies_list( "http://api.crunchbase.com/v/1/companies.js" );
The problem is the follows:
I start the script it finishes fine.
I restart the script. The script fails in "$browser->get()".
I have to wait some time (about 5 min) then it will start working again.
I am working on Linux and have WWW-Mechanize version 1.66.
Any idea what might be the problem? I don't have any firewall installed either on computer or on my router.
Moreover uncommenting the "die ..." line does not help as it stopping inside get() call. I can try to upgrade to the latest, which is 1.71, but I'd like to know if someone else experience this with this Perl module.
5 minutes (300 seconds) is the default timeout. Exactly what timed out will be returned in the response's status line.
my $response = $mech->res;
if (!$response->is_success()) {
die($response->status_line());
}
This is target site issue. It shows
503 Service Unavailable No server is available to handle this
request.
right now.
Retry with wait, try this
## set maximum no of tries
my $retries = 10;
## number of secs to sleep
my $sleep = 1;
do {
eval {
print "Getting the companies list...\n";
$browser->get($url);
# die "Can't get the companies list.\n" unless( $browser->status );
$content = $browser->content();
# die "Can't get companies names.\n" unless( $browser->status );
$json = new JSON;
$parsed_text = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($content);
foreach (#$parsed_text) {
$company_name = $_->{name};
fetch_company_info( $company_name, $browser );
}
};
if ($#) {
warn $#;
## rest for some time
sleep($sleep);
## increase the value of $sleep exponetially
$sleep *= 2;
}
} while ( $# && $retries-- );