[TriLUG] help with Perl TCP server

[Wes Garrison via TriLUG]

Hi folks,

I need help with a Perl TCP server that I have listening for small JSON
messages.

It keeps "crashing" with the messages:
Use of uninitialized value in subroutine entry at
/usr/lib/x86_64-linux-gnu/perl/5.20/Socket.pm line 153.
Bad arg length for Socket::unpack_sockaddr_in, length is 0, should be 16 at
/usr/lib/x86_64-linux-gnu/perl/5.20/Socket.pm line 153.

(it's running as a daemon in Debian so it's not really "crashing", but the
service is stopping with a status of "active (exited)" every day or 2)

I am using the Perl TCP server from the Perl Cookbook
<http://docstore.mik.ua/orelly/perl3/cookbook/ch17_03.htm> with minimal
modification, so I'm not sure what is causing this.

It *looks *like $sock->peername is sometimes returning 0 or an undefined
value, but that shouldn't cause the whole service to die.
Line 153 of Socket.pm is:
 elsif (wantarray) {
        croak "usage:   (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
        unpack_sockaddr_in(@_); ### line 153
    }

The only references I can find to this error message are for a Perl bug
report for AmigaOS, which doesn't seem to apply here:
http://www.perlmonks.org/?node_id=1141502
https://rt.cpan.org/Public/Bug/Display.html?id=106797

I've been fighting with this for a while and I'm at a loss.

I've attached a stripped-down version of the server in case that helps.  (I
changed the file extension to .txt so malware filters won't flag it.)

Any insights would be greatly appreciated!

-Wes
_________________________________
Wesley S. Garrison
Network Engineer
Xitech Communications, Inc.
phone:  (919) 260-0803
fax:       (919) 932-5051
__________________________________
"Lead us not into temptation, but deliver us from email."
-------------- next part --------------
#!/usr/bin/perl -w
use strict;
use warnings;
use IO::Socket;
use DBI;
use JSON -support_by_pp;
 
my $dieNow        = 0;                                     # used for "infinte loop" construct - allows daemon mode to gracefully exit
my $sleepMainLoop = 1;                                    # number of seconds to wait between "do something" execution after queue is clear

until ($dieNow) {
	sleep($sleepMainLoop);
 
	my($server_socket, $sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO, $currentPoll);
	$MAXLEN = 1024;
	$PORTNO = 8531;
	
	$| = 1; ## auto flush on socket
	$server_socket = IO::Socket::INET->new(
	LocalHost => '0.0.0.0',
	LocalPort => $PORTNO,
	Proto => 'tcp',
	Listen => 5,
	Reuse => 1
	) or die "socket: $@";

	logEntry ("Awaiting TCP messages on port $PORTNO");
	
	while ($sock = $server_socket->accept()) {
		
		#### I put this check in to make sure the socket exists before I called $sock->peername or inet_ntoa($ipaddr)
		#### but maybe it's not necessary?
		if ($sock) {
			$sock->recv($newmsg, $MAXLEN);
		}
		else {
			next;
		}
		#########################################################

		my($port, $ipaddr) = sockaddr_in($sock->peername);
		$hishost = inet_ntoa($ipaddr);
		
		logEntry ($hishost ." said ". $newmsg);  ### debugging

		if (!($newmsg =~ /}/)) {
			(my $ICCID, $currentPoll, my $RSSI) = split(/,/,$newmsg);
			if (length($ICCID) == 20) {
				$newmsg = '{"msg":"get","ICCID":"'.$ICCID.'","RSSI":'.$RSSI.'}';	
			}
		}

		eval {
			my $json = new JSON;
			$newmsg = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($newmsg);		
			return 1;
		}	or do {
			logEntry ("Bad JSON, $hishost said ".$newmsg);
			$sock->send('{"error":"Bad JSON format!"}');
			shutdown($sock, 1);
			next;
		};

		#########################################################################
		### Make Database Calls and stuff here
		#########################################################################

		shutdown($sock, 1);

	} ### end while $sock is receiving data

	logEntry ("recv: $!");
	close($server_socket);

} ### end until receive $dieNow from service