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;