This is starting to look pretty good from my testing. I like the -cev features. It seems to work without crashing, but I still see some kind of weird thread leakage. It isn't real bad, but somehow I don't like seeing "stray unused threads" in my ps list.

This is what I did to test.

I setup 3 clients, and started the server. Then I would kill off the clients in the reverse order of starting them up(3-2-1). Then I would check the output of socklist and ps auxww. I would repeat about 5 times without restarting the server. Sometimes I would get 3 extra threads in my ps list, even if all clients were killed. What is even more perplexing, is that if I occaisionally would kill off the clients in creation order(1-2-3), it would sometimes cleanup the stray threads and the socklist.

This is starting to work real nice otherwise, I couldn't crash the server.

One other minor thing, I had to add 192.168.0.0 to the allowed servers.

if ( $pAddr !~ /^127\.0\.0\./ 
&& $pAddr !~ /^10\.10\.10\.\d+/
&& $pAddr !~ /^192\.168\.0\.\d+/ )
[download]

In case it makes some difference, here is the client I'm using to test.

#!/usr/bin/perl -w
use strict;
use IO::Socket;

my ( $host, $port, $kidpid, $handle, $line );

( $host, $port ) = ('192.168.0.1',3333);

#this is for identifying chat if desired
#my $name = shift || ''; 
#if($name eq ''){print "What's your name?\n"} 
#chomp ($name = <>); 


# create a tcp connection to the specified host and port 
$handle = IO::Socket::INET->new(
    Proto    => "tcp",
    PeerAddr => $host,
    PeerPort => $port
  )
  or die "can't connect to port $port on $host: $!";
$handle->autoflush(1);    # so output gets there right away 
print STDERR "[Connected to $host:$port]\n";

# split the program into two processes, identical twins 
die "can't fork: $!" unless defined( $kidpid = fork() );

# the if{} block runs only in the parent process 
if ($kidpid) {

    # copy the socket to standard output 
    while ( defined( $line = <$handle> ) ) {
                      print STDOUT $line;
                      }
    kill( "TERM", $kidpid );    # send SIGTERM to child 
}

# the else{} block runs only in the child process 
else {

    # copy standard input to the socket 
    while ( defined( $line = <STDIN> ) ) {
        #print $handle "$name->$line"; 
        print $handle "$line";
    }
}
[download]

I did the testing as described above, but started the server with the -cev flags. What I notice centers around the portion of writer code which prints out the new Client indexes:

 
Writer MryZzHCZj8
        dies
        new Client indexes:3BMOliyMCT:0;3rNBRdpLo5:0;
[download]

What seems to be happening, is after I start the 3 clients, in order 1-2-3, if I kill client 1 first, then the 2 and 3, the new Client indexes gets reduced properly, with no clients in the index when all clients are dead. The socklist and ps list looks good

But if I kill client 2 or 3 first, that new Client index line dosn't even get printed, and when second client is killed, the new Client index gets printed, but with the extra client still in there. So then there is one client left in the index, with all clients killed.

I hope you know where this is being caused?

Hm,

I think, what you mean, comes up because of cond_signal(@chat) after the loop in Reader.

This way all the Writers are not called to 'work' on @chat. So even the Writer that has to die, waits until s.o. writes s.th. and only then it kills itself.

You may replace the cond_signal(@chat) after the Reader's loop by cond_broadcast(@chat). Now all Writers are called (for nothing) execpt the one that is going to die.

Another way to manage this may be to replace the kill-procedure. If the Client is killed, this was only registered by the Reader, thefore I came up with this solution, where the Writer (the problem-child) is doing the final suicide, so that I know both were gone.
But it may be better to put the killing-changes into the Reader and let the Writer die, if it could not find it's own ID in Elm. But again, because of con_wait(@chat) the Writer dies only after one Reader has put s.th. into @chat.
Therefor I put the cond_broadcast(@chat) in the last line of the Reader's run-method (right before ##: nothing). Problem solved?
Carl

Here is the alternative ChatServer:

#!/usr/bin/perl
# buffered Chat Server (build on the threaded chat server of Patric Ha
+ller)
# that does NOT echo the lines back to the
# Client where they are from. Therefore: $ID which is used in the loop
# of Reader and the Writer.
# Furthermore it doesn't do anything if there is only 1 Client.

use strict;
use warnings;
use threads;           # pull in threading routines
use threads::shared;   # and variable sharing routines
use IO::Socket::INET;  # and rock the sock et
use File::Temp qw/ :POSIX /;

#t: buffered, threaded Chat Server, options -cev:
our $p2Cons     = ( "@ARGV" =~ /^\-[ev]*c/i ) ? 1 : 0; #: (-c)  print 
+incomminge lines to console (used in Reader), default: no print to co
+nsole
our $e2Client = ( "@ARGV" =~ /^\-[cv]*e/i ) ? 1 : 0; #: (-e) echo inco
+mming lines back to Client (used Reader & Writer), default: no echo
our $verbose = ( "@ARGV" =~ /^\-[ec]*v/i ) ? 1 : 0; #: (-v) verbose mo
+de, default: not verbose, (for logging use: >> File.log)
if ( "@ARGV" =~ /\?|h/) {
    print "\nuse of this program:\n\t$0 [-celv]".
            "\n\t-c: print incomming lines to console,".
            "\n\t-e: echo incomming lines back to the client,".
            "\n\t-v: verbose mode\n\n";
    exit;
}

# internal Variables
our @chat:shared = ();    # buffer for incomming lines
# $Elm is used as hash, but the single Items cannot be protected by lo
+ck
# Therefore I choosed a string
our $Elm:shared = ''; #
our $NoClient:shared = 0; # No. of Clients connected
our $EOL = "\r\n";
# signal for the Writer to die,
# otherwise $NoClient and $Elm would be hard do admin.
tmpnam() =~ /.+mp\/(.+)/;
our $kill = $1.'  my Socket broke  '.$1; # to have a secure kill-code 
+(no matter how it looks like)

$SIG{PIPE} = 'ignore';   sub ignore { ; }
        #We ignore SIGPIPEs generated by clients trying to work
        #with closed connections. SIGPIPEs, if not handled, cause deat
+h.

    my $server = IO::Socket::INET->new(LocalPort => 3333, Type => SOCK
+_STREAM,
        Reuse => 1, Listen => 10) or die $!;

    while (my $client = $server->accept()){                     #forea
+ch $client
        my $pAddr = $client->peerhost();
        if ($pAddr !~ /^127\.0\.0\./ && $pAddr !~ /^10\.10\.10\.\d+/) 
+{
            print $client 'Sorry not for you..',$EOL;
            print "Ooops, who was that? Addr: $pAddr\n";
            close($client);
            next;
        }
        lock($NoClient);
        $NoClient++;
        cond_broadcast($NoClient);
        tmpnam() =~ /.+mp\/(.+)/;        # get a secure ID
        lock($Elm);                                # add this ID to $E
+lm
        $Elm .= "$1:0;";
        cond_broadcast($Elm);
        my $r  = threads->new(\&Reader::run, client => $client, "ID", 
+"$1", "Addr", $pAddr );
        $r->detach();
        my $w = threads->new( \&Writer::run, client => $client, "ID", 
+"$1" );
        $w->detach();
    }


#####
package Reader; #: detached process to receive the Client's Input
use threads;
use threads::shared;

sub new { #: create Reader
    my $pkg = shift; #: Package
    my $self = { @_ };
    return bless($self, $pkg); ##:  arr of blessed (self, pkg)
}
sub run { #: runs until the socket of this Reader dies; reads from the
+ socket and pushs it into @chat
    my $self = Reader->new(@_); #: Me
    my $socket = $self->{client}; #: The socket of the Client
    my $ID = $self->{ID}; #: The ID (same as for the Writer)
    my $Time = time;
    printf "$ID\t%12s has connected at %s\n",$self->{Addr}, scalar(loc
+altime($Time));
    my $l;

    while(defined ($l = <$socket>) ){
        # only 1 Client don't echo!
        print "$ID <\t$l" if $verbose;
        next if ($NoClient < 2 && (!$e2Client) );
        # skip empty lines: this may not work for everyone
        $l =~ /(.+)[\n\r]+/;
        if ($1) {
            lock(@chat);
            # add ID, so that the Writer knows what NOT to send => NO 
+echo!
            push @chat, "$ID\t$1";
            cond_broadcast(@chat);
        }
        print "$ID\t$1\n" if ($p2Cons);
    } # end while
    printf "$ID\t%12s  disconnected at %s  after %s\n",$self->{Addr}, 
+scalar(localtime(time)), s2T(time-$Time);
    print "Reader $ID\n\tI'm going to die, bye ..\n" if $verbose;
    lock($NoClient);
    lock($Elm);
    $l = ''; # used here as tmp
    foreach ( split /;/, $Elm ) {
        $l .= "$_;" if ( $_ !~ /^$ID\:/ && $_ =~/:/);
    }
    $Elm = $l;
    print "\tnew Client indexes:$Elm\n" if $verbose;
    $NoClient--;
    cond_broadcast($NoClient);
    cond_broadcast($Elm);
    cond_broadcast(@chat);
    ##: nothing
}
    sub s2T { #: calcs sec into days hh:mm:ss
        # my $dur = shift #: Duration in sec. transfrmd into Days hh:m
+m:ss
        ##: formated string [d]  hh:mm:ss
        if ( $_[0] > 86400 ) {
            my $ti = ( ($_[0]%86400)/3600 )%100;
            my $t = ($_[0]%86400) - ($ti*3600);
            return sprintf(" %i d %3i:%02i:%02i",
                        int($_[0] / 86400),$ti,(($t/60)%60),($t-((($t/
+60)%60)*60)));
        }
        my $ti = ( $_[0]/3600 )%100;
        my $t = $_[0] - ($ti*3600);
        return sprintf("%3i:%02i:%02i",$ti,(($t/60)%60),($t-((($t/60)%
+60)*60))); #: return fotmatted transcripted duration
    }


#####
package Writer; #: detached process to print to the socket for the cli
+ent
use threads;
use threads::shared;

sub new { #: create a Writer
    my $pkg = shift; #: Package
    my $self = { @_ }; #: Me
    return bless($self, $pkg); ##: arr of blessed (self, pkg)
}

sub run { #: runs until it gets the code to die from the Reader
    my $self = Writer->new(@_); #: Me
    my $socket = $self->{client}; #: Socket to the Client
    my $ID = $self->{ID}; #: The Writer/Readers ID
    my (%E, $min);

    while( 1 ) {

        lock(@chat);
        cond_wait(@chat);
        # shall I die?
        last if ( $Elm !~ /$ID:/ );
        lock($Elm);
        %E = (map { _split($_)  } (split /;/, $Elm));
        print "Writer $ID\n\tsends ",(($e2Client) ? ' ' : 'up to '),(@
+chat - $E{$ID})," lines from ",(scalar @chat)," of \@chat\n" if $verb
+ose;
        foreach ( @chat[$E{$ID} .. $#chat] ) {    # all before $E{$ID}
+ has been send by me
            /(.+?)\s(.+)[\n\r]*/;  # split into $ID and org. line
            # and send only the line ONLY if it is not from 'my' Reade
+r and it is not the kill-code
            if ($e2Client) {
                print $socket $2,$EOL if ( $2 ne $kill);
            } else {
                print $socket $2,$EOL if ( $1 ne $ID && $2 ne $kill);
            }
        }
        # now rewrite $Elm and Chat
        $E{$ID} = @chat;
        $min = min(values %E);
        #    print "deleting form chat-buffer:\n",(map { $_."\n" } @ch
+at[0 .. ($min-1)]),"\n" if $verbose;
        print "\tdelets from \@chat $min lines\n" if $verbose;
        @chat = @chat[$min .. $#chat];    # to eliminate all before $m
+in and keep the rest
        $Elm ='';                                         # to rewrite
+ $E
        foreach ( keys %E ) {
            $Elm .= "$_:".(($_ eq $ID) ? @chat : ($E{$_} - $min) ).';'
+;
        }
        print "\tnew \@chat, size: ",scalar @chat,";\n\tClient indexes
+:$Elm\n" if $verbose;
        cond_broadcast($Elm);

    } # end while
    print "Writer $ID\n\tdies too, ..\n" if $verbose;

    ##: nothing
}

    sub min { #: min of value-list
        # @_ =  #: LIST of values (int,float)
        my $m = shift;
        foreach (@_) { $m = $_ if $m > $_  }
        return $m; ##: min of list
    }

    sub _split { #: internal use to split a string 'key:item' into key
+ and item for a hash
        # my $_[0]  #: String to be splitted at ':'
        /(.+):(.+)/;
        return  ($1) ? ($1 => $2) : (); ##: pair Key => Item or an emp
+ty list
    }
[download]

Well,

2 little beautifying amandements:


1. to prevent a warning if you enable at line 117 cond_broadcast(@chat) just add

       lock(@chat);
   [download]

   right the line before.
2. to prevent that all Writers go through their writing loop, if a Reader makes the 'kill-broadcast' from the above mentioned line, enter

        next unless (@chat);
   [download]

   right after last if ($Elm ..); within the endless loop of the Writer.
Enjoy,
Carl