Chat client/server print failed

[deadpickle]

This is a chat client wrote in perl Gtk2. THe problem that I am
running into is that when you type and click send I get a "print() on
closed filehandle GEN0 at chat-client.pl line 332" error. This error
is the print statement in the send_msg_all sub. I cant figure out how
the file handle is closed and am wondering if anyone can see why. I'll
leave the server running for testing purposes.

# the Client:

#!/usr/bin/perl
# Flow of the Program:
# *Send message to the server - send_msg_all
# *Connect to the server - sub connect_server
# -unblock the server - nonblock
# -Login to the server - send_login
# -Timer started to wait for messages - wait_for_msg
# >Handler - handle
# $Process the incoming meswsages - process_incoming
# @Recieve messages and display in textview - rcv_msg

use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use IO::Socket::INET;
use Tie::RefHash;
use IO::Select;

#global variables
my $buffer;
my $host = "Deadpickle-hobo";
my $port = 6666;
my $conn_stat = 'idle';
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
my $select;
my $conn;
my $user;

#the main chat widget
my $main_window = Gtk2::Window->new("toplevel");
$main_window->signal_connect(delete_event => sub {Gtk2->main_quit;});
$main_window->set_default_size(250, 200);

my $table = Gtk2::Table->new(4, 2, FALSE);

$buffer = Gtk2::TextBuffer->new;
my $button = Gtk2::Button->new("Send");
my $entry = Gtk2::Entry->new();

my $label = Gtk2::Label->new("Chat Client Test");

my $textview = Gtk2::TextView->new_with_buffer($buffer);
$textview->set_cursor_visible (FALSE);
my $swindow = Gtk2::ScrolledWindow->new( undef, undef);
$swindow->set_policy( 'automatic', 'automatic');
$swindow->set_shadow_type( 'etched-out');

$swindow->add( $textview);

$table->attach_defaults($label, 0, 1, 0, 1);
$table->attach_defaults($swindow, 0, 2, 1, 3);
$table->attach_defaults($entry, 0, 1, 3, 4);
$table->attach_defaults($button, 1, 2, 3, 4);
$main_window->add($table);

$main_window->show_all();

$button->signal_connect("clicked" => sub { send_msg_all($entry-

get_text); $entry->set_text('');} );

#run the login dialog
dialog($buffer);

Gtk2->main;

#-------------------Login Dialog-------------------
sub dialog{
my $buffer = shift;

my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-

main_quit});

my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $dialog_label3 = Gtk2::Label->new('Host:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');

$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);

$dialog_button1->signal_connect("clicked" => sub {$user = $chat_user-

get_text; $dialog_window->destroy; $buffer->insert(($buffer-
get_end_iter), "Username: $user...\n"); connect_server()});

$dialog_window->add($dialog_table);

$dialog_window->show_all;

return 1;
}
#------------------Connect to server---------------------
#establishes connection to the server
sub connect_server{
if ($conn_stat ne 'connected') {
$buffer->insert(($buffer->get_end_iter), "Connecting to Server
$host:$port...\n");

$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);

if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
$buffer->insert(($buffer->get_end_iter), "Connected!\n");

#send login to server
send_login();

#start the timer that monitors incoming messages
my $timer_waiting = Glib::Timeout->add(100, \&wait_for_msg);

print "$conn\n";
}
}
}
#-------------------Error popup-------------------
# pops up an error message
sub popup_err{
my ($error_code) = @_;
my $error;

if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
elsif ($error_code == 6) {$error = "User Successfully Added!"}
elsif ($error_code == 7) {$error = "Error Registering User!"}
elsif ($error_code == 8) {$error = "Already Logged Out!"}
else {$error = "Unkown Error!"}

$buffer->insert(($buffer->get_end_iter), "$error\n");

my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-
with-parent', 'error', 'ok', "$error");

$error_dialog->run;
$error_dialog->destroy;
}
#-------------------blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);
}
#-------------------Message Waiting-------------------
# Wait for incoming messages from the server relayed from clients
sub wait_for_msg {

print "waiting\n";

if ($conn_stat eq 'connected') {
my ($list_size, $msg);
my $server;
my $rv;
my $data;

# check for new information on the connections we have
# anything to read or accept?
foreach $server ($select->can_read(1)) {
# read data
$data = '';
$rv = $server->recv($data, 'POSIX::BUFSIZ', 0);

unless (defined($rv) && length $data) {
# This would be the end of file, so close the client
delete $inbuffer{$server};
delete $outbuffer{$server};
delete $ready{$server};

$select->remove($server);
close $server;
next;
}

$inbuffer{$server} .= $data;

# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$server} =~ s/(.*\n)//) {

push( @{$ready{$server}}, $1 );
}
}

# Any complete requests to process?
foreach $server (keys %ready) {

handle($server);
}
}
}
#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$server}
# send output to $outbuffer{$server}
my $server = shift;
my $request;

foreach $request (@{$ready{$server}}) {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
process_incoming($server, $request);
}
delete $ready{$server};
}
#-------------------Process Incoming-------------------
sub process_incoming {
my ($server, $msg) = @_;
my @logged_users;

my @rcvd_msg = split(/::/, $msg);

if ($rcvd_msg[1] eq "1") {
# Login responses
# 12 = already logged on
# 03 = logged in

if($rcvd_msg[2] eq "03") {
print "Successfully Logged in!\n";
} elsif ($rcvd_msg[2] eq "12") {
popup_err(4);
} else {
# Create pop-up for error!
print "Error Logging in ", $msg, "\n";
popup_err(5);
}
} elsif ($rcvd_msg[1] eq "2") {
# register response
if ($rcvd_msg[2] eq "06") {
print "New user successfully registered!\n";
popup_err(6);
} elsif ($rcvd_msg[2] eq "02") {
print "$msg\n";
popup_err(4);
} else {
print "$msg\n";
popup_err(7);
}
} elsif ($rcvd_msg[1] eq "3") {
# quit response
print "$msg\n";
# $exit_cond = 0;
} elsif ($rcvd_msg[1] eq "4") {
# log out response
# 14 = user logged off
# 13 = user not logged in to begin with
print "$msg\n";
if($rcvd_msg[2] == 13) {
popup_err(8); # not logged in
}
# else {
# # clear the buddy list
# $list_size = $buddy_list->size;
# $list_size = $list_size - 1;
# $buddy_list->delete(0,$list_size);
# }
# $menu_file->update;
# } elsif ($rcvd_msg[1] eq "5") {
# # delete existing list of users
# $list_size = $buddy_list->size;
# if($list_size > 0) { $buddy_list->delete(0,$list_size); }
# # get users list response
# # if server response for proto 5 is 17 then Draw in
$buddy_list
# if ($rcvd_msg[2] == 17) {
# @logged_users = split (/ /, $rcvd_msg[3]);
# foreach (@logged_users) {
# $buddy_list->insert('end', "$_");
# }
# } elsif ($rcvd_msg[2] eq 18) {
# # generate error for login
# print "Please Log in to server first!\n";
# print "$msg\n";
# popup_err(51);
# } else {
# print "Unknown error updating buddy list:\n";
# print "$msg\n";
# popup_err(52);
# }
# $menu_file->update;
} elsif ($rcvd_msg[1] eq "6") {
# receive user message
# 13 - user not logged in
# 23 - buddy (target) not logged in
print "$msg\n";
rcv_msg($rcvd_msg[3], $rcvd_msg[4]);
# } elsif ($rcvd_msg[1] eq "7") {
# # receive global message
# print "$msg\n";
# rcv_msg_all($rcvd_msg[3], $rcvd_msg[4]);
# } elsif ($rcvd_msg[1] eq "8") {
# if ($rcvd_msg[2] == 23) {
# popup_err(81);
# } elsif ($rcvd_msg[2] eq "13") {
# popup_err(82);
# } else {
# # receive query information
# print "$msg\n";
# process_query($msg);
# }
# $menu_file->update;
} else {
print "Unrecognized response: $msg\n";
# popup_err(92);
exit(0);
}
# if($err) { print "ERROR: $err\n"; }
}
#-------------------Send message to all-------------------
sub send_msg_all {
my ($msg) = @_;

print "$conn\n";

if(defined $conn) {
# Send a the Message to server
print "Sending\n";
print $conn "7\:\:$user\:\:$msg\n";
} else {
popup_err(3);
}
}
#-------------------Send login-------------------
#logs the user name on the server
sub send_login {
# my ($u) = @_;

if(defined $conn) {
if(length($user) > 0) {
#send login to server
print $conn "1\:\:$user\n";
# update_info();
} else {
popup_err(2);
}
} else {
popup_err(3);
}
}
#-------------------Display Message-------------------
sub rcv_msg {
my ($from, $msg) = @_;

print "Received message from $from\n";
if(defined $conn) {
print "Already Connected: Proceeding with message!\n";
# $status->insert('end',"[$from]: $msg\n");
} else {
print "No connection established!\n";
popup_err(3);
}
}


The Server:

#!/usr/local/bin/perl
#
# SERVER PROTOCOLS
# 01 - Login ....... 1::username:asswd
# 02 - Register New User 2::username:asswd
# 03 - Terminate Program ....... 3::username:asswd
# 04 - Logoff Server 4::username:asswd
# 05 - Get Logged Users ....... 5::username:asswd
# 06 - Message another user
6::username:asswd::rcpt::message
# 07 - Global message ....... 7::username:asswd::message
# 08 - Query buddy 8::username:asswd::rcpt
# 09 - Update Buddy Info .......
9::username:asswd::Name::Email::Quote

use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;

$port = 6666;
my %hosts;

# Create Server
$server = IO::Socket::INET->new(LocalPort => $port,
Listen => 100 )
or die "Can't make server socket: $@\n";

print "Server created. Waiting for events...\n";

# begin with empty buffers
%inbuffer = ();
%outbuffer = ();
%ready = ();

tie %ready, 'Tie::RefHash';

nonblock($server);
$select = IO::Select->new($server);

# Main loop: check reads/accepts, check writes, check ready to process
while (1) {
my $client;
my $rv;
my $data;

# check for new information on the connections we have

# anything to read or accept?
foreach $client ($select->can_read(1)) {

if ($client == $server) {
# accept a new connection
$client = $server->accept();
$select->add($client);
nonblock($client); #subroutine
} else {
# read data
$data = '';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);

unless (defined($rv) && length $data) { #Runs the
bottom statement unless it is true
# This would be the end of file, so close the client
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};

$select->remove($client);
close $client;
next;
}

$inbuffer{$client} .= $data; #add the recieved data
to the inbuffer

# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
# Disceting the matching variable:
# =~: between variable and and regular expression
# s/PATTERN//REPLACEMENT/: searchs the string for the
pattern then replaces it with the replacement text
# (.*\n):
# . match any character except newline
# * match zero or more times
# \n newline
while ($inbuffer{$client} =~ s/(.*\n)//) { #If there is
data in the inbuffer; searches for a string with a newline at the end
push( @{$ready{$client}}, $1 ); # $1 is the matched
string that is added the the hash/array %ready; this must be the
REFHASH
}
}
}

# Any complete requests to process?
foreach $client (keys %ready) { #calls the refhash keys
handle($client); #subroutine
}

# Buffers to flush?
foreach $client ($select->can_write(1)) { #see what clients are
ready to be wrote to
# Skip this client if we have nothing to say
next unless exists $outbuffer{$client}; #run the next
iteration unless the outbuffer exists

$rv = $client->send($outbuffer{$client}, 0);
unless (defined $rv) { #run the statement unless $rv is
defined
# Whine, but move on.
warn "I was told I could write, but I can't.\n";
next;
}
if ($rv == length $outbuffer{$client} ||
$! == POSIX::EWOULDBLOCK) {
substr($outbuffer{$client}, 0, $rv) = '';
delete $outbuffer{$client} unless length
$outbuffer{$client};
} else {
# Couldn't write all the data, and it wasn't because
# it would have blocked. Shutdown and move on.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};

$select->remove($client);
close($client);
next;
}
}

# Out of band data?
foreach $client ($select->has_exception(0)) { # arg is timeout
# Deal with out-of-band data here, if you want to.
print "DEBUG ME!\n";
}
}
#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$client}
# send output to $outbuffer{$client}
my $client = shift;
my $request;

foreach $request (@{$ready{$client}}) { #cycle through the
clients
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
rcvd_msg_from_client($client, $request); #subroutine

# $outbuffer{$client} .= "$request";
}
delete $ready{$client}; #remove the client from the processes
}
#-------------------Blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);
}
#-------------------Receive Message from Client-------------------
sub rcvd_msg_from_client {
# This sub receives the message from the client and processes
# it.
my ($client, $request) = @_; #drop the passed variables

if (length($request) ne 0) { #if there is a request
chomp $request;
print "CLIENT QUERY: '$request'\n"; #this is used for all
requests into the server
# CLIENT QUERY in the form of ID_NUMBER::USERNAME:: ...
my @msg = split(/::/, $request); #assigned by the client;
runs the requested subs
if($msg[0] eq '1') {logon($client, @msg)}
# } elsif ($msg[0] eq 2) {
# register($client, @msg);
# } elsif ($msg[0] eq 3) {
# quit($client, @msg);
# } elsif ($msg[0] eq 4) {
# logoff($client, @msg);
# } elsif ($msg[0] eq 5) {
# return_logged_users($client, @msg);
# } elsif ($msg[0] eq 6) {
# msg_user($client, @msg);
elsif ($msg[0] eq 7) {msg_all_users($client, @msg)}
# } elsif ($msg[0] eq 8) {
# query_buddy($client, @msg);
# } elsif ($msg[0] eq 9) {
# update_info($client, @msg);
else {
print "Unrecognized ID $msg[0]\n";
$outbuffer{$client} .= "Unrecognized ID $msg[0]\n";
}
}
}
#-------------------login-------------------
sub logon {
# This sub checks the length of the data passed to it,
# if the length is ne 0, then it checks to make sure the
# data authenticates (i.e. login name and password authenticate)
# If this happens then chk_for_login is called else user is
# logged in.
my ($client, @msg) = @_;

my $client_ip = get_hostaddr($client);

if (length($msg[1]) ne 0) {
print "User $msg[1] attempting login...\n";
# if (authorize($msg[1], $msg[2])) {
# check if user is already logged in
if (chk_for_login($msg[1])) { # check if username is already
in use
# user is already logged in
print "SERVER::",time_stamp(),"::03::User $msg[1] $client_ip
logged in.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::03::$msg[1] logged in!
\n";
} else {
# user is not logged in, add to %hosts
my $current_time = time_stamp();
$hosts{$msg[1]}->{'ip'} = $client_ip;
$hosts{$msg[1]}->{'status'} = 'connected';
$hosts{$msg[1]}->{'logged_in'} = 'yes';
$hosts{$msg[1]}->{'user_name'} = $msg[1];
$hosts{$msg[1]}->{'con_time'} = $current_time;
$hosts{$msg[1]}->{'connection'} = $client;
print "SERVER::",time_stamp(),"::03::User $msg[1] $client_ip
logged in.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::03::$msg[1] logged in!
\n";
}
# } else {
# print "SERVER::",time_stamp(),"::00::User $msg[1] NOT logged in.
\n";
# $outbuffer{$client} .= "SERVER::$msg[0]::00::$msg[1] NOT logged
in!\n";
# }
} else {
print "SERVER::",time_stamp(),"::00::Null user not logged in.\n";
print "ERROR::",time_stamp(),"::09::Invalid logon attempt.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::00::Could not login with
that name.\n";
}
}
#-------------------Get host address-------------------
sub get_hostaddr {
my ($client) = @_;
my $sock = $client;
return $sock->peerhost();
}
#-------------------Check current users-------------------
sub chk_for_login {
# chk_for_login() checks the hash of logins for a matching
# key. if one is found then 1 is returned, else 0 is returned
my ($user_name) = @_;
foreach (keys %hosts) {
if($_ eq $user_name) {
return 1;
} else {
return 0;
}
}
}
#-------------------Timestamp-------------------
sub time_stamp {
# This sub returns the time using gmtime();
my ($s, $m, $h, $dy, $mo, $yr, $wd, $dst);
($s, $m, $h, $dy, $mo, $yr, $wd, $dst) = gmtime(); # get the date
$mo++;
$yr = $yr - 100;
if ($mo < 10) { $mo = "0".$mo; }
if ($dy < 10) { $dy = "0".$dy; }
if ($yr < 10) { $yr = "0".$yr; }
if ($h < 10) { $h = "0".$h; }
if ($m < 10) { $m = "0".$m; }
if ($s < 10) { $s = "0".$s; }
return "$mo-$dy-$yr $h:$m:$s";
}
#-------------------Message all users-------------------
sub msg_all_users {
# sends a global message to every user logged in
my ($client, @msg) = @_;
my $rcpt;

print "SERVER::",time_stamp(),"::21::Global message attempt:
$msg[1]\n";
if (chk_for_login($msg[1])) { # check if user is logged in
print "SERVER::",time_stamp(),"::21::$msg[1] cleared for GM\n";
foreach (keys %hosts) { # for each logged in user
$rcpt = get_link($_); # get rcpts connection
$outbuffer{$rcpt} .= "SERVER::$msg[0]::21::$msg[1]::$msg[3]\n";
}
}
}
#-------------------Get the links to the connected
users-------------------
sub get_link {
# This sub gets a connection link to a user
my ($user_name) = @_;
foreach (keys %hosts) {
if($_ eq $user_name) {
return $hosts{$_}->{'connection'};
}
}
}

 

[smallpond]

This is a chat client wrote in perl Gtk2. THe problem that I am
running into is that when you type and click send I get a "print() on
closed filehandle GEN0 at chat-client.pl line 332" error. This error
is the print statement in the send_msg_all sub. I cant figure out how
the file handle is closed and am wondering if anyone can see why. I'll
leave the server running for testing purposes.

# the Client:

#!/usr/bin/perl
# Flow of the Program:
# *Send message to the server - send_msg_all
# *Connect to the server - sub connect_server
# -unblock the server - nonblock
# -Login to the server - send_login
# -Timer started to wait for messages - wait_for_msg
# >Handler - handle
# $Process the incoming meswsages - process_incoming
# @Recieve messages and display in textview - rcv_msg

use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use IO::Socket::INET;
use Tie::RefHash;
use IO::Select;

#global variables
my $buffer;
my $host = "Deadpickle-hobo";
my $port = 6666;
my $conn_stat = 'idle';
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
my $select;
my $conn;
my $user;

#the main chat widget
my $main_window = Gtk2::Window->new("toplevel");
$main_window->signal_connect(delete_event => sub {Gtk2->main_quit;});
$main_window->set_default_size(250, 200);

my $table = Gtk2::Table->new(4, 2, FALSE);

$buffer = Gtk2::TextBuffer->new;
my $button = Gtk2::Button->new("Send");
my $entry = Gtk2::Entry->new();

my $label = Gtk2::Label->new("Chat Client Test");

my $textview = Gtk2::TextView->new_with_buffer($buffer);
$textview->set_cursor_visible (FALSE);
my $swindow = Gtk2::ScrolledWindow->new( undef, undef);
$swindow->set_policy( 'automatic', 'automatic');
$swindow->set_shadow_type( 'etched-out');

$swindow->add( $textview);

$table->attach_defaults($label, 0, 1, 0, 1);
$table->attach_defaults($swindow, 0, 2, 1, 3);
$table->attach_defaults($entry, 0, 1, 3, 4);
$table->attach_defaults($button, 1, 2, 3, 4);
$main_window->add($table);

$main_window->show_all();

$button->signal_connect("clicked" => sub { send_msg_all($entry-

get_text); $entry->set_text('');} );

#run the login dialog
dialog($buffer);

Gtk2->main;

#-------------------Login Dialog-------------------
sub dialog{
my $buffer = shift;

my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-

main_quit});

my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $dialog_label3 = Gtk2::Label->new('Host:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');

$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);

$dialog_button1->signal_connect("clicked" => sub {$user = $chat_user-

get_text; $dialog_window->destroy; $buffer->insert(($buffer-
get_end_iter), "Username: $user...\n"); connect_server()});

$dialog_window->add($dialog_table);

$dialog_window->show_all;

return 1;}

#------------------Connect to server---------------------
#establishes connection to the server
sub connect_server{
if ($conn_stat ne 'connected') {
$buffer->insert(($buffer->get_end_iter), "Connecting to Server
$host:$port...\n");

$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);

if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
$buffer->insert(($buffer->get_end_iter), "Connected!\n");

#send login to server
send_login();

#start the timer that monitors incoming messages
my $timer_waiting = Glib::Timeout->add(100, \&wait_for_msg);

print "$conn\n";
}
}}

#-------------------Error popup-------------------
# pops up an error message
sub popup_err{
my ($error_code) = @_;
my $error;

if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
elsif ($error_code == 6) {$error = "User Successfully Added!"}
elsif ($error_code == 7) {$error = "Error Registering User!"}
elsif ($error_code == 8) {$error = "Already Logged Out!"}
else {$error = "Unkown Error!"}

$buffer->insert(($buffer->get_end_iter), "$error\n");

my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-
with-parent', 'error', 'ok', "$error");

$error_dialog->run;
$error_dialog->destroy;}

#-------------------blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);}

#-------------------Message Waiting-------------------
# Wait for incoming messages from the server relayed from clients
sub wait_for_msg {

print "waiting\n";

if ($conn_stat eq 'connected') {
my ($list_size, $msg);
my $server;
my $rv;
my $data;

# check for new information on the connections we have
# anything to read or accept?
foreach $server ($select->can_read(1)) {
# read data
$data = '';
$rv = $server->recv($data, 'POSIX::BUFSIZ', 0);

unless (defined($rv) && length $data) {
# This would be the end of file, so close the client
delete $inbuffer{$server};
delete $outbuffer{$server};
delete $ready{$server};

$select->remove($server);
close $server;
next;
}

$inbuffer{$server} .= $data;

# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$server} =~ s/(.*\n)//) {

push( @{$ready{$server}}, $1 );
}
}

# Any complete requests to process?
foreach $server (keys %ready) {

handle($server);
}
}}

#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$server}
# send output to $outbuffer{$server}
my $server = shift;
my $request;

foreach $request (@{$ready{$server}}) {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
process_incoming($server, $request);
}
delete $ready{$server};}

#-------------------Process Incoming-------------------
sub process_incoming {
my ($server, $msg) = @_;
my @logged_users;

my @rcvd_msg = split(/::/, $msg);

if ($rcvd_msg[1] eq "1") {
# Login responses
# 12 = already logged on
# 03 = logged in

if($rcvd_msg[2] eq "03") {
print "Successfully Logged in!\n";
} elsif ($rcvd_msg[2] eq "12") {
popup_err(4);
} else {
# Create pop-up for error!
print "Error Logging in ", $msg, "\n";
popup_err(5);
}
} elsif ($rcvd_msg[1] eq "2") {
# register response
if ($rcvd_msg[2] eq "06") {
print "New user successfully registered!\n";
popup_err(6);
} elsif ($rcvd_msg[2] eq "02") {
print "$msg\n";
popup_err(4);
} else {
print "$msg\n";
popup_err(7);
}
} elsif ($rcvd_msg[1] eq "3") {
# quit response
print "$msg\n";
# $exit_cond = 0;
} elsif ($rcvd_msg[1] eq "4") {
# log out response
# 14 = user logged off
# 13 = user not logged in to begin with
print "$msg\n";
if($rcvd_msg[2] == 13) {
popup_err(8); # not logged in
}
# else {
# # clear the buddy list
# $list_size = $buddy_list->size;
# $list_size = $list_size - 1;
# $buddy_list->delete(0,$list_size);
# }
# $menu_file->update;
# } elsif ($rcvd_msg[1] eq "5") {
# # delete existing list of users
# $list_size = $buddy_list->size;
# if($list_size > 0) { $buddy_list->delete(0,$list_size); }
# # get users list response
# # if server response for proto 5 is 17 then Draw in
$buddy_list
# if ($rcvd_msg[2] == 17) {
# @logged_users = split (/ /, $rcvd_msg[3]);
# foreach (@logged_users) {
# $buddy_list->insert('end', "$_");
# }
# } elsif ($rcvd_msg[2] eq 18) {
# # generate error for login
# print "Please Log in to server first!\n";
# print "$msg\n";
# popup_err(51);
# } else {
# print "Unknown error updating buddy list:\n";
# print "$msg\n";
# popup_err(52);
# }
# $menu_file->update;
} elsif ($rcvd_msg[1] eq "6") {
# receive user message
# 13 - user not logged in
# 23 - buddy (target) not logged in
print "$msg\n";
rcv_msg($rcvd_msg[3], $rcvd_msg[4]);
# } elsif ($rcvd_msg[1] eq "7") {
# # receive global message
# print "$msg\n";
# rcv_msg_all($rcvd_msg[3], $rcvd_msg[4]);
# } elsif ($rcvd_msg[1] eq "8") {
# if ($rcvd_msg[2] == 23) {
# popup_err(81);
# } elsif ($rcvd_msg[2] eq "13") {
# popup_err(82);
# } else {
# # receive query information
# print "$msg\n";
# process_query($msg);
# }
# $menu_file->update;
} else {
print "Unrecognized response: $msg\n";
# popup_err(92);
exit(0);
}
# if($err) { print "ERROR: $err\n"; }}

#-------------------Send message to all-------------------
sub send_msg_all {
my ($msg) = @_;

print "$conn\n";

if(defined $conn) {
# Send a the Message to server
print "Sending\n";
print $conn "7\:\:$user\:\:$msg\n";
} else {
popup_err(3);
}}

#-------------------Send login-------------------
#logs the user name on the server
sub send_login {
# my ($u) = @_;

if(defined $conn) {
if(length($user) > 0) {
#send login to server
print $conn "1\:\:$user\n";
# update_info();
} else {
popup_err(2);
}
} else {
popup_err(3);
}}

#-------------------Display Message-------------------
sub rcv_msg {
my ($from, $msg) = @_;

print "Received message from $from\n";
if(defined $conn) {
print "Already Connected: Proceeding with message!\n";
# $status->insert('end',"[$from]: $msg\n");
} else {
print "No connection established!\n";
popup_err(3);
}

}

The Server:

#!/usr/local/bin/perl
#
# SERVER PROTOCOLS
# 01 - Login ....... 1::username:asswd
# 02 - Register New User 2::username:asswd
# 03 - Terminate Program ....... 3::username:asswd
# 04 - Logoff Server 4::username:asswd
# 05 - Get Logged Users ....... 5::username:asswd
# 06 - Message another user
6::username:asswd::rcpt::message
# 07 - Global message ....... 7::username:asswd::message
# 08 - Query buddy 8::username:asswd::rcpt
# 09 - Update Buddy Info .......
9::username:asswd::Name::Email::Quote

use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;

$port = 6666;
my %hosts;

# Create Server
$server = IO::Socket::INET->new(LocalPort => $port,
Listen => 100 )
or die "Can't make server socket: $@\n";

print "Server created. Waiting for events...\n";

# begin with empty buffers
%inbuffer = ();
%outbuffer = ();
%ready = ();

tie %ready, 'Tie::RefHash';

nonblock($server);
$select = IO::Select->new($server);

# Main loop: check reads/accepts, check writes, check ready to process
while (1) {
my $client;
my $rv;
my $data;

# check for new information on the connections we have

# anything to read or accept?
foreach $client ($select->can_read(1)) {

if ($client == $server) {
# accept a new connection
$client = $server->accept();
$select->add($client);
nonblock($client); #subroutine
} else {
# read data
$data = '';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);

unless (defined($rv) && length $data) { #Runs the
bottom statement unless it is true
# This would be the end of file, so close the client
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};

$select->remove($client);
close $client;
next;
}

$inbuffer{$client} .= $data; #add the recieved data
to the inbuffer

# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
# Disceting the matching variable:
# =~: between variable and and regular expression
# s/PATTERN//REPLACEMENT/: searchs the string for the
pattern then replaces it with the replacement text
# (.*\n):
# . match any character except newline
# * match zero or more times
# \n newline
while ($inbuffer{$client} =~ s/(.*\n)//) { #If there is
data in the inbuffer; searches for a string with a newline at the end
push( @{$ready{$client}}, $1 ); # $1 is the matched
string that is added the the hash/array %ready; this must be the
REFHASH
}
}
}

# Any complete requests to process?
foreach $client (keys %ready) { #calls the refhash keys
handle($client); #subroutine
}

# Buffers to flush?
foreach $client ($select->can_write(1)) { #see what clients are
ready to be wrote to
# Skip this client if we have nothing to say
next unless exists $outbuffer{$client}; #run the next
iteration unless the outbuffer exists

$rv = $client->send($outbuffer{$client}, 0);
unless (defined $rv) { #run the statement unless $rv is
defined
# Whine, but move on.
warn "I was told I could write, but I can't.\n";
next;
}
if ($rv == length $outbuffer{$client} ||
$! == POSIX::EWOULDBLOCK) {
substr($outbuffer{$client}, 0, $rv) = '';
delete $outbuffer{$client} unless length
$outbuffer{$client};
} else {
# Couldn't write all the data, and it wasn't because
# it would have blocked. Shutdown and move on.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};

$select->remove($client);
close($client);
next;
}
}

# Out of band data?
foreach $client ($select->has_exception(0)) { # arg is timeout
# Deal with out-of-band data here, if you want to.
print "DEBUG ME!\n";
}}

#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$client}
# send output to $outbuffer{$client}
my $client = shift;
my $request;

foreach $request (@{$ready{$client}}) { #cycle through the
clients
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
rcvd_msg_from_client($client, $request); #subroutine

# $outbuffer{$client} .= "$request";
}
delete $ready{$client}; #remove the client from the processes}

#-------------------Blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);
}
#-------------------Receive Message from Client-------------------
sub rcvd_msg_from_client {
# This sub receives the message from the client and processes
# it.
my ($client, $request) = @_; #drop the passed variables

if (length($request) ne 0) { #if there is a request
chomp $request;
print "CLIENT QUERY: '$request'\n"; #this is used for all
requests into the server
# CLIENT QUERY in the form of ID_NUMBER::USERNAME:: ...
my @msg = split(/::/, $request); #assigned by the client;
runs the requested subs
if($msg[0] eq '1') {logon($client, @msg)}
# } elsif ($msg[0] eq 2) {
# register($client, @msg);
# } elsif ($msg[0] eq 3) {
# quit($client, @msg);
# } elsif ($msg[0] eq 4) {
# logoff($client, @msg);
# } elsif ($msg[0] eq 5) {
# return_logged_users($client, @msg);
# } elsif ($msg[0] eq 6) {
# msg_user($client, @msg);
elsif ($msg[0] eq 7) {msg_all_users($client, @msg)}
# } elsif ($msg[0] eq 8) {
# query_buddy($client, @msg);
# } elsif ($msg[0] eq 9) {
# update_info($client, @msg);
else {
print "Unrecognized ID $msg[0]\n";
$outbuffer{$client} .= "Unrecognized ID $msg[0]\n";
}
}}

#-------------------login-------------------
sub logon {
# This sub checks the length of the data passed to it,
# if the length is ne 0, then it checks to make sure the
# data authenticates (i.e. login name and password authenticate)
# If this happens then chk_for_login is called else user is
# logged in.
my ($client, @msg) = @_;

my $client_ip = get_hostaddr($client);

if (length($msg[1]) ne 0) {
print "User $msg[1] attempting login...\n";
# if (authorize($msg[1], $msg[2])) {
# check if user is already logged in
if (chk_for_login($msg[1])) { # check if username is already
in use
# user is already logged in
print "SERVER::",time_stamp(),"::03::User $msg[1] $client_ip
logged in.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::03::$msg[1] logged in!
\n";
} else {
# user is not logged in, add to %hosts
my $current_time = time_stamp();
$hosts{$msg[1]}->{'ip'} = $client_ip;
$hosts{$msg[1]}->{'status'} = 'connected';
$hosts{$msg[1]}->{'logged_in'} = 'yes';
$hosts{$msg[1]}->{'user_name'} = $msg[1];
$hosts{$msg[1]}->{'con_time'} = $current_time;
$hosts{$msg[1]}->{'connection'} = $client;
print "SERVER::",time_stamp(),"::03::User $msg[1] $client_ip
logged in.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::03::$msg[1] logged in!
\n";
}
# } else {
# print "SERVER::",time_stamp(),"::00::User $msg[1] NOT logged in.
\n";
# $outbuffer{$client} .= "SERVER::$msg[0]::00::$msg[1] NOT logged
in!\n";
# }
} else {
print "SERVER::",time_stamp(),"::00::Null user not logged in.\n";
print "ERROR::",time_stamp(),"::09::Invalid logon attempt.\n";
$outbuffer{$client} .= "SERVER::$msg[0]::00::Could not login with
that name.\n";
}}

#-------------------Get host address-------------------
sub get_hostaddr {
my ($client) = @_;
my $sock = $client;
return $sock->peerhost();}

#-------------------Check current users-------------------
sub chk_for_login {
# chk_for_login() checks the hash of logins for a matching
# key. if one is found then 1 is returned, else 0 is returned
my ($user_name) = @_;
foreach (keys %hosts) {
if($_ eq $user_name) {
return 1;
} else {
return 0;
}
}}

#-------------------Timestamp-------------------
sub time_stamp {
# This sub returns the time using gmtime();
my ($s, $m, $h, $dy, $mo, $yr, $wd, $dst);
($s, $m, $h, $dy, $mo, $yr, $wd, $dst) = gmtime(); # get the date
$mo++;
$yr = $yr - 100;
if ($mo < 10) { $mo = "0".$mo; }
if ($dy < 10) { $dy = "0".$dy; }
if ($yr < 10) { $yr = "0".$yr; }
if ($h < 10) { $h = "0".$h; }
if ($m < 10) { $m = "0".$m; }
if ($s < 10) { $s = "0".$s; }
return "$mo-$dy-$yr $h:$m:$s";}

#-------------------Message all users-------------------
sub msg_all_users {
# sends a global message to every user logged in
my ($client, @msg) = @_;
my $rcpt;

print "SERVER::",time_stamp(),"::21::Global message attempt:
$msg[1]\n";
if (chk_for_login($msg[1])) { # check if user is logged in
print "SERVER::",time_stamp(),"::21::$msg[1] cleared for GM\n";
foreach (keys %hosts) { # for each logged in user
$rcpt = get_link($_); # get rcpts connection
$outbuffer{$rcpt} .= "SERVER::$msg[0]::21::$msg[1]::$msg[3]\n";
}
}}

#-------------------Get the links to the connected
users-------------------
sub get_link {
# This sub gets a connection link to a user
my ($user_name) = @_;
foreach (keys %hosts) {
if($_ eq $user_name) {
return $hosts{$_}->{'connection'};
}
}

}

This is the shortest example you could do to show the problem?

"print on closed filehandle" means just that. You are doing
a print to a filehandle which is not open.

perl -e 'use warnings; print FOO "bang!\n"'
Name "main::FOO" used only once: possible typo at -e line 1.
print() on unopened filehandle FOO at -e line 1.

perl is telling you that you do not have a filehandle $conn
which is open. The error message is pretty clear.
--S

 

[Ted Zlatanov]

s> This is the shortest example you could do to show the problem?

....and you had to quote all 700+ lines of it? I'd rather see
top-quoting than this.

Ted

 

[smallpond]

s> This is the shortest example you could do to show the problem?

...and you had to quote all 700+ lines of it? I'd rather see
top-quoting than this.

Ted

My apologies. The Google browser client hides quoted text and I
sometimes
forget to trim replies.
--S

 

[zentara]

This is a chat client wrote in perl Gtk2. THe problem that I am
running into is that when you type and click send I get a "print() on
closed filehandle GEN0 at chat-client.pl line 332" error. This error
is the print statement in the send_msg_all sub. I cant figure out how
the file handle is closed and am wondering if anyone can see why. I'll
leave the server running for testing purposes.

I'm sorry to say, that this complex set of scripts is a PITA to deal
with.

After fixing the many wordwrap problems, and host mismatches,
I got to see your problem.

It's too complex for me to see how to fix it, without alot of work.

Simply put, you need a bi-directional client so the client can
function properly. The way it is setup, your $conn only works
for the first connection, then is closed. So you are printing to a
closed socket. You need a bi-directional client, OR some loop
that keeps the client alive switching between send and recv mode.
Something like
while($select->can_read){
do stuff with the socket
}

Google for select loop examples.

Try starting your server, and testing it with this bi-directional
client. It dosn't follow your original connection protocol, but
it stays alive.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
#use IO::Select;
use IO::Socket;

require Tk::ROText;

# create the socket

my $host = shift || 'localhost';
my $port = 6666;

my $socket = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp',
);

defined $socket or die "ERROR: Can't connect to port $port on $host:
$!\n";

print STDERR "Connected to server ...\n";

my $mw = new MainWindow;
my $log = $mw->Scrolled(qw/ROText -scrollbars ose/)->pack;

my $txt = $mw->Entry()->pack(qw/-fill x -pady 5/);

$mw ->bind('<Any-Enter>' => sub { $txt->Tk::focus });
$txt->bind('<Return>' => [\&broadcast, $socket]);

$mw ->fileevent($socket, readable => sub {
my $line = <$socket>;
unless (defined $line) {
$mw->fileevent($socket => readable => '');
return;
}
$log->insert(end => $line);
});


MainLoop;

sub broadcast {
my ($ent, $sock) = @_;

my $text = $ent->get;
$ent->delete(qw/0 end/);

print $sock $text, "\n";
}
__END__


zentara

 

[zentara]

I'm sorry to say, that this complex set of scripts is a PITA to deal
with.

After fixing the many wordwrap problems, and host mismatches,
I got to see your problem.

It's too complex for me to see how to fix it, without alot of work.

Simply put, you need a bi-directional client so the client can
function properly. The way it is setup, your $conn only works
for the first connection, then is closed. So you are printing to a
closed socket. You need a bi-directional client, OR some loop
that keeps the client alive switching between send and recv mode.

Hi, I quickly looked at it again, and saw where you closed the $conn
filehandle. This isn't a fix, but comment out these lines in your
client. This is where you are shutting down.

unless (defined($rv) && length $data) {

# This would be the end of file, so close the client
# delete $inbuffer{$server};
# delete $outbuffer{$server};
# delete $ready{$server};
# $select->remove($server);
# close $server;

next;


zentara

 

[deadpickle]

Thanks for your help. Commenting that code out gets the client to stay
connected, also I can send a message to the server and it is received.
Now I'm trying to get the message to be received and then displayed in
the Textview. It seems that nothing is being received by the client.
In the original program that this is based on, the author use a Tk
repeat loop in order the call the subroutine wait_for_msg. In this
Gtk2 version, a Glib::Timeout is used instead. The question is is if
this loop is receiving data from the server or not. I'm going to look
into the code but if someone sees something please let me know.

The Client:
#!/usr/bin/perl
# Flow of the Program:
# *Send message to the server - send_msg_all
# *Connect to the server - sub connect_server
# -unblock the server - nonblock
# -Login to the server - send_login
# -Timer started to wait for messages - wait_for_msg
# >Handler - handle
# $Process the incoming meswsages - process_incoming
# @Recieve messages and display in textview - rcv_msg_all

use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use IO::Socket::INET;
use Tie::RefHash;
use IO::Select;

#global variables
my $buffer;
my $host = "Deadpickle-hobo";
my $port = 6666;
my $conn_stat = 'idle';
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
my $select;
my $conn;
my $user;

#the main chat widget
my $main_window = Gtk2::Window->new("toplevel");
$main_window->signal_connect(delete_event => sub {Gtk2->main_quit;});
$main_window->set_default_size(250, 200);

my $table = Gtk2::Table->new(4, 2, FALSE);

$buffer = Gtk2::TextBuffer->new;
my $button = Gtk2::Button->new("Send");
my $entry = Gtk2::Entry->new();

my $label = Gtk2::Label->new("Chat Client Test");

my $textview = Gtk2::TextView->new_with_buffer($buffer);
$textview->set_cursor_visible (FALSE);
my $swindow = Gtk2::ScrolledWindow->new( undef, undef);
$swindow->set_policy( 'automatic', 'automatic');
$swindow->set_shadow_type( 'etched-out');

$swindow->add( $textview);

$table->attach_defaults($label, 0, 1, 0, 1);
$table->attach_defaults($swindow, 0, 2, 1, 3);
$table->attach_defaults($entry, 0, 1, 3, 4);
$table->attach_defaults($button, 1, 2, 3, 4);
$main_window->add($table);

$main_window->show_all();

$button->signal_connect("clicked" => sub { send_msg_all($entry-

get_text); $entry->set_text('');} );

#run the login dialog
dialog($buffer);

Gtk2->main;

#-------------------Login Dialog-------------------
sub dialog{
my $buffer = shift;

my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-

main_quit});

my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $dialog_label3 = Gtk2::Label->new('Host:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');

$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);

$dialog_button1->signal_connect("clicked" => sub {$user = $chat_user-

get_text; $dialog_window->destroy; $buffer->insert(($buffer-
get_end_iter), "Username: $user...\n"); connect_server()});

$dialog_window->add($dialog_table);

$dialog_window->show_all;

return 1;
}
#------------------Connect to server---------------------
#establishes connection to the server
sub connect_server{
if ($conn_stat ne 'connected') {
$buffer->insert(($buffer->get_end_iter), "Connecting to Server
$host:$port...\n");

$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);

if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
$buffer->insert(($buffer->get_end_iter), "Connected!\n");

#send login to server
send_login();

#start the timer that monitors incoming messages
my $timer_waiting = Glib::Timeout->add(100, \&wait_for_msg);
}
}
}
#-------------------Error popup-------------------
# pops up an error message
sub popup_err{
my ($error_code) = @_;
my $error;

if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
elsif ($error_code == 6) {$error = "User Successfully Added!"}
elsif ($error_code == 7) {$error = "Error Registering User!"}
elsif ($error_code == 8) {$error = "Already Logged Out!"}
else {$error = "Unkown Error!"}

$buffer->insert(($buffer->get_end_iter), "$error\n");

my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-
with-parent', 'error', 'ok', "$error");

$error_dialog->run;
$error_dialog->destroy;
}
#-------------------blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);
}
#-------------------Message Waiting-------------------
# Wait for incoming messages from the server relayed from clients
sub wait_for_msg {
if ($conn_stat eq 'connected') {
my ($list_size, $msg);
my $server;
my $rv;
my $data;

# check for new information on the connections we have
# anything to read or accept?
foreach $server ($select->can_read(1)) {
# read data
$data = '';
$rv = $server->recv($data, 'POSIX::BUFSIZ', 0);
$inbuffer{$server} .= $data;

# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$server} =~ s/(.*\n)//) {

push( @{$ready{$server}}, $1 );
}
}

# Any complete requests to process?
foreach $server (keys %ready) {

handle($server);
}
}
}
#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
# requests are in $ready{$server}
# send output to $outbuffer{$server}
my $server = shift;
my $request;

foreach $request (@{$ready{$server}}) {
# $request is the text of the request
# put text of reply into $outbuffer{$client}
chomp $request;
process_incoming($server, $request);
}
delete $ready{$server};
}
#-------------------Process Incoming-------------------
sub process_incoming {
my ($server, $msg) = @_;
my @logged_users;

my @rcvd_msg = split(/::/, $msg);

if ($rcvd_msg[1] eq "1") {
# Login responses
# 12 = already logged on
# 03 = logged in

if($rcvd_msg[2] eq "03") {
print "Successfully Logged in!\n";
} elsif ($rcvd_msg[2] eq "12") {
popup_err(4);
} else {
# Create pop-up for error!
print "Error Logging in ", $msg, "\n";
popup_err(5);
}
}
elsif ($rcvd_msg[1] eq "7") {
# receive global message
print "$msg\n";
rcv_msg_all($rcvd_msg[3], $rcvd_msg[4]);
} else {
print "Unrecognized response: $msg\n";
exit(0);
}
}
#-------------------Send message to all-------------------
sub send_msg_all {
my ($msg) = @_;

print "$conn\n";

if(defined $conn) {
# Send a the Message to server
print "Sending\n";
print $conn "7\:\:$user\:\:$msg\n";
} else {
popup_err(3);
}
}
#-------------------Send login-------------------
#logs the user name on the server
sub send_login {
if(defined $conn) {
if(length($user) > 0) {
#send login to server
print $conn "1\:\:$user\n";
} else {
popup_err(2);
}
} else {
popup_err(3);
}
}
#-------------------Display All Message-------------------
sub rcv_msg_all {
my ($from, $msg) = @_;

print "Received Global message:\n";
if(defined $conn) {
print "Already Connected: Proceeding with message!\n";
# $status->insert('end',"$from: $msg\n");
} else {
print "No connection established!\n";
popup_err(3);
}
}

 

[deadpickle]

I suspect it is the Glib::Timeout that is not working right. I tried
putting a print statement in the wait_for_msg sub and it only printed
once and it should be printing continuously. Is there a better way to
create a timer in Gtk2?

 

[zentara]

I suspect it is the Glib::Timeout that is not working right. I tried
putting a print statement in the wait_for_msg sub and it only printed
once and it should be printing continuously. Is there a better way to
create a timer in Gtk2?

Timers in Gtk2 will stop unless you return 1 from it's sub.

At the end of your wait_for_msg sub, put
return1;

Usually, you setup a test, to return a 1 or 0, depending on
whether you want to stop the timer.

zentara

 

[zentara]

I suspect it is the Glib::Timeout that is not working right. I tried
putting a print statement in the wait_for_msg sub and it only printed
once and it should be printing continuously. Is there a better way to
create a timer in Gtk2?

It dawned on me in a dream, that using a timer to keep the socket
open( as you are tring to do ) is wrong.

What you need to do is use a Gtk2::Helper (which is like Tk's
fileevent), NOT a TIMER, to keep a select read open on the socket.

#add a Gtk2::Helper watch on any incomming connections

Gtk2::Helper->add_watch ( fileno $sock, 'in',sub{
my ($fd,$condition,$fh) = @_;
#call 'watch_callback' to handle the incomming data
\&watch_callback($fh,$tview);
},$sock);

sub watch_callback {

my ($fh,$tview) = @_;
my $msg;
$fh->recv($msg, $MAXLEN) or die "recv: $!";
print $msg."\n";
my $buffer = $tview->get_buffer();
&update_buffer($buffer,$msg,FALSE);

return 1;
}


goodluck,
zentara

 

[deadpickle]

Thanks for the help, I think your right about a timer being a bad
choice. I added the lines, and edited them, to the program. When I ran
the client I got an error that was referenced to the add_watch of the
Gtk2::Helper (located in the connect_server sub):
*** unhandled exception in callback:
*** Not a GLOB reference at chat-client.pl line 120.
*** ignoring at chat-client.pl line 67.
I have gotten these errors before but I don't understand what they
mean or how I fixed them. I reposted the program with the new code.
I'm not sure if I got it implemented correctly.


#!/usr/bin/perl
use warnings;
use strict;
use Gtk2 -init;
use Glib qw/TRUE FALSE/;
use IO::Socket::INET;
use Tie::RefHash;
use IO::Select;
use Gtk2::Helper;

#global variables
my $buffer;
my $host = "Deadpickle-hobo";
my $port = 6666;
my $conn_stat = 'idle';
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();
my $select;
my $conn;
my $user;

#the main chat widget
my $main_window = Gtk2::Window->new("toplevel");
$main_window->signal_connect(delete_event => sub {Gtk2->main_quit;});
$main_window->set_default_size(250, 200);

my $table = Gtk2::Table->new(4, 2, FALSE);

$buffer = Gtk2::TextBuffer->new;
my $button = Gtk2::Button->new("Send");
my $entry = Gtk2::Entry->new();

my $label = Gtk2::Label->new("Chat Client Test");

my $textview = Gtk2::TextView->new_with_buffer($buffer);
$textview->set_cursor_visible (FALSE);
my $swindow = Gtk2::ScrolledWindow->new( undef, undef);
$swindow->set_policy( 'automatic', 'automatic');
$swindow->set_shadow_type( 'etched-out');

$swindow->add( $textview);

$table->attach_defaults($label, 0, 1, 0, 1);
$table->attach_defaults($swindow, 0, 2, 1, 3);
$table->attach_defaults($entry, 0, 1, 3, 4);
$table->attach_defaults($button, 1, 2, 3, 4);
$main_window->add($table);

$main_window->show_all();

$button->signal_connect("clicked" => sub { send_msg_all($entry-

get_text); $entry->set_text('');} );

#run the login dialog
dialog($buffer);

Gtk2->main;

#-------------------Login Dialog-------------------
sub dialog{
my $buffer = shift;

my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-

main_quit});

my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $dialog_label3 = Gtk2::Label->new('Host:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');

$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);

$dialog_button1->signal_connect("clicked" => sub {$user = $chat_user-

get_text; $dialog_window->destroy; my $msg = "Username: $user...";

&update_buffer($msg); connect_server()});

$dialog_window->add($dialog_table);

$dialog_window->show_all;

return 1;
}
#------------------Connect to server---------------------
#establishes connection to the server
sub connect_server{
if ($conn_stat ne 'connected') {
$buffer->insert(($buffer->get_end_iter), "Connecting to Server
$host:$port...\n");

$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);

if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
&update_buffer(my $msg = "Connected!");

#send login to server
send_login();

Gtk2::Helper->add_watch ( fileno $select, 'in',sub{ my ($fh) =
@_; \&wait_for_msg($fh);},$select);

}
}
return 1;
}
#-------------------Error popup-------------------
# pops up an error message
sub popup_err{
my ($error_code) = @_;
my $error;

if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
else {$error = "Unkown Error!"}

&update_buffer($error);

my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-
with-parent', 'error', 'ok', "$error");

$error_dialog->run;
$error_dialog->destroy;
return 1;
}
#-------------------blocking-------------------
# nonblock($socket) puts socket into nonblocking mode
sub nonblock {
my $socket = shift;

$socket->blocking(0);
return 1;
}
#-------------------Message Waiting-------------------
# Wait for incoming messages from the server relayed from clients
sub wait_for_msg {
my ($fh) = @_;
my $msg;

$fh->recv($msg, 'POSIX::BUFSIZ', 0) or die "recv: $!";
print $msg."\n";

while ($inbuffer{$fh} =~ s/(.*\n)//) {
push( @{$ready{$fh}}, $1 );
}

foreach $fh (keys %ready) {
handle($fh);
}




return 1;
}
#-------------------Handler-------------------
# handle($socket) deals with all pending requests for $client
sub handle {
my $server = shift;
my $request;

foreach $request (@{$ready{$server}}) {
chomp $request;
process_incoming($server, $request);
}
delete $ready{$server};
return 1;
}
#-------------------Process Incoming-------------------
sub process_incoming {
my ($server, $msg) = @_;
my @logged_users;

my @rcvd_msg = split(/::/, $msg);

print "@rcvd_msg\n";

if ($rcvd_msg[1] eq "1") {

if($rcvd_msg[2] eq "03") {
print "Successfully Logged in!\n";
} elsif ($rcvd_msg[2] eq "12") {
popup_err(4);
} else {
# Create pop-up for error!
print "Error Logging in ", $msg, "\n";
popup_err(5);
}
}
elsif ($rcvd_msg[1] eq "7") {
# receive global message
print "$msg\n";
rcv_msg_all($rcvd_msg[3], $rcvd_msg[4]);

} else {
print "Unrecognized response: $msg\n";
exit(0);
}
return 1;
}
#-------------------Send message to all-------------------
sub send_msg_all {
my ($msg) = @_;

print "$conn\n";

if(defined $conn) {
# Send a the Message to server
print "Sending\n";
print $conn "7\:\:$user\:\:$msg\n";
} else {
popup_err(3);
}
return 1;
}
#-------------------Send login-------------------
#logs the user name on the server
sub send_login {
# my ($u) = @_;

if(defined $conn) {
if(length($user) > 0) {
#send login to server
print $conn "1\:\:$user\n";
} else {
popup_err(2);
}
} else {
popup_err(3);
}
return 1;
}
#-------------------Display All Message-------------------
sub rcv_msg_all {
my ($from, $msg) = @_;

print "Received Global message:\n";
if(defined $conn) {
print "Already Connected: Proceeding with message!\n";
$buffer->insert(($buffer->get_end_iter), "$from: $msg\n");
} else {
print "No connection established!\n";
popup_err(3);
}
return 1;
}
#-------------------Print messages to the widget-------------------
sub update_buffer {
my ($msg) = @_;
$buffer->insert(($buffer->get_end_iter), "$msg\n");
return 1;
}

 

[Ben Morrow]

Thanks for the help, I think your right about a timer being a bad
choice. I added the lines, and edited them, to the program. When I ran
the client I got an error that was referenced to the add_watch of the
Gtk2::Helper (located in the connect_server sub):
*** unhandled exception in callback:
*** Not a GLOB reference at chat-client.pl line 120.
*** ignoring at chat-client.pl line 67.
I have gotten these errors before but I don't understand what they
mean or how I fixed them. I reposted the program with the new code.
I'm not sure if I got it implemented correctly.

$conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort =>
$port, Proto => 'tcp') or popup_err(1);

if ($conn) {
%inbuffer = ();
%outbuffer = ();
%ready = ();
tie %ready, 'Tie::RefHash';

This is almost certainly wrong. Either %ready hasn't been used before,
in which case the = () is unnecessary; or it has, in which case you
would need to untie it first.

nonblock($conn);
$select = IO::Select->new($conn);
$conn_stat = 'connected';
&update_buffer(my $msg = "Connected!");

Don't call subs with & unless you know what it does and why you need it.

#send login to server
send_login();

Gtk2::Helper->add_watch ( fileno $select, 'in',sub{ my ($fh) =

$select isn't a filehandle, so you can't pass it to fileno. Messages
about GLOB refs usually refer to filehandles.

Why did you create $select at all? Just pass $conn to ->add_watch.

@_; \&wait_for_msg($fh);},$select);

What do you think this syntax does? I think yu probably just meant to
call wait_for_msg?

Also, you are allowed to use more than one line per statement .

Gtk2::Helper->add_watch(
$conn,
in => sub {
my ($fh) = @_;
wait_for_msg($fh);
},
$conn,
);

Since anon subs in Perl close over lexicals, I would write this without
the parameter:

Gtk2::Helper->add_watch($conn, in => sub { wait_for_msg($conn) });

The anon sub picks up the surrounding $conn and remembers it until it is
called.

if ($error_code == 1) {$error = "Cannot create Socket!"}
elsif ($error_code == 2) {$error = "Username to Short!"}
elsif ($error_code == 3) {$error = "No connection Established!"}
elsif ($error_code == 4) {$error = "Already Logged on with This User
Name!"}
elsif ($error_code == 5) {$error = "Not Connected!"}
else {$error = "Unkown Error!"}

my @errors = (
'Unknown error',
'Cannot create socket',
'Username too short',
'No connection established',
'Already logged on with this username',
'Not connected',
);

$error = $errors[$error_code] || $errors[0];

$fh->recv($msg, 'POSIX::BUFSIZ', 0) or die "recv: $!";

HUH? What made you think quoting this was sensible? It's a function, not
a string.

$fh->recv($msg, POSIX::BUFSIZ, 0)
or die "recv: $!";

Note that depending on your system recv (and everything else) can fail
with EINTR, which isn't a failure at all and just means you need to
retry.

Ben

 

[zentara]

Thanks for the help, I think your right about a timer being a bad
choice. I added the lines, and edited them, to the program. When I ran
the client I got an error that was referenced to the add_watch of the
Gtk2::Helper (located in the connect_server sub):
*** unhandled exception in callback:
*** Not a GLOB reference at chat-client.pl line 120.
*** ignoring at chat-client.pl line 67.
I have gotten these errors before but I don't understand what they
mean or how I fixed them. I reposted the program with the new code.
I'm not sure if I got it implemented correctly.

I see Ben Morrow tried to fix your numerous errors, but why don't you
go to
http://perlmonks.org?node_id=663428

and use that as a basic start to rewrite your code. All you need to do
is add a logon popup and do a password negotiation.

Your current code is too complex for someone to troubleshoot for
free.

zentara

 

[deadpickle]

THanks alot, those scripts are very simple compared to that confusing
script I was trying to write. What I am trying to do is send the user
name to the server so that it can be added to the client list. I dont
quit get how to do this and could use some help.

The client:
#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use IO::Socket;

#-------------------Global variables-------------------

my $host = 'Deadpickle-hobo';
my $port = 12345;
my $socket;
my $user;

#-------------------Main Window-------------------

my $window = Gtk2::Window->new;
$window->signal_connect( delete_event => sub { exit } );
$window->set_default_size( 300, 200 );

my $vbox = Gtk2::VBox->new;
$window->add($vbox);

my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add($scroller);
my $textview = Gtk2::TextView->new;
$textview ->set_editable (0);
$textview ->can_focus(0);
my $buffer = $textview->get_buffer;
$buffer->create_mark( 'end', $buffer->get_end_iter, FALSE );
$buffer->signal_connect(insert_text => sub {
$textview->scroll_to_mark( $buffer->get_mark('end'), 0.0,
TRUE, 0, 0.5 );
});

$scroller->add($textview);

my $entry = Gtk2::Entry->new();

$vbox->pack_start( $entry, FALSE, FALSE, 0 );
$vbox->set_focus_child ($entry); # keeps cursor in entry
$window->set_focus_child ($entry); # keeps cursor in entry

# allows for sending each line with an enter keypress
my $send_sig = $entry->signal_connect ('key-press-event' => sub {
my ($widget,$event)= @_;
if( $event->keyval() == 65293){ # a return key press
my $text = $entry->get_text;
if(defined $socket){ print $socket $user.'->'. $text,
"\n";}
$entry->set_text('');
$entry->set_position(0);
}
});

#If you store the ID returned by signal_connect, you can temporarily
#block your signal handler with
# $object->signal_handler_block ($handler_id)
# and unblock it again when you're done with
## $object->signal_handler_unblock ($handler_id).

# we want to block/unblock the enter keypress depending
# on the state of the socket
$entry->signal_handler_block($send_sig); #not connected yet
$entry->set_editable(0);

$window->show_all;

#start the dialog window
dialog();
Gtk2->main;
exit;

#-------------------Login Dialog-------------------

sub dialog{

my $dialog_window = Gtk2::Window->new('toplevel');
$dialog_window->signal_connect(delete_event => sub {Gtk2-

main_quit});

my $dialog_table = Gtk2::Table->new(2, 2, FALSE);
my $dialog_label1 = Gtk2::Label->new('Chat Login:');
my $dialog_label2 = Gtk2::Label->new('User:');
my $chat_user = Gtk2::Entry->new();
$chat_user->set_text('');
my $dialog_button1 = Gtk2::Button->new('Connect');

$dialog_table->attach_defaults($dialog_label1, 0, 1, 0, 1);
$dialog_table->attach_defaults($chat_user, 1, 2, 0, 1);
$dialog_table->attach_defaults($dialog_button1, 1, 2, 1, 2);

#connect to the server
$dialog_button1->signal_connect( clicked => sub {
$user = $chat_user->get_text;
$dialog_window->destroy;
init_connect();
});

$dialog_window->add($dialog_table);
$dialog_window->show_all;
return;
}

#------------------Connect to server---------------------

sub init_connect{

$socket = IO::Socket::INET->new(
PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp',
);

if( ! defined $socket){
my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, "ERROR: Can't
connect to port $port on $host as $user: $!\n" );
return;
}

# install an io watch for this stream and
# return immediately to the main caller, who will return
# immediately to the event loop. the callback will be
# invoked whenever something interesting happens.
Glib::IO->add_watch( fileno $socket, [qw/in hup err/],
\&watch_callback, $socket );

#turn on entry widget
$entry->set_editable(1);
$entry->grab_focus;
$entry->signal_handler_unblock ($send_sig);

#send the username to the server for handling
print $socket "$user\n";

Gtk2->main_iteration while Gtk2->events_pending;
}

#-------------------Watch for Events-------------------

sub watch_callback {

my ( $fd, $condition, $fh ) = @_;

if ( $condition >= 'in' ) {
# there's data available for reading. we have no
# guarantee that all the data is there, just that
# some is there. however, we know that the child
# will be writing full lines, so we'll assume that
# we have lines and will just use <>.
my $data = scalar <$fh>;

if ( defined $data ) {
# do something useful with the text.
my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, $data );
}
}

if ( $condition >= 'hup' or $condition >= 'err' ) {
# End Of File, Hang UP, or ERRor. that means
# we're finished.

# stop ability to send
$entry->set_editable(0);
$entry->signal_handler_block ($send_sig);

my $buffer = $textview->get_buffer;
$buffer->insert( $buffer->get_end_iter, "Server connection
lost !!\n" );

#close socket
$fh->close;
$fh = undef;

#allow for new connection
#$button->set_label('Connect');
#$button->set_sensitive(1);
#$button->grab_focus;
#Gtk2->main_iteration while Gtk2->events_pending;
}

if ($fh) {
# the file handle is still open, so return TRUE to
# stay installed and be called again.
# print "still connected\n";
# possibly have a "connection alive" indicator
return TRUE;
}

else {
# we're finished with this job. start another one,
# if there are any, and uninstall ourselves.
return FALSE;
}
}

the server:
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket;
use threads;
use threads::shared;

my $user;

$|++;
print "$$ Server started\n";; # do a "top -p -H $$" to monitor server
threads

our @clients : shared;
@clients = ();

my $server = new IO::Socket::INET(
Timeout => 7200,
Proto => "tcp",
LocalPort => 12345,
Reuse => 1,
Listen => 3
);

while (1) {
my $client;

do {
$client = $server->accept;
} until ( defined($client) );

$server->recv($user, 300);

my $peerhost = $client->peerhost();
print "accepted a client $client, $peerhost, username = $user \n";
my $fileno = fileno $client;
push (@clients, $fileno);
#spawn a thread here for each client
my $thr = threads->new( \&process_it, $client, $fileno,
$peerhost )->detach();
}
# end of main thread

sub process_it {
my ($lclient,$lfileno,$lpeer) = @_; #local client

if($lclient->connected){
# Here you can do your stuff
# I use have the server talk to the client
# via print $client and while(<$lclient>)
print $lclient "$lpeer->Welcome to server\n";

while(<$lclient>){
# print $lclient "$lpeer->$_\n";
print "clients-> @clients\n";

foreach my $fn (@clients) {
open my $fh, ">&=$fn" or warn $! and die;
print $fh "$_"
}

}

}

#close filehandle before detached thread dies out
close( $lclient);
#remove multi-echo-clients from echo list
@clients = grep {$_ !~ $lfileno} @clients;

}

 

[zentara]

THanks alot, those scripts are very simple compared to that confusing
script I was trying to write. What I am trying to do is send the user
name to the server so that it can be added to the client list. I dont
quit get how to do this and could use some help.

Well what you need to do, is watch the first few sockets transactions,
which will pass the username and password. Then the server should accept
the connection only if the correct username/password is sent.

So you should probably do the popup asking for username/password, right
at the program start. Then when you try to establish the socket
connection, send the user=$username|pass=$password to the server.
If the server likes it, it will send the welcome message.

I don't feel like writing it now for you, but I do have a Tk version at
http://perlmonks.org?node_id=387351

It uses Net::EasyTCP, which is different than a pure socket connection,
but you can see how the password system works.

To be honest, you will never learn how this stuff works, until
you spend a few hours ( I spent 20 ) experimenting with the code.
Otherwise you will constantly be asking us to do your troubleshooting.

Jump in there, and send user/pass combo, and see what happens.
When you can receive the user/pass at the server, what is the next step?
You verify it. If verified, you connect as normal. otherwise don't allow
the connection.

Goodluck, and happy hacking,
zentara