Perl is a powerful script language, not just do simple stuff, but also can do complex stuff too.
Lots of people have trouble to figure out parent process, child process, socket communication with client and  how to zombie a dead child process, etc..


Here is my example have everything in it. It's simplified from one of my heavy duty daemon, very robust. Defunct process free.

The main idea of it is that

Have a socket open for connection from client
Accept connection from client
Fork a child process
Handle the connection to child, then close parent process.
Child process can do whatever need to do with client
While parent process can deal with new connections.

Simplified Parent and Child process example code.

After fork, two identical processes created. By adding while loop to them, parent process can continue process upcoming client connections, while child process deal with each request.

if( !defined($pid = fork) ) {
   printf( "Cannot fork: $!\n" );
}
elsif( $pid ) { # parent process
   printf( "New server started with PID: $pid, will be recycled after it's reap\n" );
}
else { # else I'm the worker child
   # do real stuff here
   exit;
}

Reaper functionn example code

Here is reaper example, waitpid is called from a SIGCHLD handler, to reap the children as soon as they die. And use the WHOHANG flag to make waitpid immediately return 0 if there are no dead children. So that the parent process knows which and when a child die. A loop process is used to avoid the race situation that two or more child processes reach to reaper, for normally kernel keeps track of underlivered signals using a bit vector, one bit per signal.

sub REAPER
{
  my ($childpid,$ex);
  while (($childpid = waitpid(-1,WNOHANG) ) > 0 ) {
    $ex = $?;
    if( $ex ) {
      $ex = $ex/256;
    }
    if( $childpid == -1 ) {
      printf( "reaped a child's system command\n" );
    }
    else {
      printf( "PID $childpid: " . ($ex ? " (exit $ex)." : '.')."\n" );
    }
  }
  $SIG{CHLD} = \&REAPER;
  return;
}

Socket connection function

$proto = getprotobyname( 'tcp' );
socket( Server, PF_INET, SOCK_STREAM, $proto ) or printf( "socket: $!\n" );
setsockopt( Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1) ) or printf( "setsockopt: $!\n" );
bind( Server, sockaddr_in($g_port, INADDR_ANY) ) or printf( "bind: $!\n" );
listen( Server, SOMAXCONN ) or printf( "listen: $!\n" );

# set flushing
$| = 1;
  $paddr = accept( Client, Server );
  if( defined($paddr) ) {
    ($port,$iaddr) = sockaddr_in( $paddr );
    $name = gethostbyaddr( $iaddr, AF_INET );
    printf( "Connection from $name [".inet_ntoa($iaddr)."] at port $port\n" );
    $pid = getpid();
    syswrite( Client, "I'm main process $pid,I've got you connected, how are you! \n", $g_maxbuf) ;
  }

Putting things together

With checking and and verification, it comes up as a simple TCP server daemon script. Put your real business code into child process part. You have your own TCP server daemon!

It's a proved robust daemon, take a try, and drop me a question if you have.
Below is the whole simplified daemon in perl, put your real job in child part.

You can also download it from attached file.

#!/usr/bin/perl

#= PACKAGES / SETUP ===========================================================
use warnings;
use strict;

BEGIN {
  $ENV{ENV} = '';
  $ENV{PATH} = "/bin:/usr/bin:/sbin:/usr/sbin";
  @INC = (".", @INC);
}

use POSIX;
use Socket;

use lib qw(.);

#= CONSTANTS      =============================================================

#= GLOB VARIABLES =============================================================
## set defaults
our $g_port=12345;
my $g_maxbuf = 512 ;    ## need to get eventu. from config

#= SUBROUTINES ================================================================

###############################################################################
# SUB:
# PURPOSE:
#
# ARGS:
#
# NOTES:
# RETURNS:
###############################################################################
sub REAPER
{
  my ($childpid,$ex);
  while (($childpid = waitpid(-1,WNOHANG) ) > 0 ) {
    $ex = $?;
    if( $ex ) {
      $ex = $ex/256;
    }
    if( $childpid == -1 ) {
      printf( "reaped a child's system command\n" );
    }
    else {
      printf( "PID $childpid: " . ($ex ? " (exit $ex)." : '.')."\n" );
    }
  }
  $SIG{CHLD} = \&REAPER;
  return;
}

###############################################################################
# SUB:   SysWrite
# PURPOSE: systemwrite
#
# ARGS:
#
# NOTES:
# RETURNS:
###############################################################################
sub SysWrite
{
  my $res=$_[0] ;
  my $buf="" ;
  my $nr = 0 ;

  syswrite( Client, $res, $g_maxbuf) ;
  $res = 0 ;
  eval {
      local $SIG{ALRM} = sub { die "alarm\n" };       # NB \n required
      alarm 120 ;
      $nr = sysread( Client, $buf, $g_maxbuf );
      alarm 0 ;
     };
  die if $@ && $@ ne "alarm\n";       # propagate errors
    if ($@) {
      alarm 0;
      printf( "sysread time out , will be closed\n" );
      $res=6 ;
    }
  if( $nr <= 0 ) {
    if($res != 6 ) {
      $res = 5 ;
    }
  }
  else {
    if(!($buf eq "act" )) {
      $res = 1 ;
    }
  }
  return($res) ;
}

#= MAIN Section begins ========================================================

my( $proto, $pid, $paddr, $port, $iaddr, $name );

$proto = getprotobyname( 'tcp' );
socket( Server, PF_INET, SOCK_STREAM, $proto ) or printf( "socket: $!\n" );
setsockopt( Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1) ) or printf( "setsockopt: $!\n" );
bind( Server, sockaddr_in($g_port, INADDR_ANY) ) or printf( "bind: $!\n" );
listen( Server, SOMAXCONN ) or printf( "listen: $!\n" );

# set flushing
$| = 1;

$SIG{CHLD} = \&REAPER;

while( 1 ) {
  printf( "Ready to accept connection from client\n" );
  if ( -f "/tmp/stoptest" ) {
    last;
  }
  $paddr = accept( Client, Server );
  if( defined($paddr) ) {
    ($port,$iaddr) = sockaddr_in( $paddr );
    $name = gethostbyaddr( $iaddr, AF_INET );
    printf( "Connection from $name [".inet_ntoa($iaddr)."] at port $port\n" );
    $pid = getpid();
    syswrite( Client, "I'm main process $pid,I've got you connected, how are you! \n", $g_maxbuf) ;
    if( !defined($pid = fork) ) {
      printf( "Cannot fork: $!\n" );
    }
    elsif( $pid ) {
      printf( "New server started with PID: $pid, will be recycled after it's reap\n" );
      $pid = getpid();
      syswrite( Client, "parent feedback PID $pid,I've passed your connection to a child worker process, I'm closing connection.. bye bye!\n", $g_maxbuf) ;
      close Client ;
      sleep(0.1);
    }
    else {    # else I'm the worker child
      $pid = getpid();
      printf( "I'm child worker $pid, I'm trying to do something here for client!, please wait !\n" ) ;
      syswrite( Client, "I'm child worker $pid, trying to do something here for you, please wait !\n", $g_maxbuf) ;
      sleep 5;
      # do real stuff here
      syswrite( Client, "child worker $pid feedback, I'm closing connection.. bye bye!\n", $g_maxbuf) ;
      close Client ;
      exit 44;
    }
  }
  else {
     printf("message from pid $pid,see you !\n");
  }
  printf("here is after child,after sleep secs\n");
  my $current_pid = getpid();
  printf( "tracking main process $pid,$current_pid\n" ) ;
}
printf( "NOTE! daemon stopped! \n" ) ;
exit ( 0 ) ;

__END__

TEST run

$./simpledaemon.pl

Ready to accept connection from client

From another session, run

$telnet server 12345
Trying 192.168.1.1 ...
Connected to aaaa.
Escape character is '^]'.
I'm main process 10484,I've got you connected, how are you!
parent feedback PID 10484,I've passed your connection to a child worker process, I'm closing connection.. bye bye!
I'm child worker 10486, trying to do something here for you, please wait !

child worker 10486 feedback, I'm closing connection.. bye bye!
Connection closed by foreign host.

On daemon session , you will see the following message

Connection from client [192.168.1.1] at port 49948
New server started with PID: 10486, will be recycled after it's reap
here is after child,after sleep secs
tracking main process 10484,10484
Ready to accept connection from client
I'm child worker 10486, I'm trying to do something here for client!, please wait !
PID 10486:  (exit 44).
message from pid 10484,see you !
here is after child,after sleep secs
tracking main process 10484,10484
Ready to accept connection from client

 

 

 

 

 

 

Comments powered by CComment