Perl IO::Socket timing problem

Question

I've bumped into a strange problem. I wrote a little daemon in Perl which binds a port on a server. On the same server there's a LAMP running and the client for my Perl daemon is a php file that opens a socket with the daemon, pushes some info and then closes the connection. In the Perl daemon I log each connection in a log file for later usage.

My biggest problem is the following: between the moment when the php script finishes its execution there are 15-20seconds until the daemon logs the connection.

PHP Client:

$sh = fsockopen("127.0.0.1", 7890, $errno, $errstr, 30);
if (!$sh) 
{
echo "$errstr ($errno)<br />\n";
} 
else 
{

    $out = base64_encode('contents');
    fwrite($sh, $out);
    fclose($sh);
}

Perl daemon (just the socket part)

#!/usr/bin/perl

use strict;
use warnings;
use Proc::Daemon;
use Proc::PID::File;
use IO::Socket;
use MIME::Base64;
use Net::Address::IP::Local;

MAIN:
{
#setup some vars to be used down...
if (Proc::PID::File->running())
        {
                exit(0);
        }


        my $sock = new IO::Socket::INET(
                        LocalHost => $ip,
                        LocalPort => $port,
                        Proto => 'tcp',
                        Listen => SOMAXCONN,
                        Reuse => 1);

        $sock or die "no socket :$!";
        my($new_sock, $c_addr, $buf);

for (;;) 
        {

                # setup log file 
                open(LH, ">>".$logs);

                print "SERVER started on $ip:$port \n";
                print LH "SERVER started on $ip:$port \n";

                while (($new_sock, $c_addr) = $sock->accept())
                {
                        my ($client_port, $c_ip) =sockaddr_in($c_addr);
                        my $client_ipnum = inet_ntoa($c_ip);
                        my $client_host =gethostbyaddr($c_ip, AF_INET);

                        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime time;
                        $year += 1900;
                        $mon += 1;
                        print "$year-$mon-$mday $hour:$min:$sec [".time()."] - got a connection from: [$client_ipnum]";

                        open(AL, ">>".$accessLog);
                        print AL "$year-$mon-$mday $hour:$min:$sec [".time()."] - got a connection from: [$client_ipnum]\n";
                        close AL;

                        while (defined ($buf = <$new_sock>))
                        {
                                print "contents:",  decode_base64($buf), " \n";
                                open(FH, ">".$basepath."file_" . time() .".txt")  or warn "Can't open ".$basepath."file_".time().".txt for writing: $!";
                                print FH decode_base64($buf);
                                close FH;
                        }
                }
                close LH;

        }

}

What is the thing that I do so wrong and then leads to 20seconds gap between php closing the socket after writing it and the Perl script logging the connection. Any idea? Be gentle, I'm new to Perl :)

Answer 1

I am not seeing any call to flush the buffer, could you check if the delay disappears when flushing after logging?

Answer 2

$new_sock is not closed explicitly, and so is not closed until the accept call. This might cause some things to hang until timeouts are hit. (I am not sure if the close will happen on entry to accept or exit from. )

Also, you are using the "<>" operator to read data from a socket. What happens if there are no newlines in the input ?

The best way to see what is actually happening is to run the process under "strace -e trace=network" and try to match up the network system call with the perl and php statements.