Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Perl daemon + fork + DBI persistent database connection

Posted on 2002-03-19
Medium Priority
Last Modified: 2007-12-19
I am running a simple daemon using libwww's HTTP::Daemon module.. Main code looks like this (I just deleted things that don't have to do anything with my question):

local $SIG{CHLD} = 'IGNORE';

# &connectDB should be executed here

  my $server;
  unless (defined $server) {
  $server = new HTTP::Daemon
        LocalAddr => $Config{'host'},
        LocalPort => $Config{'port'} || die "Can't start daemon!";

  while (my $connection = $server->accept) {

# Fork a child process for the connection (beginning of the child process)
     if (my $pid = fork) {

      while (my $request = $connection->get_request) {
# here's where the *magic* takes place      
      undef $connection;
# end of the child process

# &disconnectDB should be executed here


Well generally pretty simple. But now I want this daemon to have a persistent connection to a database using DBI.
I managed to do this with PostgreSQL by using "InactiveDestroy => 1" parameter. But I ran into some problems because after a few requests Postgres hangs up and dies producing zombies. This happens because of some sort of bug in libpq (if I understand correctly what is going on), but no one can really help me to fix this error (Backend message type 0x50 arrived while idle). So now I am trying to do the same thing with MySql which ignores this InactiveDestroy parameter and database connection gets lost after the child exits.
The code above should call procedure to connect to database before forking child process and then child process should execute some queries (*magic*) through this connection and then child should die but parent should stay connected to database. Postgres was working like this just fine but after a few requests that 0x50 error message arrived and all childs became zombies and didn't exit afterwards. But with MySql database connection is lost after first child has finished executing queries and exited.
What am I supposed to do?
I know that I can connect to database at the beginning of child and disconnect before child exits, but that solution is not any good for me - too slow and too much connections to database at once.
Question by:jakac
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2

Accepted Solution

Sapa earned 1000 total points
ID: 6880450
Hi jakac,

The main problem in you task  - you have opened only
one database connection, and pass it to several child
processes. In this case, several copies of client RDBMS
library send their request into one socket and cause
client-server protocol violation. You should open
several DBI connections in main process, pass one of
these connections into child process and mark it as
busy. The next child process should get another
DBI connection from pool of pre-opened ones. Also,
you should write SIGCHLD signal handler, to catch
child terminations, cleanup process table ('wait' function),
and mark corresponding DBI connection in pool as free.

But even in this case, it may cause some troubles if child
process will terminated before it read all answers from
DB connection socket. Also, some DB client libraries can
enumerate answers and replies and after child terminated,
the main process (and new child with reused connection too) will have internal state does not corresponding to
server side one.

The most correct solution is pre-fork several child processes, open one DB connection in each pre-forked
child process. It's fairly easy to implement. Just fork
_before_ the "while (my $connection = $server->accept) {"
line. For example:

sub child {
    my $server = shift;
    my $dbi = DBI->connect('...') or die $DBI::errstr;

    while(my $conn = $server->accept) {
       # Do not fork here!!!
       while (my $req = $conn->get_request) {
           # process all requests (may be more than one      
           # for keep-alive connections).
     undef $conn;

sub create_child {
    my $pid = fork;
    return $pid if $pid;
    child @_;
    exit 0;

my $server = new HTTP::Daemon
       LocalAddr => $Config{'host'},
       LocalPort => $Config{'port'}
} or die "Can't start daemon!";

create_child($server) foreach 1..10;

while ((my $pid = wait) > 0) {
    print STDERR, "Child process died. Spawn new one\n";

# -------------------- end --------------

Note, normally the child processes never dies. They get
connection, handle all requests from this connection, and
return to waiting for new connection (accept). Only one
child process, that is free at this moment (in accept waiting) will get new connection. If all processes are
busy now, the connection will be in kernel incoming connection queue until one of processes becomes free
and accept the new one. The "while(wait)" loop in main
process just collect childs died due to some programm errors and respawn new one. Of course it can do something
else, like watch how many child processes are busy and
enlarge processes pool if necessary. Just like Apache do.

good luck!



Author Comment

ID: 6882125
I have just another question for you before I accept Comment as answer (your answer is excellent!!). Before I modified my server using your code I was starting my server like ./server.pl start - that still works OK, writes a PID file so then ./server.pl stop kills that pid. Before everything was OK, but now if I look at the processes while server is running it looks like this:

jakac@ns:~/Server$ ps axj | grep server.pl
    1 13224 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13226 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13227 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13228 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13229 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13230 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13231 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13232 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13233 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13234 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
13224 13235 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start

Ok - so 13224 is parent and others are childs.. But if I do ./server.pl stop - code for this looks like this:

local (*PID);
while (my $line = <PID>) {
    if (! kill 9, $line) {
     print "Cannot kill process $line!\n";
    } else {
     print "Killed process $line.\n";

here's what happens:

jakac@ns:~/Server$ ./server.pl stop    
Killed process 13224.
jakac@ns:~/Server$ ps axj | grep server.pl
    1 13226 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13227 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13228 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13229 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13230 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13231 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13232 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13233 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13234 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start
    1 13235 13224 13224 ?           -1 S     1001   0:00 perl -w ./server.pl start

Parent is killed and all childs become parents and then I have to manually kill them... Any idea how to modify this "server.pl stop" function to kill all processes - parent and all childs?
BTW: Will increase question points before I accept your answer!

Expert Comment

ID: 6884181

I don't know what server.pid contains in. If it contains
parent PID only, you should kill process group instead of one process. Just send negative signal:

kill -9, $pid;

instead of:

kill 9, $pid;

If server.pid contains list of all PID's - parent and children, your code should works ok.


P.S. look 'perldoc -f kill' about negative signal values.

Author Comment

ID: 6884959
Thanx for your help!

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
Six Sigma Control Plans

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question