Setting up the alarm in threads with a message if timed out - perl

I'm refering to this question, but didn't want to post it there as it was half a year ago & its already answered.
I think that I need to set the alarm within the thread because it is listening for a connection (sockets) and I dont know what time to set for alarm until the client sents a command.
Short context: A clients sents a command which orders my script to run a selfwritten perl module. This module needs to be killed if it runs longer than it should. This "should" is very specific and will be written in the config file for each module.
I tried the alarm within a simple perl script and it worked quite well - even with my own message.
I am able to let the alarm quit the script, but it does not give me a message at all.
Used this example until I noticed that it may be different with threads.
Then I tried the Thread::alarm($time), but as I started with perl about 3 weeks ago I wasn't able to implement it correctly (it just does nothing. It does not even end the program).
Do you need any code to help or is there a site with examples that I could use and which I just did not find?

Did you already try AnyEvent?
AnyEvent let you setup watchers acting like timers:
# one-shot or repeating timers
my $w = AE::timer $seconds, 0, sub { ... }; # executed only once
my $w = AE::timer $seconds, $interval, sub { ... }; # executed every $interval
$seconds could be defined during the config phase, at thread start.
In callbacks you may use the same code that kills the program.
AnyEvent has its logging framework too AnyEvent::Log, which logs nothing by default, but you can enable some logging to see if it suits your needs about messages.

Related

PERL - Net::Websocket::Server with external periodic event

In my server program I need to have ability to iterate every 5 minutes through all opened connections and see which is really "active" or not.
I know that the best approach is to use "heart beat", but then, the server need to have somehow ability to check weather the connection is "off" in order to delete the associated "user parameters" that is attached to the connection.
My first approach was to use "Async" module, but this works in a separate process - so I cannot delete any element from the main process unless I use a technique to invoke a subroutine from the main process called from the child process (I don't know how, any help will be warmly welcomed).
Another possibility using Async is create a static client that is all the time on (also in the server) and sending "commands" to the server, but to me it looks "too exaggerating" to create such "wasting memory" client in the server, and also "eat" CPU time (I think much more than simple event like equivalent to "setTimeout" in JS).
Yet another approach is to use EV: But when I call EV::run it will NOT RUN anything ELSE than this "periodic event" - means that it will not reach the next line where the ->Start for the server is.
Placing it after the ->Start will make this event useless too: As the server works the program will not go behind the ->Start line.
Using EV::run EV::RUN_NOWAIT; will make the server work, but the EV will somehow not work, for a strange reason (Anyone know how can I still make it work?)
I prefer to not use Net::Websocket::EV, because as per their script, it doesn't do the handshake automatically, and many things (as well as SSL connection that I have) I will need to do manually and for me it is change a lot in my program.
PROBLEM SUMMARY:
How to make the code in EV run every 5 minutes, together with the server?
my %CON; # Connections (And user data) hash
my $__ConChk=EV::periodic 0, 300, 0, sub {
my #l=keys %CON;
for(my $i=0 ; $i<#l ; $i++) {
if($CON{$l[$i]}{"T"}+3600<time()) { # I give one hour time to be completely offline (for different reasons)
$CON{$l[$i]}{"C"}->disconnect(); delete $CON{$l[$i]};
}
}
};
EV::run EV::RUN_NOWAIT; # This is not working - Seems to be ignored!
Net::WebSocket::Server->new(
listen => $ssl, # Earlier preset
silence_max=>60, # Time to just shut the connection off, but don't delete user data
on_connect => sub {
my($serv,$conn)=#_;
my $cid; # Connection ID (for the hash)
$conn->on(
handshake => sub {
my($conn,$handshake)=#_;
# Create user data in $CON{$cid}
},
binary => sub {
$CON{$cid}{"T"}=time();
# Handling of single incomming message (command)
},
disconnect => sub {
# Do NOT DELETE THE ENTRY!! Maybe the connection drop due to instability!!
}
);
}
)->start; # This will run - but ignoring EV::run - what to do....?
undef $__ConChk;

Perl: Using alarms with Post request produces odd behaviour

Initial Question
I am trying use Perl to make a POST to a remote server. I am using an alarm to set a hard timeout. When the alarm triggers, I am getting what I would consider to be strange behaviour.
This is the code:
eval {
local $SIG{ALRM} = sub {
die("Foobar");
};
alarm 25;
my $userAgent = new LWP::UserAgent( keep_alive => 1 );
$answer = $userAgent->post( ... );
# During a timeout, I expect that this code will not run. However,
# it does and it prints "Foobar".
$m = $answer->message();
print $m;
alarm 0;
};
alarm 0;
print "Done";
Put a sleep (or breakpoint) on server, so it will not respond and so that the alarm will trigger. When the alarm triggers, this will be printed:
Foobar
Done
My expectation was that this should print:
Done
Key questions:
Why is this happening? Am I using some kind of anti-pattern? Is using alarms, not a good idea, because underlying libraries may use them as well, and they may conflict?
What is the right way to solve this problem?
Appendix 1 - I know there is another method...
I know that I should be using:
$userAgent->timeout( ... );
And actually, I am. However, I would like to set a hard timeout as well, so that I can ensure that at most I will spend 25 seconds waiting on the request. Since the timeout associated with $userAgent->timeout( ... ); is reset each time the client gets something back from the server, it is not reliable enough.
Appendix 2 - Environment Info
#bolav mentioned that on his system, he could not reproduce the issue, I guess that it is possible that it is System dependant.
OS:
cat /etc/redhat-release
CentOS release 6.6 (Final)
Perl Version:
This is perl, v5.6.1 built for i686-linux
Appendix 3 - Answers on SO suggesting to use this method
https://stackoverflow.com/a/15900249/251589

Forwarding AnyEvent::Log messages to a callback if certain requirements are met

I am working on a project that uses AnyEvent Log in the main program as well as several dependent modules/packages. I currently have each module writing to it's own context, and all contexts are added to the main programs context as slaves. This project is part of a much larger project, and in addition to writing out a local log file, there are certain messages that I would like to send to a remote program which will then be responsible for presenting the messages to users.
The problem is that in order to send to the remote program, I have to have a piece of information that is only available from the main program, so it's not feesible to just implement a method at the package level to send messages. The piece of information I need is more or less a transaction id, and the log messages are interesting events from a particular transaction.
The main program has 2 contexts ( main , secondary ). The messages I am interested in will either come from the secondary ctx OR one of the package/module contexts. I am interested in only sending info - crit level messages to users, but ONLY WHEN the txID exists in the main program. I ALWAYS want messages to be written to my local log file regardless of whether or not a deployment is running. I would like this to be something that I setup in the main program rather than in a module because the modules are tasked to do certain thing and shouldn't even be aware of the fact that there is an ID associated with the task at hand.
Here is a quick breakdown of the log configuration specific code in the main program.
# Immediately after Proc::Daemon::Init
my $logger = AnyEvent::Log::ctx "desman";
# configure is done before daemonization to allow for --nodaemon
sub configure {
my ( $level, $file ) = #_;
$AnyEvent::Log::FILTER->level($level);
$AnyEvent::Log::LOG->log_to_file($file);
}
sub log_event {
... logic to send messages as tx event ...
}
sub worker_init {
threads->create(sub {
$logger->attach( my $worklog = AnyEvent::Log::ctx "worker" );
... more stuff for worker specifics ...
});
}
Ideally, I would be able to use one or both of log_cb and fmt_cb to handle the formatting and sending of messages to the remote program using the log_event sub. I have tried a few different things, and so far I'm stuck.
# doesn't seem to do anything
$logger->fmt_cb( sub { ... } );
$logger->log_cb( sub { ... } );
# broke everything
$AnyEvent::Log::COLLECT->attach( my $evtlog = new AnyEvent::Log::Ctx
fmt_cb => \&event_formatter,
log_cb => \&log_event
);
$evtlog->levels('crit','warning','notice','info');
I've been searching around for more examples than what's in the docs, but haven't found much yet. Not much of a surprise there since AE::log is pretty much awesome as it is, but anything to help will be greatly appreciated.

How to run a background process with mod perl

I am using perl to return data sets in XML. Now I have come across a situation where I need to run some clean up after sending a dataset to the client. But some where, in the chain of mod perl and Apache, the output gets held onto until my method returns.
I have attempted to clear the buffers with commands like.
$| =1;
STDOUT->flush(); # flush the buffer so the content is sent to the client and the finish hook can carry on, with out delaying the return.
if ($mod_perl_io){
$mod_perl_io->rflush;
}
Yet I still get no output until my method returns. I then found out that my browser my be waiting for the connection to close and found that setting the content type in the header should fix this.
rint $cgi->header(-type => "text/plain; charset=UTF-8", -cookie => $config->{'cookie'});
Still no luck, in fact I had always been sending the correct headers.
So I though the best option is to simply start a new thread and let my method return. But when I create a new thread.
use threads ('yield',
'stack_size' => 64*4096,
'exit' => 'threads_only',
'stringify');
my $thr = threads->create('doRebuild', $dbconnect, $dbusername, $dbpassword, $bindir);
sub doRebuild {
my ($dbconnect, $dbusername, $dbpassword, $bindir ) = #_;
1;
}
I get a segfault
[Fri Feb 22 10:16:47 2013] [notice] child pid 26076 exit signal Segmentation fault (11)
From what I have read this is done by mod perl to ensure thread safe operation. Not sure if this is correct.
So I thought I'd try using {exe }
{exec 'perl', "$bindir/rebuild_needed_values.pl", qw('$dbconnect' '$dbusername' '$dbpassword');}
From what I gather this is taking over the process from mod perl and not letting it return anything.
I know this isn't as specific as a question on stack overflow should be, but this sort of thing must be a common problem how have others solved it?
You could use fork(), however I like to recommend http://gearman.org/ for background processing.
A solution like Gearman is much better, because your background process is not in Apache's process chain.
Your process will survive an Apache restart if implemented using gearman. It is also more secure, as the Gearman environment can be run in a chroot jail.
A nice side effect of using Gearman is that your background process becomes callable from other machines and even other languages.
Gearman makes it easy to collect the data from your process at a later time as well, and you can feed back progress information to your web app rather easily.

Perl IPC - FIFO and daemons & CPU Usage

I have a mail parser perl script which is called every time a mail arrives for a user (using .qmail). It extracts a calendar attachment out of the mail and places the "path" of the file in a FIFO queue implemented using the Directory::Queue module.
Another perl script which reads the path of the calendar attachment and performs certain file operations on the local system as well as on the remote CalDAV server, is being run as a daemon, as explained here. So basically this script looks like:
my $declarations
sub foo {
.
.
}
sub bar {
.
.
}
while ($keep_running) {
for(keep-checking-the-queue-for-new-entries) {
sub caldav_logic1 {
.
.
}
sub caldav_logic2 {
.
.
}
}
}
I am using Proc::Daemon for running the script as a daemon. Now the problem is, this process has almost 100% CPU usage. What are the suggested ways to implement the daemon in a more standard, safer way ? I am using pretty much the same code as mentioned in the link mentioned for usage of Proc::Daemon.
I bet it is your for loop and checking for new queue entries.
There are ways to watch a directory for file changes. These ways are OS dependent but there might be a Perl module that wraps them up for you. Use that instead of busy looping. Even with a sleep delay, the looping is inefficient when you can have your program told exactly when to wake up by an OS event.
File::ChangeNotify looks promising.
Maybe you don't want truly continuous polling. Is keep-checking-the-queue-for-new-entries a CPU-intensive part of the code, even when the queue is empty? That would explain why your processor is always busy.
Try putting a sleep 1 statement at the very top (or very bottom) of the while loop to let the processor rest between queue checks. If that doesn't degrade the program performance too much (i.e., if everyone can tolerate waiting an extra second before the company calendars get updated) and if the CPU usage still seems high, try sleep 2, sleep 5, etc.
cpan Linux::Inotify2
The kernel knows when files change and sends this information to your program which runs the sub. Maybe this will be better because the program will run the sub only when the file is changed.