Net-Waiter

 view release on metacpan or  search on metacpan

lib/Net/Waiter.pm  view on Meta::CPAN

#
##############################################################################
package Net::Waiter;
use strict;
use POSIX ":sys_wait_h";
use IO::Socket::INET;
use Sys::SigAction qw( set_sig_handler );
use IPC::Shareable;
use Data::Dumper;

our $VERSION = '1.19';

$Data::Dumper::Terse = 1;
 
##############################################################################
            
sub new
{
  my $class = shift;
  $class = ref( $class ) || $class;
  
  my %opt = @_;
  
  my $self = { 
               PORT    => $opt{ 'PORT'    },         # which port to listen on
               PREFORK => $opt{ 'PREFORK' },         # how many preforked processes, 0 means forking server
               MAXFORK => $opt{ 'MAXFORK' } || 1024, # max count of forked processes
               NOFORK  => $opt{ 'NOFORK'  },         # foreground process
               TIMEOUT => $opt{ 'TIMEOUT' } || 4,    # timeout for accept(), default 4 seconds

               PX_IDLE => $opt{ 'PX_IDLE' } || 31,   # process exit idle, used in preforked processes
               
               PROP_SIGUSR => $opt{ 'PROP_SIGUSR' },

               DEBUG   => $opt{ 'DEBUG'   }, # debug level, true to enable or positive number for debug level
    
               SSL     => $opt{ 'SSL'     }, # use SSL
               OPT     => \%opt,
             };

  if( $opt{ 'SSL' } )
    {
    $self->{ 'SSL_OPTS' } = {};
    while( my ( $k, $v ) = each %opt )
      {
      next unless $k =~ /^SSL_/;
      $self->{ 'SSL_OPTS' }{ $k } = $v;
      }
    }

  my $pf = $self->{ 'PREFORK' };
  my $mf = $self->{ 'MAXFORK' };
  if( $pf < 0 )
    {
    # if PREFORK is negative, it will be absolute prefork and maxfork count
    $self->{ 'PREFORK' } = abs( $pf );
    $self->{ 'MAXFORK' } = abs( $pf ) unless $mf > 0;
    }

  # timeout cap
  $self->{ 'TIMEOUT' } =    1 if $self->{ 'TIMEOUT' } <    1; # avoid busyloop
  $self->{ 'TIMEOUT' } = 3600 if $self->{ 'TIMEOUT' } > 3600; # 1 hour max should be enough :)

  $self->{ 'PX_IDLE' } = 31 if $self->{ 'PX_IDLE' } < 1;
             
  bless $self, $class;
  return $self;
}

##############################################################################

sub run
{
  my $self = shift;

  $self->{ 'PARENT_PID' } = $$;

  if( $self->ssl_in_use() )
    {
    eval { require IO::Socket::SSL; };
    die "SSL not available: $@" if $@;
    };

  $SIG{ 'INT'   } = sub { $self->break_main_loop(); };
  $SIG{ 'TERM'  } = sub { $self->break_main_loop(); };
  $SIG{ 'CHLD'  } = sub { $self->__sig_child();     };
  $SIG{ 'HUP'   } = sub { $self->__sig_hup();       };
  $SIG{ 'USR1'  } = sub { $self->__sig_usr1();      };
  $SIG{ 'USR2'  } = sub { $self->__sig_usr2();      };
  $SIG{ 'RTMIN' } = sub { $self->__sig_kid_idle()   };
  $SIG{ 'RTMAX' } = sub { $self->__sig_kid_busy()   };

  srand();

  $self->on_server_begin();

  my $server_socket;

  my $sock_pkg;
  my %sock_opts;
  if( $self->ssl_in_use() )
    {
    my %sock_opts = %{ $self->{ 'SSL_OPTS' } };
    $sock_opts{ 'SSL_error_trap'  } = sub { shift; $self->on_ssl_error( shift() ); },
    $sock_pkg = 'IO::Socket::SSL';
    }
  else
    {
    $sock_pkg = 'IO::Socket::INET';
    }

  $server_socket = $sock_pkg->new(  
                                       Proto     => 'tcp',
                                       LocalPort => $self->{ 'PORT' },
                                       Listen    => 128,
                                       ReuseAddr => 1,
                                       Blocking  => 0,

                                       %sock_opts,
                                       );

  if( ! $server_socket )
    {
    # cannot open server port
    return 100;
    }
  else
    {
    binmode( $server_socket );
    $self->{ 'SERVER_SOCKET' } = $server_socket;
    $self->on_listen_ok();
    }

  $self->__reinstall_sha();

  while(4)
    {
    last if $self->{ 'BREAK_MAIN_LOOP' };
 
    if( $self->{ 'PREFORK' } > 0 )
      {
      $self->__run_prefork( $server_socket );
      sleep(4); # will be interrupted by busy/free signals
      }
    else
      {  
      $self->__run_forking( $server_socket );
      # no need for sleep since, select/accept will block for a while (4 sec)
      }

    eval
      {
      $self->__sha_lock_rw( 'MASTER STATS UPDATE' );

      $self->{ 'KIDS_BUSY'   } = 0;
      for my $cpid ( keys %{ $self->{ 'SHA' }{ 'PIDS' } } )
        {
        next unless $cpid > 0;
        if( ! exists $self->{ 'KID_PIDS' }{ $cpid } )
          {
          delete $self->{ 'SHA' }{ 'PIDS' }{ $cpid };
          }
        else
          {
          my $v = $self->{ 'SHA' }{ 'PIDS' }{ $cpid };
          my ( $b, $c ) = split /:/, $v;
          $self->{ 'KIDS_BUSY'  }++ if $b eq '*';
          }  
        }
      $self->{ 'STAT' }{ 'BUSY_COUNT' } = $self->{ 'SHA' }{ 'STAT' }{ 'BUSY_COUNT' };

      $self->__sha_unlock( 'MASTER STATS UPDATE' );
      };
    if( $@ )  
      {
      $self->log( "error: main loop kids stats management: $@" );
      $self->log( "status: reinstalling SHA, trying to recover..." );

      eval
        {
        $self->__sha_unlock( 'MASTER STATS UPDATE' );
        };
      # do not need result, if cannot be unlocked there is far bigger problem  

      $self->stop_all_kids( 'TERM' );
      $self->stop_all_kids( 'KILL' );
      sleep(1);
      
      $self->{ 'KIDS_BUSY'   } = 0;
      
      $self->__reinstall_sha();
      }
      
    }

  $self->stop_all_kids( 'TERM' );
  
  tied( %{ $self->{ 'SHA' } } )->clean_up();
  delete $self->{ 'SHA' };

  $self->on_server_close( $server_socket );
  close( $server_socket );

lib/Net/Waiter.pm  view on Meta::CPAN

    return '0E0';
    }

  my $client_socket = $server_socket->accept() or return '0E0';
  if( ! $client_socket )
    {
    $self->on_accept_error();
    return;
    }

  binmode( $client_socket );
  $self->{ 'CLIENT_SOCKET' } = $client_socket;

  my $peerhost = $client_socket->peerhost();
  my $peerport = $client_socket->peerport();
  my $sockhost = $client_socket->sockhost();
  my $sockport = $client_socket->sockport();

  $self->on_accept_ok( $client_socket );
  
  my $mf = $self->{ 'MAXFORK' };
  if( $mf > 0 and $self->{ 'KIDS' } >= $mf )
    {
    $self->on_maxforked( $client_socket );
    $self->on_close( $client_socket );
    $client_socket->close();
    return;
    }

  my $pid;
  if( ! $self->{ 'NOFORK' } )
    {
    $pid = fork();
    if( ! defined $pid )
      {
      die "fatal: fork failed: $!";
      }
    if( $pid )
      {
      $self->{ 'FORKS' }++;
      $self->{ 'KIDS'  }++;
      $self->{ 'KID_PIDS' }{ $pid } = 1;
      $self->on_fork_ok( $pid );
      $client_socket->close();
      next;
      }
    }
  # --------- kid here ---------
  $self->{ 'CHILD'  } = 1;
  delete $self->{ 'SERVER_SOCKET' };
  delete $self->{ 'KIDS' };
  delete $self->{ 'KID_PIDS' };

  # reinstall signal handlers in the kid
  $SIG{ 'INT'   } = sub { $self->break_main_loop();   };
  $SIG{ 'TERM'  } = sub { $self->break_main_loop();   };
  $SIG{ 'HUP'   } = sub { $self->__child_sig_hup();   };
  $SIG{ 'USR1'  } = sub { $self->__child_sig_usr1();  };
  $SIG{ 'USR2'  } = sub { $self->__child_sig_usr2();  };
  $SIG{ 'RTMIN' } = sub { $self->__sig_kid_idle()     };
  $SIG{ 'RTMAX' } = sub { $self->__sig_kid_busy()     };
  # ignored here, if smb needs it, should reinstall
  $SIG{ 'CHLD'  } = 'IGNORE';

  $self->{ 'SHA' } = new IPC::Shareable key => $self->{ 'SHA_KEY' } or die "fatal: cannot attach shared memory segment\n";

  srand();

  $client_socket->autoflush( 1 );
  $self->on_child_start();

  $self->im_busy();
  $self->on_process( $client_socket );
  $self->on_close( $client_socket );
  $client_socket->close();
  $self->im_idle();
  
  $self->on_child_exit();

  if( ! $self->{ 'NOFORK' } )
    {
    exit();
    }
  # ------- child exits here -------
}

my $__prefork_next_stat = time() + 4;
sub __run_prefork
{
  my $self          = shift;
  my $server_socket = shift;

  my $prefork_count = $self->{ 'PREFORK' };

  my $kk = $self->{ 'KIDS' };             # kids k'ount ;)
  my $bk = $self->get_busy_kids_count();  # busy count
  my $ik = $kk - $bk;                     # idle kids count

  my $tk = $prefork_count;
    #$tk = $kk + $prefork_count / 2 if $kk > $prefork_count and $ik < ( 1 + $prefork_count / 10 );
     $tk = $kk + $prefork_count if $ik <= ( 1 + $kk / 10 );

  my $mf = $self->{ 'MAXFORK' };
  $tk = $mf if $mf > 0 and $tk > $mf; # MAXFORK cap

  if( time() > $__prefork_next_stat )
    {
    $self->{ 'STAT' }{ 'IDLE_FREQ' }{ int( $ik / 5 ) * 5 }++ if $bk > 0;
    $self->__prefork_print_stat() if $self->{ 'DEBUG' };
    $__prefork_next_stat = time() + 4;
    }
  my $tbk = $self->{ 'STAT' }{ 'BUSY_COUNT' };
  $self->log_debug( "debug: kids: $kk   busy: $bk   idle: $ik   to_fork: $tk   will_fork?: $kk < $tk  total busy count: $tbk" );

  while( $self->{ 'KIDS' } < $tk )
    {
    my $pid;
    $pid = fork();
    if( ! defined $pid )
      {
      die "fatal: fork failed: $!";
      }
    if( $pid )
      {
      $self->{ 'FORKS' }++;
      $self->{ 'KIDS'  }++;
      $self->{ 'KID_PIDS' }{ $pid } = 1;
      $self->on_fork_ok( $pid );
      $self->{ 'STAT' }{ 'SPAWNS' }++;
      }
    else
      {
      # --------- child here ---------
      $self->{ 'CHILD'  } = 1;
      $self->{ 'SPTIME' } = time();
      delete $self->{ 'SERVER_SOCKET' };
      delete $self->{ 'KIDS' };
      delete $self->{ 'KID_PIDS' };

      # reinstall signal handlers in the kid
      $SIG{ 'INT'   } = sub { $self->break_main_loop();   };
      $SIG{ 'TERM'  } = sub { $self->break_main_loop();   };
      $SIG{ 'HUP'   } = sub { $self->__child_sig_hup();   };
      $SIG{ 'USR1'  } = sub { $self->__child_sig_usr1();  };
      $SIG{ 'USR2'  } = sub { $self->__child_sig_usr2();  };
      $SIG{ 'RTMIN' } = sub { $self->__sig_kid_idle()     };
      $SIG{ 'RTMAX' } = sub { $self->__sig_kid_busy()     };
      # ignored here, if smb needs it, should reinstall
      $SIG{ 'CHLD'  } = 'IGNORE';

      $self->{ 'SHA' } = new IPC::Shareable key => $self->{ 'SHA_KEY' } or die "fatal: cannot attach shared memory segment\n";
      
      srand();

      $self->on_child_start();
      
      $self->im_idle();

      my $kid_idle;
      while(4)
        {
        last if $self->{ 'BREAK_MAIN_LOOP' };
        last unless $self->__run_preforked_child( $server_socket );
        $kid_idle = $self->{ 'LPTIME' } > 0 ? time() - $self->{ 'LPTIME' } : - ( time() - $self->{ 'SPTIME' } );
        last if $self->{ 'LPTIME' } > 0 and $kid_idle > $self->{ 'PX_IDLE' };

        my $tt = $0;
        $tt =~ s/ \[-?\d+\]//;
        $0 = $tt . " [$kid_idle]";
        }
      $self->on_child_exit();

      exit;  
      # ------- child exits here -------
      }  
    }
}

sub __run_preforked_child
{
  my $self          = shift;
  my $server_socket = shift;

  if( ! socket_can_read( $server_socket, $self->{ 'TIMEOUT' } ) )
    {
    $self->on_prefork_child_idle();
    return '0E0';
    }

  my $client_socket = $server_socket->accept() or return '0E0';

  binmode( $client_socket );
  $self->{ 'CLIENT_SOCKET' } = $client_socket;

  my $peerhost = $client_socket->peerhost();
  my $peerport = $client_socket->peerport();
  my $sockhost = $client_socket->sockhost();
  my $sockport = $client_socket->sockport();

  $self->on_accept_ok( $client_socket );

  $self->{ 'BUSY_COUNT' }++;
  $self->im_busy();
  $client_socket->autoflush( 1 );
  my $res = $self->on_process( $client_socket );
  $self->on_close( $client_socket );
  $client_socket->close();
  $self->im_idle();

  $self->{ 'LPTIME' } = time(); # last processing time
  
  return $res;
}

sub __prefork_print_stat
{
  my $self = shift;

  eval
    {
    $self->__sha_lock_ro( 'MASTER SHARED STATE' );
    $self->log_debug( "debug: shared memory state:\n" . Dumper( $self->{ 'SHA' } ) );
    $self->__sha_unlock( 'MASTER SHARED STATE' );
    };
  if( $@ )  
    {
    $self->log_debug( "debug: stats unavailable" );
    return;
    }

  $self->log_debug( "debug: stats:\n" . Dumper( $self->{ 'STAT' } ) );

  my $_c = 10;
  for my $k ( sort { $self->{ 'STAT' }{ 'IDLE_FREQ' }{ $b } <=> $self->{ 'STAT' }{ 'IDLE_FREQ' }{ $a } } keys %{ $self->{ 'STAT' }{ 'IDLE_FREQ' } } )
    {
    my $v = $self->{ 'STAT' }{ 'IDLE_FREQ' }{ $k };
    $self->log_debug( sprintf( "debug: %3d idle(s) => %3d time(s)", $k, $v ) );
    last unless $_c--;
    }
}

sub stop_all_kids
{
  my $self = shift;

  my $sig = shift || 'TERM';
  
  my $wait_time = time();
  while( $self->{ 'KIDS' } and ( time() - $wait_time < 8 ) )
    {
    $self->log( "status: waiting current kids, sending $sig: " . $self->{ 'KIDS' } );
    $self->propagate_signal( $sig );
    sleep(1); # will be cancelled on SIGCHILD anyway...
    }
  
  return 1;  
}

##############################################################################

sub __reinstall_sha
{
  my $self = shift;

lib/Net/Waiter.pm  view on Meta::CPAN

#use Data::Tools;
sub __sha_lock_ro
{
  my $self = shift;
  return $self->__sha_obtain_lock( IPC::Shareable::LOCK_SH, 'SH' );
}

sub __sha_lock_rw
{
  my $self = shift;
  return $self->__sha_obtain_lock( IPC::Shareable::LOCK_EX, 'EX' );
}

sub __sha_unlock
{
  my $self = shift;
  return $self->__sha_obtain_lock( IPC::Shareable::LOCK_UN, 'UN' );
}


sub __sha_obtain_lock
{
  my $self = shift;
  my $op   = shift;
  my $str  = shift;
  
  my $limit = 4;
  my $rc;
  while( ! $rc )
    {
    $rc = tied( %{ $self->{ 'SHA' } } )->lock( $op );
    return $rc if $rc;
    next if $!{EINTR} or $!{EAGAIN};
    $self->log( "error: cannot obtain $str lock for SHA! [$rc] $! retry in 1 second" );  
    last if $self->{ 'BREAK_MAIN_LOOP' };
    last unless $limit--;
    sleep(1);
    }
  $self->log( "error: cannot obtain $str lock for SHA! $!" );  
  my $ppid = $self->get_parent_pid();
  die "error: [$ppid/$$] cannot obtain $str lock for SHA! $!, will exit\n";
  return undef;  
}

##############################################################################

sub get_server_socket
{
  my $self = shift;
  
  return exists $self->{ 'SERVER_SOCKET' } ? $self->{ 'SERVER_SOCKET' } : undef;
}

sub get_client_socket
{
  my $self = shift;
  
  return exists $self->{ 'CLIENT_SOCKET' } ? $self->{ 'CLIENT_SOCKET' } : undef;
}

sub get_busy_kids_count
{
  my $self = shift;
  
  return wantarray ? ( $self->{ 'KIDS_BUSY'  }, $self->{ 'KIDS'  } ) : $self->{ 'KIDS_BUSY'  };
}

sub get_kids_count
{
  my $self = shift;
  
  return $self->{ 'KIDS' };
}

sub get_parent_pid
{
  my $self = shift;
  
  return $self->{ 'PARENT_PID' };
}

sub get_kid_pids
{
  my $self = shift;

  return () if $self->is_child();
  
  return keys %{ $self->{ 'KID_PIDS' } || {} };
}

sub im_busy
{
  my $self = shift;
  
  return $self->__im_in_state( '*' );
}

sub im_idle
{
  my $self = shift;
  
  return $self->__im_in_state( '-' );
}

sub __im_in_state
{
  my $self  =    shift;
  my $state = uc shift;

  my $ppid = $self->get_parent_pid();
  return 0 if $ppid == $$; # states are available only for kids

  my $set_state = $state . ":" . $self->{ 'BUSY_COUNT' };

  $self->__sha_lock_rw( 'KID STATE' );
  $self->{ 'SHA' }{ 'PIDS' }{ $$ } = $set_state;
  $self->{ 'SHA' }{ 'STAT' }{ 'BUSY_COUNT' }++ if $state eq '*';
  $self->__sha_unlock( 'KID STATE' );

  my $tt = $0;
  $tt =~ s/ \| .+//;
  $0 = $tt . ' | ' . $set_state;
  
  return kill( 'RTMIN', $ppid ) if $state eq '-';
  return kill( 'RTMAX', $ppid ) if $state eq '*';
  return 0;
}

##############################################################################

sub break_main_loop
{
  my $self = shift;
  
  $self->{ 'BREAK_MAIN_LOOP' } = 1;
}

sub ssl_in_use
{
  my $self = shift;
  
  return $self->{ 'SSL' };
}

sub is_child
{
  my $self = shift;
  
  return $self->{ 'CHILD' };
}

lib/Net/Waiter.pm  view on Meta::CPAN

sub __sig_hup
{
  my $self = shift;

  $self->on_sig_hup();
  $SIG{ 'HUP ' } = sub { $self->__sig_hup();   };
}

sub __sig_usr1
{
  my $self = shift;

  $self->on_sig_usr1();
  $self->propagate_signal( 'USR1' ) if $self->{ 'PROP_SIGUSR' };
  $SIG{ 'USR1' } = sub { $self->__sig_usr1();  };
}

sub __sig_usr2
{
  my $self = shift;

  $self->on_sig_usr2();
  $self->propagate_signal( 'USR2' ) if $self->{ 'PROP_SIGUSR' };
  $SIG{ 'USR2' } = sub { $self->__sig_usr2();  };
}

sub __child_sig_hup
{
  my $self = shift;

  $self->on_child_sig_hup();
  $SIG{ 'HUP' } = sub { $self->__child_sig_hup();  };
}

sub __child_sig_usr1
{
  my $self = shift;

  $self->on_child_sig_usr1();
  $SIG{ 'USR1' } = sub { $self->__child_sig_usr1();  };
}

sub __child_sig_usr2
{
  my $self = shift;

  $self->on_child_sig_usr2();
  $SIG{ 'USR2' } = sub { $self->__child_sig_usr2();  };
}


# used only for waking up preforked servers main loop sleep
sub __sig_kid_idle
{
  my $self = shift;

  $SIG{ 'RTMIN' } = sub { $self->__sig_kid_idle()   };
}

# used only for waking up preforked servers main loop sleep
sub __sig_kid_busy
{
  my $self = shift;

  $SIG{ 'RTMAX' } = sub { $self->__sig_kid_busy()   };
}

##############################################################################

sub on_server_begin
{
}

sub on_listen_ok
{
}

sub on_accept_error
{
}

sub on_accept_ok
{
}

sub on_fork_ok
{
}

# called when connection is accepted and processing requested on socket data
sub on_process
{
}

# called on preforked childs, when accept timeouts
sub on_prefork_child_idle
{
}

# called on forking mode parent side, when noone connects in 'TIMEOUT' secods.
sub on_forking_idle
{
}

sub on_maxforked
{
}

# called right after fork, in the forked child, after initial setup but just before processing start
sub on_child_start
{
}

# called just before forked or preforked child exits
sub on_child_exit
{
}

sub on_close
{
}

sub on_server_close
{
}

lib/Net/Waiter.pm  view on Meta::CPAN

   PORT    => 9123, # which port to listen on
   PREFORK =>    8, # how many preforked processes
   MAXFORK =>   32, # max count of preforked processes
   NOFORK  =>    0, # if 1 will not fork, only single client will be accepted
   TIMEOUT =>    4, # timeout for accepting connections, defaults to 4 seconds
   SSL     =>    1, # use SSL

   PX_IDLE =>   31, # prefork exit idle time, defaults to 31

   PROP_SIGUSR => 1, # if true, will propagate USR1/USR2 signals to childs
   
   DEBUG   =>    1, # enable debug mode, prints debug messages

if PREFORK is negative, the absolute value will be used both for PREFORK and
MAXFORK counts.

if SSL is enabled then additional IO::Socket::SSL options can be added:

   SSL_cert_file   => 'cert.pem',
   SSL_key_file    => 'key.pem', 
   SSL_ca_file     => 'ca.pem',
   SSL_verify_mode => 1,

for further details, check IO::Socket::SSL docs. all SSL_ options are allowed.
   
=head2 run()

This executes server main loop. It will create new server socket, set
options (listen port, ssl options, etc.) then fork and call handlers along
the way.

Run returns exit code:

    0 -- ok
  100 -- cannot create server listen socket

=head2 break_main_loop()

Breaks main server loop. Calling break_main_loop() is possible from parent 
server process handler functions (see HANDLER FUNCTIONS below) but it will 
not break the main loop immediately. It will just raise flag which will stop 
when control is returned to the next server loop.

=head2 ssl_in_use()

Returns true (1) if current setup uses SSL (useful mostly inside handlers).

=head2 is_child()

Returns true (1) if this process is client/child process (useful mostly inside handlers).

=head2 get_server_socket()

Returns server (listening) socket object. Valid in parent only, otherwise returns undef.

=head2 get_client_socket()

Returns connected client socket.

=head2 get_busy_kids_count()

Returns the count of all forked busy processes (which are already accepted connection).
In array contect returns two integers: busy process count and all forked processes count.
This method is accessible from parent and all forked processes and reflect all processes.

Returns client (connected) socket object. Valid in kids only, otherwise returns undef.

=head2 get_kid_pids()

Returns list of forked child pids. Available only in parent processes.

=head2 propagate_signal( 'SIGNAME' )

Sends signal 'SIGNAME' to all child processes.

=head1 EVENT HANDLING FUNCTIONS

All of the following methods are empty in the base implementation and are
expected to be reimplemented. The list order below is chronological but the
most important function which must be reimplemented is on_process().

=head2 on_listen_ok()

Called when listen socket is ready but no connection is accepted yet.

=head2 on_accept_error()

Called if there is an error with accepting connections.

=head2 on_accept_ok( $client_socket )

Called when new connection is accepted without error.

=head2 on_fork_ok( $child_pid )

Called when new process is forked. This will be executed inside the server
(parent) process and will have forked (child) process pid as 1st argument.

=head2 on_process( $client_socket )

Called when socket is ready to be used. This is the place where the actual
work must be done.

=head2 on_prefork_child_idle

Called on preforked childs, when accept timeouts (see 'TIMEOUT' option).

=head2 on_forking_idle

Called on forking mode parent, when accept timeouts (see 'TIMEOUT' option).

=head2 on_maxforked( $client_socket )

Called if client socket is accepted but MAXFORK count reached. This can be
used to advise the situation over the socket and will be called right before
client socket close.

note: this handler is only used for FORKING server. preforked servers will
not accept the socket at all if MAXFORK has been reached. the reason is that
forking server may release child process during the accept() call.

=head2 on_child_start()