view release on metacpan or  search on metacpan

Forking.pm  view on Meta::CPAN

    my @param = @_;
    my $self  = shift @param;
    
    $SIG{ INT } = $SIG{ KILL } = $SIG{ TERM } = sub {    
    									$self->killall_childs;
  									unlink $DAEMON_PID;
									exit 0 ;
								};
    
    if ( @param % 2 )
    {
        return ( $CODE[6][0], 0, $CODE[6][1] );
    }
    my %param    = @param;
    my $uid      = exists( $param{ uid } ) ? $param{ uid } : '';
    my $gid      = exists( $param{ gid } ) ? $param{ gid } : '';
    my $home     = exists( $param{ home } ) ? $param{ home } : '';
    my $pid_file = $param{ pid_file } if exists( $param{ pid_file } );
    my $name     = $param{ name } if exists( $param{ name } );
    if ( defined( $name ) )
    {
        my $exp_name = $name;
        $exp_name =~ s/##/$$/g;
        $0 = $exp_name;
	my $main_process = new Sys::Prctl();
        $main_process->name( $0 );
    }

    my $child = fork;
    if ( !defined $child )
    {
        return ( $CODE[13][0], 0, $CODE[13][1] );
    }
    exit 0 if $child;    # parent dies;

    if ( exists( $param{ pid_file } ) )
    {
        $pid_file =~ s/##/$$/g;
        $DAEMON_PID = $pid_file;
        my @ret = create_pid_file( $pid_file, $$ );
        if ( $ret[0] )
        {
#             die "Another process is RUNNING\n";
	    carp "Another process is RUNNING\n";
	    return ( $CODE[3][0], 0, $CODE[3][1] ) ;
        }
    }

    my $luid = -1;
    my $lgid = -1;
    if ( $uid ne '' )
    {
        $luid = $uid;
    }
    if ( $gid ne '' )
    {
        $lgid = $gid;
    }
    chown $luid, $lgid, $pid_file;
    if ( $home ne '' )
    {
        local ( $>, $< ) = ( $<, $> );
        my $cwd = $home;
        chdir( $cwd )  || return ( $CODE[11][0], 0, $CODE[11][1] );
        chroot( $cwd ) || return ( $CODE[12][0], 0, $CODE[12][1] );
        $< = $>;
    }

    if ( $gid ne '' )
    {
        $) = "$gid $gid";
    }

    if ( $uid ne '' )
    {
        $> = $uid;
    }
    POSIX::setsid();
    open( STDIN,  "</dev/null" );
    open( STDOUT, ">/dev/null" );
    open( STDERR, ">&STDOUT" );
    chdir '/';
    umask( 0 );
    $ENV{ PATH } = '/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin';
    delete @ENV{ 'IFS', 'CDPATH', 'ENV', 'BASH_ENV' };
    $SIG{ CHLD } = \&garbage_child;
}

sub new
{
    my ( $class ) = @_;
    bless {
        _function        => $_[1],
        _args            => $_[2],
        _name            => $_[3],
        _pid             => $_[4],
        _pid_file        => $_[5],
        _home            => $_[6],
        _uid             => $_[7],
        _gid             => $_[8],
        _max_child       => $_[9],
        _max_load        => $_[10],
        _pids            => $_[11],
        _names           => $_[12],
        _max_mem         => $_[13],
        _expiration      => $_[14],
        _expiration_auto => $_[15],
        _start_time      => $_[16],
        _eagain_sleep    => $_[17],
#        _strict           => $_[17],
    }, $class;

}

sub fork_child
{
    my @param      = @_;
    my $self       = shift @param;
    my $start_time = time;