in reply to Re: Building a chat server and client
in thread Building a chat server and client

Thanks for the replies, they are very helpful! But I'm still lost.
The server should listen for incoming messages. When it receives messages it should then broadcast them to all the connected users. Also, the server is in charge of the connected users. This entails checking for duplicate usernames and informing the connected users of new and leaving users. The thing is that I don't know where to start in this whole diboggle. I'm not familiar with sockets and writing server scripts.

For the client it should connect to the server and share its user name. The users connection should be rejected if there is a similar username or should be forced to have a different name. with that taken care of, it should work just like a chat client does. you type and then the message is sent to the server where it is broadcast to all servers even the owner.

I have been trying to build the scripts from scratch and so far I have a client: 

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

my $SERVER = "Deadpickle-hobo";
my $SEND_PORT = 5152;
my $line;

my $send_socket = IO::Socket::INET->new(
                            PeerAddr => $SERVER,
                            PeerPort => $SEND_PORT, 
                            Proto => 'tcp',
                            Reuse => 1
) or die "socket: $@";

#ask for the user name and send it to the server
#in order to verifiy that its unique
print "Username:";
my $user = <>;
$send_socket->send($user);


$send_socket->recv($line, 80);
print $line;

$send_socket->recv($line, 80);
print $line;

[download]
and a server: 
#!/usr/bin/perl -w

use strict;
use IO::Socket;
use IO::Select;

#variables
my $LISTEN_PORT = 5152;
my $user;
my @users;
my $fh;
my @ready;

#open a new socket
my $listening_socket = IO::Socket::INET->new(
                            LocalPort => $LISTEN_PORT, 
                            Proto => 'tcp',
                            Listen => 1,
                            Reuse => 1
) or die "socket: $@";

my $select = new IO::Select($listening_socket);

#wait for a client to connect to the server
print "Awaiting TCP messages on port $LISTEN_PORT\n" if $listening_soc
+ket;

while(@ready = $select->can_read) {
    foreach $fh (@ready) {
        if($fh == $listening_socket) {
            
            #Create a new socket and get the user ID
            my $new = $listening_socket->accept;
            $new->recv($user, 80);
            
            #Check the newly connected user for copies
            if (my $new_user = grep($user, @users)) {
                
            }
            else {
                $select->add($new);
                push(@users, $user);
                $new->send("Hello\n");
                $new->send("@users");
            }
        }
        else {
            # Process socket
            # Maybe we have finished with the socket
            $select->remove($fh);
            $fh->close;
        }
    }
}

print "END\n";

[download]
I am requesting for help on implementing the ideas I mentioned above.

Replies are listed 'Best First'.
Re^3: Building a chat server and client
by zentara (Cardinal) on Jan 10, 2008 at 15:56 UTC
    I'm not in the mood right now for writing your code, but study the following tcp example, it shows the basic idea, You need to push the socket filehandle and an associated name into an array or hash, then loop thru them to send to all socket filehandles. I don't believe you can just send to an array of filehandles, like you show with $new->send("@users");

    Also you need to listen to more than 1, for a multiecho operation. 

    #!/usr/bin/perl
#server
use IO::Socket;
use IO::Select;

my @sockets;
my $machine_addr = 'localhost';
$main_sock = new IO::Socket::INET(LocalAddr=>$machine_addr,
      LocalPort=>1200,
      Proto=>'tcp',
      Listen=>3,
            Reuse=>1,
            );

die "Could not connect: $!" unless $main_sock;
print "Starting Server\n";

$readable_handles = new IO::Select();
$readable_handles->add($main_sock);

while (1)
{
  ($new_readable) = IO::Select->select($readable_handles, undef, undef
+, 0);

  foreach $sock (@$new_readable)
  {
    if ($sock == $main_sock)
    {
      $new_sock = $sock->accept();
      $readable_handles->add($new_sock);
    }
    else
    {
      $buf = <$sock>;
      if ($buf)
      { 
        print "$buf\n";
        my @sockets = $readable_handles->can_write();
    #print $sock "You sent $buf\n";
    foreach my $sck(@sockets){print $sck "$buf\n";}
        
      }
      else
      {
        $readable_handles->remove($sock);
        close($sock);
      }
    }
  }

}


print "Terminating Server\n";
close $main_sock;
getc();

    [download]
    #!/usr/bin/perl -w
# interactive client
use strict;
use IO::Socket;

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

( $host, $port ) = ('localhost',1200);

my $name = shift || '';
if($name eq ''){print "What's your name?\n"}
chomp ($name = <>);


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

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

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

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

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

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

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]
[select]
      I'm finally getting it (I'm a little slow). Here is a Gtk2 script that loads the client GUI and asks for a username. But I have ran into a problem, I receive this error:
      *** unhandled exception in callback:
      *** Undefined subroutine &main:: called at chat-client.pl line 54.
      *** ignoring at chat-client.pl line 54.
      This error seems to stem from the wait_for_msg timer that I have added and the error references the Gtk2->main loop. When the timer is commented out the program works fine. What can I do. 
       #!/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;


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


#my $timer_waiting = Glib::Timeout->add(100, wait_for_msg());

#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();

#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 $server_user = Gtk2::Entry->new();
  $server_user->set_text('uas');
  my $host = Gtk2::Entry->new();
  $host->set_text('updraft.unl.edu');
  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 {my $tag = $chat_us
+er->get_text; $dialog_window->destroy; $buffer->insert(($buffer->get_
+end_iter), "Username: $tag...\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 $ho
+st:$port...\n");

    my $conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $p
+ort, 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");
      
      #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!"};
  
  $buffer->insert(($buffer->get_end_iter), "$error\n");
  
  my $error_dialog = Gtk2::MessageDialog->new($main_window, 'destroy-w
+ith-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);

    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);
  }
  }
}

      [download]

      UPDATE: I accidentally clipped the use references.
[reply]
[d/l]
        I tried your script, and it needed 
        use Gtk2 qw (init');
use IO::Socket;

        [download]
        to get it to run. Then, 
          my $conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $por
+t, Proto => 'tcp') or popup_err(1);

        [download]
        caused the error to popup. Remove the popup_err(1) and it seems to start.

        I didn't try to debug it any further, because the tie %ready looked kind of complex to me.

        I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]
[select]
        I have ran into a wall. When I run the client, Login and then try to type and send a message I get a print to closed filehandle GEN0 error. This error is in the send_msg_all print line and seems to involve the socket variable $conn. I can't seem to figure out how the filehandle is close. This error seems to be born from only the client script. I hope someone here can help me out.

        WARNING: the scripts is long. I couldnt slim it down since the login is required by the server. But I do hope that the flow chart will help weed out the confusion.

        Read more... (10 kB)
[reply]
[d/l]

In Section Seekers of Perl Wisdom