ABSTRACT

The Proc::Forking.pm module provides a set of tool to fork and daemonize. The module fork a function code

SYNOPSIS

            #!/usr/bin/perl
    
            use strict;
            use Proc::Forking;
            use Data::Dumper;
            use Time::HiRes qw(usleep);    # to allow micro sleep
    
            my $f = Proc::Forking->new();
            $SIG{ KILL } = $SIG{ TERM } = $SIG{ INT } = sub { $f->killall_childs;sleep 1; exit },
                      $f->daemonize(
            ##              uid      => 1000,
            ##              gid      => 1000,
            ##              home     => "/tmp",
                          pid_file => "/tmp/master.pid"
                      );
    
            open( STDOUT, ">>/tmp/master.log" );
            my $nbr = 0;
            my $timemout;
    
            while ( 1 )
            {
                if ( $nbr < 20 )
            {
                    my $extra = "other parameter";
                    my ( $status, $pid, $error ) = $f->fork_child(
                        function => \&func,
                        name     => "new_name.##",
                        args     => [ "hello SOMEONE", 3, $extra ],
                        pid_file => "/tmp/fork.##.pid",
                        uid      => 1000,
                        gid      => 1000,
                        home       => "/tmp",
                        max_load   => 5,
                        max_mem    => 185000000,
                        expiration => 10,
            #           expiration_auto => 1,
                    );
                    if ( $status == 4 )    # if the load become to high
                    {
                        print "Max load reached, do a little nap\n";
                        usleep( 100000 );
                        next;
                    }
                    elsif ( $status )      # if another kind of error
            
                    {
                        print "PID=$pid\t error=$error\n";
                        print Dumper( $f->list_names() );
                        print Dumper( $f->list_pids() );
                    }
                }
                $nbr = $f->pid_nbr;
                my ( $n, @dp, @dn ) = $f->expirate;
                if ( $n )
                {
                    print Dumper( @dp );
                }
                print "free=<" . scalar( $f->getmemfree ) . ">\n";
                usleep( 100000 );    # always a good idea to put a small sleep to allow task swapper to gain some free resources
            }
            
            sub func
            {
                my $ref  = shift;
                my @args = @$ref;
                my ( $data, $time_out, $sockC ) = @args;
                $SIG{ USR1 } = sub { open my $log, ">>/tmp/log.s"; print $log "signal USR1 received\n"; close $log; };
                if ( !$time_out )
                {
                    $time_out = 3;
                }
                open my $FF, ">>/tmp/loglist";
                print $FF $$, " start time =", $^T;
                close $FF;
            
                for ( 1 .. 4 )
                {
                    open my $fh, ">>/tmp/log";
                    if ( defined $fh )
                    {
                        print $fh "TMOUT = $time_out  " . time . " PID=$$  cwd=" . Cwd::cwd() . " name =$0\n";
                        $fh->close;
                    }
                    sleep $time_out + rand( 5 );
                }
            }

REQUIREMENT

The Proc::Forking module need the following modules

        POSIX
        IO::File
        Cwd
        Sys::Load

METHODS

    The Fork module is object oriented and provide the following method

new

To create of a new pool of child:

        my $f = Proc::Forking->new();

fork_child

To fork a process

        my ( $status, $pid, $error ) = $f->fork_child(
              function        => \&func,
              name            => "new_name.$_",
              args            => [ "\thello SOMEONE",3, $other param],
              pid_file        => "/tmp/fork.$_.pid",
              uid             => 1000,
              gid             => 1000,
              home            => "/tmp",q
              max_load        => 5,
              max_child       => 5,
              max_mem         => 1850000000,
              expiration      => 20,
              expiration_auto => 1,
              strict          => 1,
              eagain_sleep    => 2,
              );
        

The only mandatory parameter is the reference to the function to fork (function => \&func) The normal return value is an array with: 3 elements (see RETURN VALUE)

function

    function is the reference to the function to use as code for the child. It is the only mandatory parameter.

name

    name is the name for the newly created process (affect new_name to $0 in the child). A ## (double sharp) into the name is replaced with the PID of the process created.

home

    the path provided will become the working directory of the child with a chroot. Be carefull for the files created into the process forked, authorizasions and paths are relative to this chroot

uid

    the child get this new uid (numerical value) Be carefull for the files created into the process forked, authorizations and paths are relative to this chroot

gid

    the child get this new gid (numerical value) Be carefull for the files created into the process forked, authorizations and paths are relative to this chroot

pid_file

    pid_file give the file containing the pid of the child (be care of uid, gid and chroot because the pid_file is created by the child) A ## (double sharp ) into the name is expanded with the PID of the process created

max_load

    if the "1 minute" load is greater than max_load, the process is not forked and the function will return [ 4, 0, "maximun LOAD reached" ]

max_child

    if the number of running child is greater than max_child, the process is not forked and the function return [ 5, 0, "maximun number of processes reached" ]

max_mem

    if the total free memory is lower than this value, the process is not forked and the function will return [ 15, 0, "maximun MEM used reached" ]

expiration

    it is a value linked with each forked process to allow the function expirate() to kill the process if it is still running after that expiration time The expiration value write in list_pids and list_names are this value (in sec ) + the start_time (to allow set_expiration to modify the value)

expiration_auto

    if defined, the child kill themselve after the defined expiration time (!!! the set_expiration function is not able to modify this expiration time)

strict

    if defined, the process is not forked if the NAME is already in process table, or if the PID_FILE id present and a corresponding process is still running

    BECARE, because the test is done before the fork, the NAME and the PID_FILE is not expanded with the child PID

eagain_sleep

    timeout between a new try of forking if POSIX::EAGAIN error occor ( default 5 second);

kill_child

        $f->kill_child(PID[,SIGNAL]);
 
 This function kill with a signal 15 (by default) the process with the provided PID.
 An optional signal could be provided.
 This function return the number of childs killed, a ref to a list of PID killed, a ref to a list of names killed.

killall_childs

        $f->killall_childs([SIGNAL]);

This function kills all processes with a signal 15 (by default). An optional signal could be provided. This function return the number of childs killed, a ref to a list of PID killed, a ref to a list of names killed.

list_pids

        my $pid = $f->list_pids;

This function return a reference to a HASH like

       {
          '1458' => {
                      'pid_file' => '/tmp/fork.3.pid',
                      'name' => 'new_name.3',
                      'home' => '/tmp',
                      'expiration' => '1105369235',
                      'start_time' => 1104998945
                    },
          '1454' => {
                      'pid_file' => '/tmp/fork.1.pid',
                      'name' => 'new_name.1',
                      'home' => '/tmp'
                    },
          '1456' => {
                      'pid_file' => '/tmp/fork.2.pid',
                      'name' => 'new_name.2',
                      'home' => '/tmp'
                    }
        };

The pid_file element in the HASH is only present if we provide the corresponding tag in the constructor fork_child Same for home element

list_names

        my $name = $f->list_names;

This function return a reference to a HASH like

          {
          'new_name.2' => {
                            'pid_file' => '/tmp/fork.2.pid',
                            'pid' => 1456,
                            'home' => '/tmp'
                            'expiration' => '1104999045',
                            'start_time' => 1104998945
                          },
          'new_name.3' => {
                            'pid_file' => '/tmp/fork.3.pid',
                            'pid' => 1458,
                            'home' => '/tmp'
                          },
          'new_name.1' => {
                            'pid_file' => '/tmp/fork.1.pid',
                            'pid' => 1454,
                            'home' => '/tmp'
                          }
        };

The pid_file element in the HASH is only present if we provide the corresponding tag in the constructor fork_child Same for home element

expirate

        my ($n, $dp, n ) =$f->expirate([signal])

This function test if child reach the expiration time and kill if necessary with the optional signal (default 15). In scalar context, this function return the number of childs killed. In array context, this function return the number of childs killed, a ref to a list of PID killed, a ref to a list of names killed.

get_expirate

        $f->get_expirate(PID)

This function return the expiration time for the PID process provided Be care!!! If called from a child, you could only receive the value of child forked before the child from where you call that function

set_expirate

        $f->set_expirate(PID, EXP)

This function set the expiration time for the PID process provided. The new expiration time is the value + the present time. This function is only useable fron main program (not childs)

getmemfree

        $f->getmemfree

In scalar context, this function return the total free memory (real + swap). In array context, this function return ( total_memory, real_memory, swap_memory).

pid_nbr

        $f->pid_nbr

This function return the number of process

clean_childs

        my (@pid_removed , @name_removed) =$f->clean_childs
        

This function return a ref to a list list of pid(s) and a ref to a list of name(s) removed because no more responding

test_pid

        my @state = $f->test_pid(PID);
        

In ARRAY context, this function return a ARRAY with the first element is the status (1 = running and 0 = not running) the second element is the NAME of process if the process with the PID is present in pid list and running In SCALAR contect, this function return the status (1 = running and 0 = not running)

test_name

        my @state = $f->test_pid(NAME);
        

In ARRAY context, this function return a ARRAY with the first element is the status (1 = running and 0 = not running) the second element is the PID of the process if the process with the NAME is present in name list and running. In SCALAR contect, this function return the status (1 = running and 0 = not running)

version

        $f->version;

Return the version number

daemonize

        $f->daemonize(
                uid=>1000,
                gid => 1000,
                home => "/tmp",
                pid_file => "/tmp/master.pid"
                name => "DAEMON"
                );
                

This function put the main process in daemon mode and detaches it from console All parameter are optional The pid_file is always created in absolute path, before any chroot either if home is provided. After it's creation, the file is chmod according to the provided uid and gig When process is kill, the pid_file is deleted

uid

    the process get this new uid (numerical value)

gid

    the process get this new gid (numerical value)

home

    the path provided become the working directory of the child with a chroot

pid_file

pid_file specified the path to the pid_file for the child Be carefull of uid, gid and chroot because the pid_file is created by the child)

name

    name is the name for the newly created process (affect new_name to $0 in the child). A ## (double sharp ) into the name is replaced with the PID of the process created.

RETURN VALUE

fork_child() constructor returns an array of 3 elements:

        1) the numerical value of the status
        2) th epid if the fork succeed
        3) the text of the status
        

the different possible values are:

        [ 0, PID, "success" ];
        [ 1, 0, "Can't fork a new process" ];
        [ 2, PID, "Can't open PID file" ];
        [ 3, PID, "Process already running with same PID" ];
        [ 4, 0, "maximun LOAD reached" ];
        [ 5, 0,  "maximun number of processes reached" ];
        [ 6, 0, "error in parameters" ];
        [ 7, 0, "No function provided" ];
        [ 8, 0  "Can't fork" ];
        [ 9, PID, "PID already present in list of PID processes" ];
        [ 10, PID, "NAME already present in list of NAME processes" ];
        [ 11, 0, "Can't chdir" ];
        [ 12, 0  "Can't chroot" ];
        [ 13, 0, "Can't become DAEMON" ];
        [ 14, PID, "Can't unlink PID file" ];
        [ 15, 0, "maximun MEM used reached" ];
        [ 16, 16, "Expiration TIMEOUT reached" ];
        [ 17, 16, "NO expiration parameter" ];
        [ 18, " Don't fork, NAME already present (STRICT mode enbled)" ];
        [ 19, " Don't fork, PID_FILE already present (STRICT mode enbled)" ];

EXAMPLES

        #!/usr/bin/perl
        
        use strict;
        use Proc::Forking;
        use Data::Dumper;
        use Cache::FastMmap;
        
        my $Cache = Cache::FastMmap->new( raw_values => 1 );
        my $f     = Proc::Forking->new();
        
        my $nbr = 0;
        my $timemout;
        my $flag = 1;
        $SIG{ INT } = $SIG{ TERM } = sub { $flag = 0; };
        
        while ( $flag )
        {
            if ( $nbr < 5 )
            {
                my $extra = "other parameter";
                my ( $status, $pid, $error ) = $f->fork_child(
                    function => \&func,
                    name     => "new_name.##",
                    args     => [ "hello SOMEONE", ( 300 + rand( 100 ) ), $extra ],
                    pid_file => "/tmp/fork.##.pid",
        #            uid      => 1000,
        #            gid      => 1000,
        #            home     => "/tmp",
        #            max_load => 5,
        #           max_mem => 1850000000,
        #            expiration_auto => 0,
                    expiration => 10 + rand( 10 ),
                );
                if ( $status == 4 )    # if the load become to high
                {
                    print "Max load reached, do a little nap\n";
                    usleep( 100000 );
                    next;
                }
                elsif ( $status )      # if another kind of error
                {
                    print "PID=$pid\t error=$error\n";
                }
            }
            $nbr = $f->pid_nbr;
            print "nbr=$nbr\n";   
            
            foreach ( keys %list )
            {
                my $val = $Cache->get( $_ );
                if ( $val )
                {
                    $Cache->remove( $_ );
                    $f->set_expiration( $_, $val );
                    print "*********PID=$_  val=$val\n";
                }
            }
            sleep 1;
        
           my ($n,@dp,@dn)=$f->expirate;
           if($n)
           {
              print Dumper(@dp);
           }
        }    
        
        
            
        sub func
        {
            my $ref  = shift;
            my @args = @$ref;
            my ( $data, $time_out, $sockC ) = @args;
            $SIG{ USR1 } = sub { open my $log, ">>/tmp/log.s"; print $log "signal USR1 received\n"; close $log; };
            $SIG{ USR2 } = sub { open my $log, ">>/tmp/log.s"; print $log "signal USR2 received for process $$ \n"; close $log; $Cache->set( $$, 123 ); };
            if ( !$time_out )
            {
                $time_out = 3;
            }
            
            open my $FF, ">>/tmp/loglist";
            print $FF "$$ free=<" . scalar( $f->getmemfree ) . ">\n";
            close $FF;
            
            while ( 1 )
            {
                open my $fh, ">>/tmp/log";
                if ( defined $fh )
                {
                    print $fh "$$ expiration=<" . $f->get_expiration . ">\n";
                    print $fh "TMOUT = $time_out  " . time . " PID=$$  cwd=" . Cwd::cwd() . " name =$0\n";
                    $fh->close;
                }
                sleep $time_out + rand( 5 );
            }
        }
        


    

TODO

  • May be a kind of IPC

  • A log, debug and/or syslog part

  • A good test.pl for the install

AUTHOR

Fabrice Dulaunoy <fabrice@dulaunoy.com>

15 July 2009

LICENSE

Under the GNU GPL2

    This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public 
    License as published by the Free Software Foundation; either version 2 of the License, 
    or (at your option) any later version.

    This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
    without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
    See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with this program; 
    if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

    Proc::Forking    Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 DULAUNOY Fabrice  Proc::Forking comes with ABSOLUTELY NO WARRANTY; 
    for details See: L<http://www.gnu.org/licenses/gpl.html> 
    This is free software, and you are welcome to redistribute it under certain conditions;