Hi List
I have just been given the task of finding out why a perl sockets listener
application we have is no longer working correctly. The application was written
back in 2002 and I am told worked fine until we were forced to install a new
server early this year. I have no idea what version of perl the old server ran
but the new server is running 5.8.8.
The idea of the listener is to start and sit and wait for a connection. When the
connection occurs a child listener should be created. The child shgould take
care of receiving data and sending it onto a posgres database. After an idle
timeout the child should exit.
What is happening is when the child exits it is killing the parent process as
well. I am told that this did not happen on the previous server and the parent
process would stay running until the server needed a reboot or the process was
manually killed.
I am not very familiar with perl so I am asking the list for any guidance as to
where the script may be failing.
I am including the code for the listener below.
#!/usr/bin/perl
#
# Name: listener.pl
#
#
# Sub index:
# exCheckTrustedIP
# GetSock
# process_line
# ProcessRequests
# Reaper
# ServiceClients
# SetProperties
# StartDaemon
#
#
#-USE---------------------------------------------------------------------------
$debug = 1;
use IO::Socket;
use POSIX ":sys_wait_h"; # (for WNOHANG)
use Fcntl;
#-CONSTANTS---------------------------------------------------------------------
my ($SERVER_ADDR, $SERVER_PORT, $LISTENER, $DATABASE_NAME, $DATABASE_PORT,
$DATABASE_HOST, $USER_ID, $PASSWORD, $DATABASE_LOCATION, $MESSAGE_TIMEOUT,
$IDLE_TIMEOUT,) = "";
# Special cases are files and the associated database that they reside in.
# It is basically saying if you see this table name, regardles of the database
you are
# meant to be talking to (eg hack, dev), talk to the database specified. Was
introduced so that
# time records were always written to the "exodus' database.
# This could be moved at a later date to be read from an actual file.
# Note that the ip_access tables should also be in any database specified in the
# list.
# Format table_name =>
table_name,database_name,hostname,portname,user_id,password
%SPECIAL_CASES = '';
%SPECIAL_CASES =
(
ex_time => "ex_time:exodus:203.xxx.xxx.x:5432:xxxxxx:xxxxxxx",
time_control =>
"time_control:exodus:203.xxx.xxx.x:5432:xxxxxx:xxxxxxx"
);
sub StartDaemon
{
print "Listener started\n";
SetProperties($_[0]);
my $pid;
if ($pid = fork()) {
waitpid($pid, 0);
} else {
if ($pid = fork()) { exit; }
$0 = "$LISTENER: accepting connections on $SERVER_PORT"; # for ŽpsŽ
ServiceClients( GetSock() ); # wait for incoming requests
}
}
#-------------------------------------------------------------------------------
# Changes:
# 13AUG03 DT Created sub.
sub SetProperties
{
my %properties = GetAllSiteRecordValues($_[0]); # eg. $_[0] = "hack"
$SERVER_ADDR = $properties{"listener.server.addr"}; # eg. 203.xxx.xxx.x
$SERVER_PORT = $properties{"listener.server.port"}; # eg. 15555
$DATABASE_NAME = $properties{"listener.db.name"}; # eg. hack
$DATABASE_PORT = $properties{"listener.db.port"}; # eg. 5432
$DATABASE_HOST = $properties{"listener.db.addr"}; # eg. 203.xxx.xxx.x
$USER_ID = $properties{"listener.db.user.id"}; # eg. beanman
$PASSWORD = $properties{"listener.db.user.password"};
$MESSAGE_TIMEOUT = $properties{"listener.timeout.message"}; # eg. 30 # Max
pause WITHIN a MESSAGE (seconds)
$IDLE_TIMEOUT = $properties{"listener.timeout.idle"}; # eg. 600 # Max
Pause BETWEEN messages (seconds)
$LISTENER = $DATABASE_NAME. "_listener";
$DATABASE_LOCATION =
"dbname=$DATABASE_NAME;host=$DATABASE_HOST;port=$DATABASE_PORT";
return 1;
}
#-------------------------------------------------------------------------------
sub GetSock {
# unlink $sockname;
my $sock = IO::Socket::INET->new(
LocalPort => $SERVER_PORT,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10,
) or die "$0: error starting $LISTENER daemon on '$SERVER_PORT':
[EMAIL PROTECTED]";
# you might want to change permissions and ownership, e.g.:
#chmod 0600, $sockname;
#chown scalar getpwnam('nobody'), 0, $sockname;
return $sock;
}
#-------------------------------------------------------------------------------
sub ServiceClients {
my $sock = shift;
$SIG{CHLD} = \&Reaper;
my $client;
while ( $client = $sock->accept() ) {
my $pid = fork(); die "Cannot fork\n" unless defined $pid;
if ($pid) { # parent
close $client; # no use to parent
next; # be ready for another client
}
# child
close $sock; # no use to child
ProcessRequests($client);
exit; # terminate child
}
}
#-------------------------------------------------------------------------------
sub ProcessRequests {
my $sock = shift;
my ($inline, $outline) = "";
$| = 1; # don't buffer output - shouldn't need \n to print
$0 = "$LISTENER: child handling requests..."; # for ŽpsŽ
my $db_handle = &ex_open_pg_connection($DATABASE_LOCATION, $USER_ID,
$PASSWORD);
if (!$db_handle) {
exCloseWithError($sock, "Database error: Couldn't connect to database");
}
exCheckTrustedIP($db_handle, $sock);
# Set non-blocking IO (from O'Reilly Perl)
$flags = '';
fcntl($sock, F_GETFL, $flags) or die "Error: $!\n";
$flags |= O_NONBLOCK;
fcntl($sock, F_SETFL, $flags) or die "Error: $!\n";
# Read 8192 bytes at a time until hex 04 then start again
$buf = "";
$prev_message_time = time; # time last message was received.
$start_message_time = ''; # > null means partial message received
open (LOG, ">>/var/log/exodus/listener.log");
while (1) {
# Check how long its been since last message received
# If more than "IDLE_TIMEOUT" seconds then exit (terminate child
process)
# Attempt to read data into buffer.
$i = recv $sock, $buf, 8192, '';
if (!$buf) {
# No data received - check for errors and timeouts.
if ($i < -1) {
exCloseWithError($sock, "Internal error: TCP Error. Read()
returned: $i");
}
# Check whether message receive in progress - if so check for
timeout.
$cur_time = time;
if ($start_message_time) {
if ($cur_time > $start_message_time + $MESSAGE_TIMEOUT) {
exCloseWithError($sock, "Message timeout ($MESSAGE_TIMEOUT)
seconds. Please retry.");
}
} else {
# no message currently being received - check for how long it's
been quiet...
if ($cur_time > $prev_message_time + $IDLE_TIMEOUT) {
exCloseWithError($sock, "A timeout has occurred after
$IDLE_TIMEOUT seconds of inactivity. >> Connection closed.");
}
}
}
else
{
# Some data received - check what we got.
if (($eom_idx = (index $buf, "\x04")) > -1)
{
# End_Of_Message received. Finalize bigbuf - should now be
entire message string
$end_buf = substr($buf, 0, $eom_idx);
$bigbuf .= $end_buf; # should now be in form
chklenRMidRMdata
$outline = exProcessMessage($db_handle, $sock, $bigbuf);
print LOG "OUT:$outline\n";
printf $sock $outline;
$prev_message_time = time;
$bigbuf = substr($buf, $eom_idx+1);
$buf = "";
$start_message_time = ''; # NO message currently being
received
} else {
$start_message_time = time;
$bigbuf .= $buf;
$buf = "";
}
}
}
close LOG;
&ex_close_pg_connection ($db_handle);
}
#-------------------------------------------------------------------------------
# Checks if IP address at other end of socket is trusted, if not send error
# message to socket and exit.
sub exCheckTrustedIP
{
my ($db_handle, $sock, $debug) = @_;
# Get client IP address
my $other_end = getpeername($sock)
or die "$LISTENER: Couldn't identify other end: $!\n";
my ($port, $iaddr) = unpack_sockaddr_in($other_end);
my $ip_address = inet_ntoa($iaddr);
# Confirm that client IP is trusted - if full IP not in table, test on
subnet
my $read_ptr = ex_read_pg_data ($db_handle, "", "trusted_ips", "EQ",
$ip_address, "", "0", "", "");
my $found_ip = shift (@$read_ptr);
if ($found_ip)
{
send $sock, "OK: Successfully connected to $SERVER_ADDR:$SERVER_PORT -
Hello, $ip_address\n", '';
}
else
{
# Test subnet - IP up to last . then 0 eg 203.113.254.0
my $ip_last_dot = rindex ($ip_address, ".");
my $subnet = substr($ip_address, 0, $ip_last_dot+1)."0";
my $read_ptr = ex_read_pg_data ($db_handle, "", "trusted_ips", "EQ",
$subnet, "", "0", "", "");
my $found_sub = shift (@$read_ptr);
if ($found_sub) { send $sock, "OK: Successfully connected to
$SERVER_ADDR:$SERVER_PORT - Hello, $ip_address on subnet $subnet", ''; }
else { printf $sock "ERROR: $ip_address is not a trusted IP
address. Please contact Exodus Systems Support if you believe this IP should be
on our Trusted IP list."; }
}
}
#-------------------------------------------------------------------------------
# Sends error message to client, then closes socket and exits
sub exCloseWithError
{
my ($sock, $err_msg, $debug) = @_;
if ($debug) { print "exCloseWithError:ERROR: $err_msg"; }
print $sock "ERROR: $err_msg";
close $sock;
exit(1);
}
#-------------------------------------------------------------------------------
# Processes a complete XML message string. Performs several checks for message
# validity, then sends message to Host and returns output to client before
# returning control to calling code
sub exProcessMessage
{
my ($db_handle, $sock, $message, $debug) = @_;
my ($file) = '';
# Check for first record mark
$rm1idx = index ($message, $RM);
if ($rm1idx == -1) {
print $sock "No Record mark in string - require 2";
return;
}
$chk_len = substr($message, 0, $rm1idx);
$msg = substr($message, $rm1idx+1);
$msg_len = length($msg);
if ($msg_len != $chk_len)
{
print $sock "Checksum doesn't match - ensure message length sent is
correct: your length>$chk_len< and message length>$msg_len<";
return;
}
@records = split(/$RM/, $msg);
$action = shift (@records);
my $file = lc $records[0];
if ($action eq "W")
{
if ($SPECIAL_CASES{$file}) {$outline = exWriteSpecialCases($sock,
$db_handle, [EMAIL PROTECTED], $debug);}
else {$outline = exWriteToPG($db_handle, [EMAIL
PROTECTED], $debug); }
}
elsif ($action eq "M") { $outline = exProcessWebpayString([EMAIL
PROTECTED], $debug); }
else { $outline = "received action ->$action<-"; }
if ($debug) { Debug($outline, "outline", "", "", "connection response",
"T", "Y"); }
return $outline; #."\n"; # need \n for <socket> read to work...
}
#-------------------------------------------------------------------------------
sub Reaper {
while (waitpid(-1,WNOHANG) > 0) {}
$SIG{CHLD} = \&Reaper;
}
#-------------------------------------------------------------------------------
sub exWriteSpecialCases
{
my ($sock, $db_handle, $records_ptr, $debug) = @_;
my @records = @$records_ptr;
my $file = lc (shift (@records));
my $key = shift (@records);
my ($output) = "RESP:";
# @records should only have 1 element left now after having the first two
# shifted off
my @data = split (/\xFE/, $records[0]);
@data_location = split (/:/, $SPECIAL_CASES{$file});
my $DATABASE_LOCATION =
"dbname=$data_location[1];host=$data_location[2];port=$data_location[3]";
my $USER_ID = $data_location[4];
my $PASSWORD = $data_location[5];
my $db_handle = ex_open_pg_connection($DATABASE_LOCATION, $USER_ID,
$PASSWORD);
exCheckTrustedIP($db_handle, $sock);
$output .= &ex_write_pg_data($db_handle, "F", $file, $key, [EMAIL
PROTECTED], $debug);
# close (DEBUG);
ex_close_pg_connection ($db_handle);
return $output;
}
#-------------------------------------------------------------------------------
1; #return true
Regards,
Richard Luckhurst
Product Development
Exodus Systems - Sydney, Australia.
[EMAIL PROTECTED]
Tel: (+612) 4754-4774
Web: www.resmaster.com
=================================================
Exodus Systems - Smarter Systems, Better Business
=================================================
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/
