1: This is based on a python script I found out on the net.
2: I have not writen a client but it works with unix telnet clients.
3:
4: chat.pl...
5:
6: #!/usr/bin/perl
7:
8: use IO::Socket;
9: use IO::Select;
10:
11: use Userlist;
12:
13: # Fork off...
14: $pid = fork();
15: exit if ($pid);
16:
17: #Turn off buffering
18: $|++;
19:
20: my $quit = 0;
21:
22: # Handle the control-c
23: $SIG{INT} = sub {$quit++};
24:
25: my $listen = IO::Socket::INET->new(
26: LocalPort => 8080,
27: Listen => 20,
28: Proto => 'tcp',
29: Reuse => 1,
30: Timeout => 60*60
31: );
32:
33: $read = IO::Select->new();
34: $read->add($listen);
35:
36: while (!$quit) {
37: my @ready = $read->can_read;
38:
39: foreach $selected (@ready) {
40: if ($selected == $listen) {
41: my $conn = $listen->accept;
42: $ip = $conn->peerhost;
43:
44: # Create new object
45: $user = Userlist->new($conn);
46:
47: # Get the user's name
48: $name = $user->getName;
49: $count = push(@users,$user);
50: print $conn $count."-".$name."-".$ip."\n";
51: $read->add($conn) if $conn;
52: } else {
53: # Get input from who's ready
54: $buffer = <$selected>;
55:
56: # Send message to all users
57: $user->broadcast($buffer,$selected,\@users);
58: }
59: }
60: }
61:
62:
63: Userlist.pm...
64:
65: package Userlist;
66:
67: sub new {
68:
69: $self = shift;
70: $obj = {
71: USER => shift,
72: NAME => ''
73: };
74:
75: return bless $obj,$self;
76: }
77:
78: sub conn {
79: $self = shift;
80: return $self->{USER};
81: }
82:
83: sub getName {
84: $self = shift;
85: $conn = $self->{USER};
86:
87: print $conn "Name: ";
88: $name = <$conn>;
89: $name =~ s/\s+$//;
90:
91: $self->{NAME} = $name;
92: return $self->{NAME};
93: }
94:
95: sub name {
96: $self = shift;
97: return $self->{NAME};
98: }
99:
100: # I'm not really sure if this is the best place to make this
101: # sub, but its the only way I can think of to get the name
102: # of the user that sent the message.
103:
104:
105: sub broadcast {
106: $self = shift;
107: $buffer = shift;
108: $selected = shift;
109: $users = shift;
110: if ($buffer) {
111: foreach $client (@$users) {
112: $connection = $client->conn();
113: $name = $self->{NAME} if ($connection == $selected);
114: exit(0) if ($buffer =~ /quit/i);
115: print $connection $name.": ".$buffer;
116: }
117: }
118: }
119: 1;
120:
121:
