Net-Waiter
view release on metacpan or search on metacpan
1. reinstalls shared memory and forked processes state if cannot lock
shared memory for 4 seconds. should not happen but sometimes external
agent may remove semaphores or shared memory segments... sadly happens.
2. added on_server_begin() hook.
1.15 2024-09-11
1. removed Time::HiRes dependency
2. wait for child processes to finish before removing shared memory
3. some debug messages removed
4. bring back rtmin rtmax busy idle signals
1.14 2024-09-08
1. fixed bug with shared memory locking logic
2. added more run-time stats
3. added log() and log_debug()
4. initial statistics, will be used for autotuning in the future
1.13 2024-07-02
2. added propagate_signal()
3. added separate signal USR1/2 handlers for parent/child processes. see:
on_sig_usr1()
on_sig_usr2()
on_child_sig_usr1()
on_child_sig_usr2()
1.09 2023.11.21
1. fixed busyloop
2. added timeout options
1.08 2023.10.04
1. changed accept socket to non-blocking
2. expanded shared memory to 1MiB (TODO: should be an option)
3. removed extra debug messages
1.07 2023.10.02
lib/Net/Waiter.pm view on Meta::CPAN
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;
}
##############################################################################
lib/Net/Waiter.pm view on Meta::CPAN
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() )
lib/Net/Waiter.pm view on Meta::CPAN
$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' );
lib/Net/Waiter.pm view on Meta::CPAN
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();
lib/Net/Waiter.pm view on Meta::CPAN
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 )
lib/Net/Waiter.pm view on Meta::CPAN
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();
lib/Net/Waiter.pm view on Meta::CPAN
$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;
}
lib/Net/Waiter.pm view on Meta::CPAN
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;
lib/Net/Waiter.pm view on Meta::CPAN
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;
lib/Net/Waiter.pm view on Meta::CPAN
# 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
{
lib/Net/Waiter.pm view on Meta::CPAN
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' )
( run in 0.247 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )