I have an app running under Catalyst+FastCGI. And I want it to fork() to do some work in background.
I used this code for plain CGI long ago (and it worked):
defined(my $pid = fork) or die "Can't fork: $!";
if ($pid) {
# produce some response
exit 0;
}
die "Can't start a new session: $!" if setsid == -1;
close STDIN or die $!;
close STDOUT or die $!;
close STDERR or die $!;
# do some work in background
I tried some variations on this under FastCGI but with no success. How should forking be done under FastCGI?
Update: This is what I have now:
defined(my $pid = fork) or die "Can't fork: $!";
if ($pid) {
$c->stash->{message} = 'ok';
$c->detach($c->view('JSON'));
}
die "Can't start a new session: $!" if setsid == -1;
close STDIN or die $!;
close STDOUT or die $!;
close STDERR or die $!;
# do some work, then exit()
I send the request with AJAX call, and have the "502 Bad Gateway" error in the firebug console.
I think this FAQ has the right answer:
https://fastcgi-archives.github.io/FastCGI_FAQ.html#Perlfork
You should do $request->Detach(); before the fork, and $request->Attach(); after the forking piece of code is done, where $request is the current FCGI object. At least, it worked for me.
In case of Catalyst::Engine::FastCGI you may need to patch the Catalyst::Engine::FastCGI to get access to the $request variable, since it is local to the run() method there (in the version that is currently on CPAN).
This part isn't going to work well with FastCGI:
if ($pid) {
# print response
exit 0;
}
You would exit in the parent process, thus it will stop responding to FastCGI requests.
The setsid()s and close()s are to daemonize your background process. This may or may not be necessary in your case.
Related
This works fine:
#!/usr/bin/perl -w
#
#pipe2 - use pipe and fork so child can send to parent
use IO::Handle;
pipe(READER, WRITER);
WRITER->autoflush(1);
if ($pid = fork) {
close WRITER;
chomp($line = <READER>);
print "Parent Pid $$ just read this: `$line'\n";
close READER;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close READER;
print WRITER "Child Pid $$ is sending this\n";
close WRITER; # this will happen anyway
exit;
}
But when I try to make the reader not block with fcntl as this:
use IO::Handle;
use Fcntl;
pipe(READER, WRITER);
WRITER->autoflush(1);
if ($pid = fork) {
close WRITER;
fcntl(fileno(READER),F_GETFL,$flags)
or die "Couldn't get flags for READER : $!\n";
$flags |= O_NONBLOCK;
fcntl(fileno(READER), F_SETFL, $flags)
or die "Couldn't set flags for READER $!\n";
chomp($line = <READER>);
print "Parent Pid $$ just read this: `$line'\n";
close READER;
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close READER;
print WRITER "Child Pid $$ is sending this\n";
close WRITER; # this will happen anyway
exit;
}
I get:
fcntl() on unopened filehandle 3 at pip2.pl line 14.
Couldn't get flags for READER : Bad file descriptor
I need to "watch" the child and do something if it doesn't respond properly within a specific time. I need async communications with the child.
fcntl(fileno(READER),F_GETFL,$flags)
fcntl gets a filehandle, not a file number. Use fcntl(READER,... not fcntl(fileno(READER), ....
Apart from that it is recommended to not use global symbols for file handles. Better use local variables, i.e.
pipe(my $reader, my $writer);
$writer->autoflush();
...
Apart from not being in potential conflict to other global symbols and avoiding risks of uncaught typos, this will also close the respective file handles ones the variable gets out of scope.
I have a piece of perl code that is roughly like this
my $pid = open(PIPE, '-|');
die "Unable to fork: $!\n" if !defined $pid;
if ($pid == 0)
{
open STDERR, '>&STDOUT' or die "Can't redirect STDERR to STDOUT\n";
exec(#cmd);
die "Unexpected exec failure: $!\n";
}
my #lines = (<PIPE>);
close PIPE;
if ($? != 0) { do stuff; }
However, for reasons I can't understand, possibly related to the actual program being called not existing, sometimes this fails to pick up the error from the child in $?
#lines contains the "Unexpected exec failure: File or directory does not exist" as expected (and some other output from a $SIG{__DIE__} handler), but $? is set to 0. I'm working round this for now by also checking the return from close which is fortunately set to 1. But where did my error code go?
I don't know. It shouldn't happen. You could use the following instead:
use IPC::Open qw( open3 );
my $pid = open3(local *PIPE, '>&STDOUT', undef, #cmd);
while (<PIPE>) {
...
}
waitpid($pid, 0);
Bonus: An error that occur while launching the child (e.g. an error from duping or from exec) throws an exception in the parent, so it doesn't look like the command ran and returned an error.
Well, I found what it was.
Someone had added an END{} block in a library that was destroying the return codes (by calling system and hence destroying $?). I backed out the change and everything was happy.
I want to redirect STDERR and STDOUT to a variable. I did this.
close(STDOUT);
close(STDERR);
my $out;
open(STDOUT, ">>", \$out);
open(STDERR, ">>", \$out);
for(1..10)
{
print "print\n"; # this is ok.
warn "warn\n"; # same
system("make"); # this is lost. neither in screen nor in variable.
}
The problem with system. I want the output of this call to be captured too.
use Capture::Tiny!
Are you seeking to capture the output in a variable? If so, you have use backticks or qx{} with appropriate redirection. For example, you could use:
#/usr/bin/env perl
use strict;
use warnings;
# Ensure we have a way to write messages
open my $fh, '>', "output" or die;
close(STDOUT);
close(STDERR);
my $out;
open(STDOUT, ">>", \$out) or do { print $fh, "failed to open STDOUT ($!)\n"; die };
open(STDERR, ">>", \$out) or do { print $fh, "failed to open STDERR ($!)\n"; die };
foreach my $i (1..10)
{
print "print $i\n";
warn "warn $i\n";
my $extra = qx{make pth$i 2>&1};
print $fh "<<$i>><<$out>><<$extra>>\n";
}
(I happen to have programs pth1, pth2 and pth3 in the directory - they were made OK; pth4 and above write errors to stderr; the redirection was necessary.)
You should always check the success of operations such as open().
Why is this necessary? Because writing to a variable requires the cooperation of the process doing the writing - and make doesn't know how to cooperate.
There are several ways to redirect and restore STDOUT. Some of them work with STDERR too. Here are my two favorites:
Using select:
my $out;
open my $fh, ">>", \$out;
select $fh;
print "written to the variable\n";
select STDOUT;
print "written to original STDOUT\n";
Using local:
my $out
do {
local *STDOUT;
open STDOUT, ">>", \$out;
print "written to the variable\n";
};
print "written to original STDOUT\n";
Enjoy.
The reason this is happening is that the STDOUT and STDERR "filehandles" are not equivalent to stderr and stdout handles provided by the shell to the perl binary. In order to achieve what you want, you should use open instead of system
Why not use IPC::Open3?
TLDR Answer
use Capture::Tiny;
Merged STDOUT and STDERR
If you want STDOUT (from print()s) and STDERR (from warn()s) to be merged, then use...
my ($merged, #result) = capture_merged { print "Hello, world!" }; # static code
my ($merged, #result) = capture_merged { eval $codetoeval }; # code in variable
Separated STDOUT and STDERR
If you want them separated...
my ($stdout, $stderr, #result) = capture { print "Hello, world!" }; # static code
my ($stdout, $stderr, #result) = capture { eval $codetoeval }; # code in variable
Results of Eval
#result indicates the success, with success being [1], and failure being []. Tiny has a ton of other functions that you can look through for other cases, like code references, etc.. But I think the code above should cover most of any Perl developer's needs.
I have a problem when I use Apache::DBI in child processes. The problem is that Apache::DBI provides a single handle for all processes which use it, so I get
DBD::mysql::db selectall_arrayref
failed: Commands out of sync; you
can't run this command now at
/usr/local/www/apache22/data/test-fork.cgi
line 20.
Reconnection doesn't help, since Apache::DBI reconnects in all processes, as I understood the following error
The server encountered an internal
error and was unable to complete your
request.
Error message: DBD driver has not
implemented the AutoCommit attribute
at
/usr/local/lib/perl5/site_perl/5.8.9/Apache/DBI.pm
line 283. ,
Here's the origin code:
use Data::Dumper 'Dumper';
use DBI ();
my $dbh = DBI->connect($dsn, $username, $password, {
RaiseError => 1,
PrintError => 0,
});
my $file = "/tmp/test-fork.tmp";
my $pid = fork;
defined $pid or die "fork: $!";
if ($pid) {
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
print "Content-Type: text/plain\n\n";
print $rows ? "parent: " . Dumper($rows) : $#;
}
else {
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
open FH, '>', $file or die "$file: $!";
print FH $rows ? "child: " . Dumper($rows) : $#;
close FH;
}
The code I used for reconnection:
...
else {
$dbh->disconnect;
$dbh = DBI->connect($dsn, $username, $password, $attrs);
my $rows = eval { $dbh->selectall_arrayref('SELECT SLEEP(1)') };
open FH, '>', $file or die "$file: $!";
print FH $rows ? "child: " . Dumper($rows) : $#;
close FH;
}
Is there a safe way to use Apache::DBI with forking? Is there a way to make it create a new connection perhaps?
I see a few options:
Explicitly close your DB handles when you fork, and reopen them as needed.
e.g.:
my $dbh = DBI->connect(...);
my $pid = fork;
defined $pid or die "fork: $!";
if ($pid) {
# parent...
}
else {
# child...
undef $dbh;
This could be made easier by storing the $dbh in an object, and passing around that object as needed to parts of your system. The object would be responsible for reopening the $dbh as needed, so the rest of the application doesn't have to concern itself with the details. Keep code encapsulated and well-separated from other parts of the system.
Don't use Apache::DBI. I can highly recommend DBIx::Connector, which opens a new connection as needed and doesn't preserve the bad behaviour of either plain DBI or Apache::DBI: see http://search.cpan.org/~dwheeler/DBIx-Connector-0.32/lib/DBIx/Connector.pm#Description for a detailed description of how it differs.
I use DBIx::Connector in my system inside a Moose object, which uses a method delegation to provide the dbh. The application simply does:
my $dbh = $db_dbj->dbh;
my $sth = $dbh->prepare(...);
# more boring DBI code here
...And the dbh is reconnected/regenerated as needed, invisibly.
As an aside, you should be really careful of using bare filehandles in a multiprocess environment. You could be very easily clobbering your data. open (my $fh, $file) or die "Cannot open $file: $!" is much safer.
I'm also a little nervous by seeing you using eval {} blocks without checking the contents of $#. You're just masking errors, rather than dealing with them, so there may be more things going on than you are aware of. Check your result values (or better, use an explicit exception-handling module, such as Try::Tiny. use use strict; use warnings;.
PS. I just noticed that you are explicitly including DBI in your code. Don't do that. If you use Apache::DBI in your startup_modperl.pl (or whatever you call your bootstrap file), you should never have to include DBI itself. I can't say for sure but I wouldn't be confident the right package is getting called (it's been a while since I looked at Apache::DBI's guts; it might take care of this for you though).
Don't fork under mod_perl2. Use Apache2::Subprocess. See also Is it a bad idea to fork under mod_perl2?
Say I have a resource (e.g. a filehandle or network socket) which has to be freed:
open my $fh, "<", "filename" or die "Couldn't open filename: $!";
process($fh);
close $fh or die "Couldn't close filename: $!";
Suppose that process might die. Then the code block exits early, and $fh doesn't get closed.
I could explicitly check for errors:
open my $fh, "<", "filename" or die "Couldn't open filename: $!";
eval {process($fh)};
my $saved_error = $#;
close $fh or die "Couldn't close filename: $!";
die $saved_error if $saved_error;
but this kind of code is notoriously difficult to get right, and only gets more complicated when you add more resources.
In C++ I would use RAII to create an object which owns the resource, and whose destructor would free it. That way, I don't have to remember to free the resource, and resource cleanup happens correctly as soon as the RAII object goes out of scope - even if an exception is thrown. Unfortunately in Perl a DESTROY method is unsuitable for this purpose as there are no guarantees for when it will be called.
Is there a Perlish way to ensure resources are automatically freed like this even in the presence of exceptions? Or is explicit error checking the only option?
I think that's what Scope::Guard was designed to help with.
#!/usr/bin/perl
use strict; use warnings;
use Scope::Guard;
my $filename = 'file.test';
open my $fh, '>', $filename
or die "Couldn't open '$filename': $!";
{
my $sg = Scope::Guard->new(
sub {
close $fh or die "Could not close";
warn "file closed properly\n";
}
);
process($fh);
}
sub process { die "cannot process\n" }
However, as #Philip notes in the comments, Scope::Guard utilizes the DESTROY method which creates some uncertainty as to when the scope exit code will be run. Modules such as Hook::Scope and Sub::ScopeFinalizer look fine as well although I have never used them.
I do like Try::Tiny for its clean interface and sheer simplicity and it will help you handle exceptions the correct way:
#!/usr/bin/perl
use strict; use warnings;
use Try::Tiny;
my $filename = 'file.test';
open my $fh, '>', $filename
or die "Couldn't open '$filename': $!";
try {
process($fh);
}
catch {
warn $_;
}
finally {
close $fh
and warn "file closed properly\n";
};
sub process { die "cannot process\n" }
My module Scope::OnExit is intended for exactly that.
The nice thing about lexical filehandles is that they'll get closed (and freed) when they go out of scope. So you can just do something like this:
{
# bare block creates new scope
open my $fh, "<", "filename" or die "Couldn't open filename: $!";
eval { process($fh) };
# handle exceptions here
close $fh or die "Couldn't close filename: $!";
}
# $fh is now out of scope and goes away automagically.