ph713 has asked for the wisdom of the Perl Monks concerning the following question:

This simplified (and retested :) ) perl script is basically a thread-pooled tcp server. Think of it like how apache traditionally does things, but in perl, with threads, and not serving http. It starts up a pool of threads which try to accept() connections on a tcp socket, and manages them with some parameters to control the maximum number of threads, minimum idle threads, maximum idle threads, and maximum connections per thread before it recycles itself.

The problem I'm having is that as soon as a thread exits (recycles self after receiving RCVR_MAXCON connections), I start getting error messages of the form:

Attempt to free unreferenced scalar at /usr/lib/perl5/5.8.1/i586-linux-thread-multi/IO/Socket.pm line 46.

That part of IO::Socket is the line containting delete $arg{Timeout} in the new() function: 

sub new {
    my($class,%arg) = @_;
    my $sock = $class->SUPER::new();

    $sock->autoflush(1);

    ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};

    return scalar(%arg) ? $sock->configure(\%arg)
                        : $sock;
}

[download]
Any thoughts on what I'm doing wrong with the socket to generate these warnings? Other than the warnings themselves, the code seems to work as it's supposed to. (example scripts themselves moved to a comment below)

Replies are listed 'Best First'.
Re: Problems with a thread-pooled tcp server
by dave_the_m (Monsignor) on Jan 13, 2005 at 18:20 UTC
    Generally the 'attempt to free unrerefenced scalar' error is an indication of a bug in perl (or XS code). Threads in early versions of 5.8.x are well-known for these sorts of problems. Try upgrading to something newer (preferably 5.8.6) and see if the problem goes away.

    Dave.

[reply]
      Yes, that was the problem, thanks. I installed a copy of 5.8.6 locally in my home directory and ran it against that and the problem went away. For some reason I was just stuck on the idea that it must be my code, never thought about questioning perl itself :)
[reply]
Re: Problems with a thread-pooled tcp server
by ph713 (Pilgrim) on Jan 13, 2005 at 17:47 UTC
    Moving the example scripts here since it was spamming the main page, sorry :)

    The RCVR_MAXCON variable in the example script is set to 3 to make this happen much quicker. 

    #!/usr/bin/perl -w

use strict;
use threads;
use threads::shared;
use IO::Socket;

my $RCVR_MAXCON = 3; # Max connections a receiver will process before 
+recycling
my $MAXRCVR = 50; # Hard max limit
my $MINIDLE = 5; # Minimum idle threads
my $MAXIDLE = 10; # Maximum idle threads

# Shared receiver thread status hash
my %idle : shared;
my %busy : shared;
my $statchg : shared = 1;

# change status

sub setidle {
  my $tid = threads->self->tid;
  lock($statchg);
  delete $busy{$tid};
  $idle{$tid} = 1;
  $statchg++;
  cond_signal($statchg);
}

sub setbusy {
  my $tid = threads->self->tid;
  lock($statchg);
  delete $idle{$tid};
  $busy{$tid} = 1;
  $statchg++;
  cond_signal($statchg);
}

sub setdead {
  my $tid = threads->self->tid;
  lock($statchg);
  delete $idle{$tid};
  delete $busy{$tid};
  $statchg++;
  cond_signal($statchg);
}

sub receiver($) {
  my $lsock = shift;
  my $runcount = $RCVR_MAXCON;

  threads->self->detach;

  while($runcount > 0) {
    my $data;
    my $temp;
    setidle;
    my $conn = $lsock->accept;
    setbusy;
    while($conn->read($temp,16384)) { $data.=$temp; }
    print "Thread " . threads->self->tid . " received $data\n";
    $conn->close();
    $runcount--;
  }
  print "+++Thread " . threads->self->tid . " exiting after $RCVR_MAXC
+ON connections\n";
  $lsock->close;
  setdead;
}

# Create the tcp socket;
my $lsock = IO::Socket::INET->new ( Listen => 10,
                                LocalPort => 7676,
                                Proto => 'tcp',
                                Reuse => 1 ) || die $!;

while (1) {
  lock($statchg);
  cond_wait($statchg) until $statchg > 0;
  my $idlecount = scalar(keys %idle);
  my $busycount = scalar(keys %busy);
  my $total = $idlecount+$busycount;
  print "--Current-- Idle: $idlecount Busy: $busycount\n";
  if($total < $MAXRCVR && $idlecount < $MINIDLE) {
    print "--------- Adding 1 thread!\n";
    threads->create("receiver",$lsock) || die $!;
  } elsif($idlecount > $MAXIDLE) {
    print "--------- Killing 1 thread!\n";
    # kill 1 thread, unimplemented yet...
  }
  $statchg=0;
}

    [download]
    And here's a client script I use to stuff some connections at the server. I usually just fire off several in the background like: ./testclient & ./testclient & ./testclient & 
    #!/usr/bin/perl -w

use strict;
use IO::Socket;

while(my $sock = IO::Socket::INET->new("localhost:7676")) {
  print $sock "TEST";
  sleep 1;
  $sock->close;
}

    [download]
[reply]
[d/l]
[select]

      FYI: Your code appears to function as designed, without errors, when run under 5.8.5 and win32.

      I think dave_the_m called it right when he suggested you upgrade. Threads were still quite flakey in 5.8.1.

      Is there a particular reason for using a single scalar to guard both your shared hashes rather than locking the hash itself (or the element being accessed) individually?

      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.
[reply]

Back to Seekers of Perl Wisdom