#!/usr/bin/perl5
#
# +---------------------------------------------------------------------+
# | sysdaemon-server                                                    |
# | Written By   : Trans-Euro I.T Ltd                                   |
# | Written On   : August 1st 1999                                      |
# |                                                                     |
# | Purpose        multi-spawning server for sysdaemon                  |
# |                sends sysdaemons message pipe to a client            |
# |                uses port 9001                                       |
# |                Do *NOT* run as root make the message pipe o+r       |
# |                                                                     |
# |                Modified to read sysdaemons config file              |
# +---------------------------------------------------------------------+
# | (c) 1999 This script is the intellectual property of                |
# | Trans-Euro I.T Ltd                                                  |
# +---------------------------------------------------------------------+  

BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }

require 5.002;

use strict;
use Socket;
use Carp;
use FileHandle;

my $program="sysdaemon-server";
my $version="1.20";

my $config=$ARGV[0];

if ( ! $config ) { print "useage: $program <config_file>\n";
                   exit 1; 
                 }

unless ( -s "$config") { die "$config is either missing or empty !!\n";}

$0=$program;

sub spawn;        # respawn ourselves
sub logmsg { print "$program $version: @_ at ", scalar localtime, "\n" } 

my $proto      = getprotobyname('tcp');
my $pipe       = "";
my $port       = "";
my $inport     = "";
my ($in)       = "";
my ($arg)      = ""; 
my $node       = "";
my $line       = "";

# +---------------------------------------------------------------------+  
# | Initialise internal variables from the config file                  |
# +---------------------------------------------------------------------+  

 open(CONFIG,"$config") || die "Cannot open configuration $config!\n";
     while($line=<CONFIG>) { 
       $line=~s/\012//g;
       $line=~s/\ {1,}//g;
         SWITCH: {
          if ($line =~ /^PIPE=/)  {(undef,$pipe)=split(/=/,$line)};
          if ($line =~ /^NODE=/)  {(undef,$node)=split(/=/,$line)};
          if ($line =~ /^PORT=/)  { (undef,$inport)=split(/=/,$line);};
                 }
                          }
    close(CONFIG);

$port = $inport;

logmsg( "$program starting" );
logmsg( "using pipe=$pipe"  );
logmsg( "using port=$port"  );
logmsg( "using node=$node"  );

# +---------------------------------------------------------------------+  
# | Check the program modules we need are present!                      |
# +---------------------------------------------------------------------+  


socket(Server, PF_INET, SOCK_STREAM, $proto) ||
       die "Cannot create socket\n";

setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ||
           die "Cannot set setsockopt\n";

bind(Server, sockaddr_in($port, INADDR_ANY)) || 
     die "Cannot bind to socket\n";

listen(Server,SOMAXCONN) ||
       die "Cannot listen\n";

logmsg "server started on port $port";

my $waitedpid = 0;
my $paddr;

sub REAPER { 
    $waitedpid = wait;
    $SIG{CHLD} = \&REAPER;  # if you don't have sigaction(2)
}
$SIG{CHLD} = \&REAPER;

for ( ; $paddr = accept(Client,Server); close Client) {
    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);
    logmsg "connection from $name [", 
            inet_ntoa($iaddr), "] at port $port";
    spawn sub { 
               # ---------------------------------------------- #
               # Within this sub routine place your handling code
               # ---------------------------------------------- #

               my $node=`/usr/bin/uname -n`;
                  $node=~ s/\012//g;
               my @pipeout="";

#               while (<Client>) {
               recv Server,$_,16,0;

               $in=$_;
               
               open(PIPE,"$pipe")||die "Cannot open $pipe!\n";
                @pipeout=<PIPE>;
               close(PIPE);

               for my $outline (@pipeout) {
                   $outline =~ s/\012//g;
                   send Client,"$node!$outline:^\r\n",0;
                                          }

                   send Client,"<EOM>\r\n",0;

               close(Client);exit;        
                      
               # ---------------------------------------------- #
#             };
                };}

sub spawn {
    my $coderef = shift;
    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { 
        confess "usage: spawn CODEREF";
    }
    my $pid;
    if (!defined($pid = fork)) {
        logmsg "cannot fork $program $version";
        return;
    } elsif ($pid) {
        logmsg "respawning $program $version $pid";
        return; # i'm the parent
    }
    # else i'm the child -- go spawn
    open(STDIN,  "<&Client")    or die "can't dup client to stdin";
    open(STDOUT, ">&Client")    or die "can't dup client to stdout";
    exit &$coderef();
}


