#!perl -w
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
my $port = scalar(@ARGV) > 0 ? $ARGV[0] : 2323;
$| = 1;
my $listen = IO::Socket::INET->new(Proto => 'tcp',
LocalPort => $port,
Listen => 1,
Reuse => 1)
or die $!;
warn "started on $port\n";
my $select = IO::Select->new($listen);
my @chatters;
# comment out this line on win32
$SIG{'PIPE'} = 'IGNORE';
while(my @ready = $select->can_read) {
# print "going: ".join(', ',map {$_->fileno} @ready) . "\n";
for my $socket (@ready) {
print "$socket ready\n";
if($socket == $listen) {
my $new_socket = $listen->accept;
Chatter->new($new_socket, $select, \@chatters);
} # if
else {
my $chatter = $chatters[$socket->fileno];
if(defined $chatter) {
&{$chatter->nextsub}();
}
else {
print "unknown chatter\n";
}
} # else
} # for
} # while
# ************************************************************
package Chatter;
use strict;
# create new chatter
sub new {
my($class, $socket, $select, $chatters) = @_;
my $self = {
'socket' => $socket,
'select' => $select,
'chatters' => $chatters
};
bless $self,$class;
$chatters->[$socket->fileno] = $self;
$self->select->add($socket);
$self->log("connected");
$self->ask_for_handle;
return $self;
} # new
# ------------------------------------------------------------
sub socket { $_[0]->{'socket'} }
sub select { $_[0]->{'select'} }
sub chatters { $_[0]->{'chatters'} }
sub handle { $_[0]->{'handle'} }
sub nextsub { $_[0]->{'nextsub'} }
# ------------------------------------------------------------
sub ask_for_handle {
my($self) = @_;
my $welcome = <<END;
Welcome to my chat server.
IMPORTANT DIRECTIONS FOR TELNET USERS:
This server doesn\'t speak telnet correctly, so not all telnet clients
will work. If each character you type appears on a separate line, log out
and try a different client. I\'ve tried these clients and they are ok:
- "telnet" on Solaris, Linux, IRIX
- CRT on Windows 95/NT
Microsoft Telnet and Tera Term Pro don\'t work.
To quit, type "/exit" or close your telnet window. Or if you\'re running
telnet from the Unix command line, hit Control-] and then type "close" at
the prompt.
You can get help with "/help"
END
;
$welcome =~ s:\n:\r\n:g;
$self->write($welcome);
$self->write("choose a handle> ");
$self->{'nextsub'} = sub { $self->get_handle };
} # ask_for_handle
# ------------------------------------------------------------
sub get_handle {
my($self) = @_;
# if no nick entered, don't block but return
my $handle = $self->read or return;
$handle =~ tr/ -~//cd;
# check if handle is still available
my $handleFree = 1;
for my $socket ($self->select->handles){
my $chatter = $self->chatters->[$socket->fileno];
if (lc($handle) eq lc($chatter->{handle})){
$handleFree = 0;
} # if
} # for
# selected handle is available
if ($handleFree){
$self->{'handle'} = $handle;
$self->broadcast("*** $handle has connected");
$self->log("handle: $handle");
$self->{'nextsub'} = sub { $self->chat };
} # if
# selected handle is not available any more
else {
$self->write("ERROR: handle $handle is already in use");
$self->write("choose a handle> ");
$self->{'nextsub'} = sub { $self->get_handle };
} # else
} # get_handle
# ------------------------------------------------------------
sub read {
my($self) = @_;
my $buf="";
$self->socket->recv($buf,80);
$self->leave if($buf eq "");
return $buf;
} # read
# ------------------------------------------------------------
sub write {
my($self,$buf) = @_;
$self->socket->send($buf."\r\n") or $self->leave;
} # write
# ------------------------------------------------------------
sub log {
my($self,$msg) = @_;
my ($logfile) = "chat.log";
my $fileno = $self->socket->fileno;
# print "$fileno: $msg\n";
open (LOG, ">>$logfile") or die ("ERROR: could not open LOG $logfile\n");
print (LOG "$fileno: ".($self->{handle} || "").": $msg\n");
close(LOG);
} # log
# ------------------------------------------------------------
sub broadcast {
my($self,$msg) = @_;
for my $socket ($self->select->handles) {
my $chatter = $self->chatters->[$socket->fileno];
$chatter->write("$msg") if(defined $chatter);
} # for
} # broadcast
# ------------------------------------------------------------
sub chat {
my($self) = @_;
my $line = $self->read;
return if ($line eq "");
return if ($line eq "\r\n");
$line =~ tr/ -~//cd;
$self->ParseLine($line);
} # chat
# ------------------------------------------------------------
sub ParseLine {
my ($self, $line) = @_;
my $handle = $self->handle;
my ($cmd, @args) = split(/ +/, $line);
$cmd = lc($cmd);
if ($cmd =~ /^\#/){
my (@args) = ($cmd, @args); $self->msg (\@args);
return;
} # if
if ($cmd !~ s|^/||){
$self->write("** Unknown command. Type /help for help");
# $self->broadcast("$self->{handle}> $line");
return;
} # if
if ($cmd eq "help"){
$self->printHelp(\@args);
}
elsif ($cmd eq "nick"){
$self->changeNick($self->handle, $args[0] || $self->handle);
} # if
elsif (($cmd eq "me") || ($cmd eq "act")){
$self->act($self->handle, join (" ", @args));
} # elsif
elsif ($cmd eq "who"){
$self->who( join (" ", @args));
} # elsif
elsif ($cmd eq "msg"){
$self->msg(\@args);
} # elsif
elsif ($cmd eq "exit"){
$self->leave;
} # elsif
elsif ($cmd eq "join"){
$self->joinChannel($args[0]);
} # elsif
elsif ($cmd eq "part"){
$self->leaveChannel($args[0]);
} # elsif
elsif ($cmd eq "list"){
$self->listChannels;
} # elsif
else {
$self->write("ERROR: unknown command: /$cmd");
} # else
} # ParseLine
# ------------------------------------------------------------
sub printHelp {
my ($self, $argsRef) = @_;
my ($helpLine) = <<"EOH";
Available commands:
- /help displays this help
- /exit leaves the chat
- /join \#channel joins channel with name \#channel
- /list list all existing channels
- /me message ->*** nickname message
- /msg nick message private message to nick
- /msg \#channel message sends a message to all people on a channel
- /nick newnick changes your handle: /nick newnick
- /part \#channel leaves channel with name \#channel
- /who lists all users in chat
- /who \#channel lists all users on channel \#channel
EOH
;
$helpLine =~ s:\n:\r\n:g;
$self->write($helpLine);
} # printHelp
# ------------------------------------------------------------
sub act {
my ($self, $handle, $line) = @_;
unless ($line){
$self->write("** Usage: /me message");
return;
} # unless
$self->log("act");
$self->broadcast("*** $handle $line");
} # act
# ------------------------------------------------------------
sub changeNick {
my ($self, $nick, $newNick) = @_;
# if no nick specified
unless ($newNick){
$self->write("** Usage: /nick newnick");
return;
} # unless
# check if handle is available
my $handleIsFree = 1;
for my $socket ($self->select->handles){
my $chatter = $self->chatters->[$socket->fileno];
if (lc($newNick) eq lc($chatter->{handle})){
$handleIsFree = 0;
} # if
} # for
# if yes
if ($handleIsFree){
$self->{'handle'} = $newNick;
$self->broadcast("** $nick is now known as $newNick");
$self->log("/nick $nick $newNick");
} # if
# if not
else {
$self->write("** ERROR: $newNick already in use");
} # else
} # changeNick
# ------------------------------------------------------------
sub joinChannel {
my ($self, $channel) = @_;
if ((! defined($channel)) || ($channel !~ /^\#/)){
$self->write("** Usage: /join \#channelname");
return;
} # if
my (@users) = ();
if (defined $main::channels{$channel}){
(@users) = @{ $main::channels{$channel} };
} # if
if (grep(/^$self->{handle}$/, @users)){
$self->write("** You are already on channel $channel");
return;
} # if
push (@users, $self->{handle});
$main::channels{$channel} = \@users;
$self->who($channel);
} # joinChannel
# ------------------------------------------------------------
sub leave {
my($self) = @_;
print "leave called\n";
my $handle = $self->handle;
# leave all channels
foreach (keys %main::channels){
$self->leaveChannel($_);
} # foreach
$self->chatters->[$self->socket->fileno] = undef;
$self->select->remove($self->socket);
$self->broadcast("[$handle left]") if(defined $handle);
$self->log("disconnected");
$self->socket->close;
} # leave
# ------------------------------------------------------------
sub leaveChannel {
my ($self, $channel) = @_;
return unless $channel;
my @users = @{ $main::channels{$channel} };
if (grep (s/^$self->{handle}$//i, @users)){
@users = sort(@users);
shift(@users) if $users[0] eq "";
$main::channels{$channel} = \@users;
$self->broadcast("*** $self->{handle} has left channel $channel");
} # if
} # leaveChannel
# ------------------------------------------------------------
sub listChannels {
my ($self) = @_;
$self->write(join(" ", keys %main::channels));
} # listchannels
# ------------------------------------------------------------
sub msg {
my ($self, $wordsRef) = @_;
my ($target, @words) = @$wordsRef;
my $err = 1;
my $targetChatter;
unless ($target && $words[0]){
$self->write("** Usage: /msg nick message");
return;
} # unless
$self->log("msg");
# message to a channel
if ($target =~ /^\#/){
unless (defined $main::channels{$target}){
$self->write("** ERROR: no such channel");
return;
} # unless
my @users = @{ $main::channels{$target} };
foreach (@users){
for my $socket ($self->select->handles){
my $chatter = $self->chatters->[$socket->fileno];
if (lc($chatter->{handle}) eq lc($_)){
$chatter->write("$target/$self->{handle}> ".join(" ", @words));
} # if
} # for
} # foreach
} # if
# private message
else {
for my $socket ($self->select->handles){
my $chatter = $self->chatters->[$socket->fileno];
if (lc($target) eq lc($chatter->{handle})){
$err = 0;
$targetChatter = $chatter;
} # if
} # for
if ($err){
$self->write("*** no such nick: $target");
} # if
else {
$self->log("msg from $self->{handle} to $targetChatter->{handle}: ".join(" ", @words));
$targetChatter->write("Msg/$self->{handle}: ".join(" ", @words));
} # else
} # else
} # msg
# ------------------------------------------------------------
sub who {
my ($self, $channel) = @_;
$self->log("who");
# if no channel given
unless ($channel){
for my $socket ($self->select->handles){
my $chatter = $self->chatters->[$socket->fileno];
$self->write($chatter->{handle}) if defined $chatter->{handle};
} # for
return;
} # for
# if invalid channel given
if ($channel !~ /^\#/){
$self->write("** Usage: /who or /who \#channelname");
return;
} # if
# if non-existing channel given
unless (defined $main::channels{$channel}){
$self->write("** No such channel $channel found");
} # unless
# channel must be valid
else {
my @users = @{ $main::channels{$channel} };
if (@users){
$self->write("Users on channel $channel:");
$self->write(join(" ", sort (@users)));
} # if
} # else
} # who
# ------------------------------------------------------------