The Proc::Forking.pm module provides a set of tool to fork and daemonize. The module fork a function code
#!/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 ); } }
The Proc::Forking module need the following modules
POSIX IO::File Cwd Sys::Load
The Fork module is object oriented and provide the following method
To create of a new pool of child:
my $f = Proc::Forking->new();
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 is the reference to the function to use as code for the child. It is the only mandatory parameter.
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.
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
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
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 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
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" ]
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" ]
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" ]
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)
if defined, the child kill themselve after the defined expiration time (!!! the set_expiration function is not able to modify this expiration time)
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
timeout between a new try of forking if POSIX::EAGAIN error occor ( default 5 second);
$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.
$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.
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
my $name = $f->list_names;
{ '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' } };
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.
$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
$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)
$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).
$f->pid_nbr
This function return the number of process
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
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)
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)
$f->version;
Return the version number
$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
the process get this new uid (numerical value)
the process get this new gid (numerical value)
the path provided become the working directory of the child with a chroot
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 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.
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)" ];
#!/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 ); } }
May be a kind of IPC
A log, debug and/or syslog part
A good test.pl for the install
Fabrice Dulaunoy <fabrice@dulaunoy.com>
15 July 2009
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;
To install Proc::Forking, copy and paste the appropriate command in to your terminal.
cpanm
cpanm Proc::Forking
CPAN shell
perl -MCPAN -e shell install Proc::Forking
For more information on module installation, please visit the detailed CPAN module installation guide.