Chat client/server print failed

Discussion in 'Perl Misc' started by deadpickle, Jan 16, 2008.

  1. deadpickle

    deadpickle Guest

    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::passwd
    # 02 - Register New User 2::username::passwd
    # 03 - Terminate Program ....... 3::username::passwd
    # 04 - Logoff Server 4::username::passwd
    # 05 - Get Logged Users ....... 5::username::passwd
    # 06 - Message another user
    6::username::passwd::rcpt::message
    # 07 - Global message ....... 7::username::passwd::message
    # 08 - Query buddy 8::username::passwd::rcpt
    # 09 - Update Buddy Info .......
    9::username::passwd::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'};
    }
    }
    }
     
    deadpickle, Jan 16, 2008
    #1
    1. Advertising

  2. deadpickle

    smallpond Guest

    On Jan 15, 7:32 pm, deadpickle <> wrote:
    > 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::passwd
    > # 02 - Register New User 2::username::passwd
    > # 03 - Terminate Program ....... 3::username::passwd
    > # 04 - Logoff Server 4::username::passwd
    > # 05 - Get Logged Users ....... 5::username::passwd
    > # 06 - Message another user
    > 6::username::passwd::rcpt::message
    > # 07 - Global message ....... 7::username::passwd::message
    > # 08 - Query buddy 8::username::passwd::rcpt
    > # 09 - Update Buddy Info .......
    > 9::username::passwd::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
     
    smallpond, Jan 16, 2008
    #2
    1. Advertising

  3. deadpickle

    Ted Zlatanov Guest

    On Wed, 16 Jan 2008 08:14:09 -0800 (PST) smallpond <> wrote:

    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
     
    Ted Zlatanov, Jan 16, 2008
    #3
  4. deadpickle

    smallpond Guest

    On Jan 16, 1:02 pm, Ted Zlatanov <> wrote:
    > On Wed, 16 Jan 2008 08:14:09 -0800 (PST) smallpond <> wrote:
    >
    > 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
     
    smallpond, Jan 16, 2008
    #4
  5. deadpickle

    zentara Guest

    On Tue, 15 Jan 2008 16:32:52 -0800 (PST), deadpickle
    <> wrote:

    >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




    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 16, 2008
    #5
  6. deadpickle

    zentara Guest

    On Wed, 16 Jan 2008 15:46:52 -0500, zentara <>
    wrote:

    >On Tue, 15 Jan 2008 16:32:52 -0800 (PST), deadpickle
    ><> wrote:
    >
    >>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.


    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







    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 17, 2008
    #6
  7. deadpickle

    deadpickle Guest

    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, Jan 17, 2008
    #7
  8. deadpickle

    deadpickle Guest

    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?
     
    deadpickle, Jan 18, 2008
    #8
  9. deadpickle

    zentara Guest

    On Fri, 18 Jan 2008 07:59:10 -0800 (PST), deadpickle
    <> wrote:

    >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


    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 18, 2008
    #9
  10. deadpickle

    zentara Guest

    On Fri, 18 Jan 2008 07:59:10 -0800 (PST), deadpickle
    <> wrote:

    >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




    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 20, 2008
    #10
  11. deadpickle

    deadpickle Guest

    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;
    }
     
    deadpickle, Jan 22, 2008
    #11
  12. deadpickle

    Ben Morrow Guest

    Quoth 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.


    <snip>
    >
    > $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.

    <snip>
    > 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];

    <snip>
    > $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
     
    Ben Morrow, Jan 22, 2008
    #12
  13. deadpickle

    zentara Guest

    On Tue, 22 Jan 2008 07:55:23 -0800 (PST), deadpickle
    <> wrote:

    >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

    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 23, 2008
    #13
  14. deadpickle

    deadpickle Guest

    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;

    }
     
    deadpickle, Jan 27, 2008
    #14
  15. deadpickle

    zentara Guest

    On Sun, 27 Jan 2008 09:38:21 -0800 (PST), deadpickle
    <> wrote:

    >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


    --
    I'm not really a human, but I play one on earth.
    http://zentara.net/japh.html
     
    zentara, Jan 27, 2008
    #15
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Replies:
    0
    Views:
    2,199
  2. Jaspreet
    Replies:
    0
    Views:
    686
    Jaspreet
    Sep 18, 2004
  3. Marek Zawadzki
    Replies:
    1
    Views:
    1,157
    Ashtar
    Jul 28, 2006
  4. Dhiraj Girdhar

    Chat server telnet client problem

    Dhiraj Girdhar, Jul 5, 2007, in forum: Ruby
    Replies:
    0
    Views:
    164
    Dhiraj Girdhar
    Jul 5, 2007
  5. HadsS
    Replies:
    8
    Views:
    161
    Glen Holcomb
    Apr 15, 2008
Loading...

Share This Page