Important note:
The version of the chapter presented here was converted from the
pre-copyedited manuscript. This means that it may contain
typographical errors, mistakes in grammar and spelling, and possibly
even code errors that are not present in the published book.
Network Programming in Perl: Home Page
TCP provides reliable connection-oriented network service, but at the cost of some overhead in setting up and tearing down connections and maintaining the fidelity of the data stream. As we have seen there's also programmer overhead. TCP server applications have to go to some lengths to handle multiple concurrent clients.
Sometimes you don't need 100% reliability. Perhaps the application can tolerate an occasional dropped or out of order packet, or perhaps it can simply retransmit a message that hasn't been acknowledged. In such cases UDP offers a simple, lightweight solution.
This chapter will develop a useful UDP version of an Internet chat system. Like other chat systems that might be familiar to you, the software consists of a server that manages multiple discussion groups called ``channels.'' Users log into the server using a command-line client, join whatever channels they are interested in, and begin exchanging public messages. Any public message that a user sends is echoed by the server to all members of his current channel. The server also supports private messages, which are sent to a single user only using his login name. The system notifies users whenever someone joins or departs one of the channels they are monitoring.
Figure 19.1 shows a sample session with the chat client. As always, keyboard input is in a bold font while output from the program are normal font.
We begin by invoking the client with the name of the server to connect to. The program prompts us for a nickname, logs in, and prints a confirmation message. We then issue the /channels command to fetch the list of all available channels. This client, like certain other command-line chat clients, expects all commands to begin with the ``/'' character. Anything else we type is assumed to be a public message to be transmitted to the current channel. The system replies with the names of five channels, a brief description, and the number of users that belong to each one (a single user may be a member of multiple channels at once, so the sum of these numbers may not reflect the total numbers of users on the system).
We join the Weather channel using the /join command, at which point we begin to see public messages from other users as well as join and departure notifications. We participate briefly in the conversation and then issue the /users command to view the users currently belonging to the channel. This command lists user's nicknames, the length of time that they have been on the system, and the channels that they are currently subscribed to.
We send a private message to one of the users using the /private command, /join the Hobbies channel briefly, and finally log out using /quit.
% chat_client.pl pesto.lsjs.org
Your nickname: lincoln
trying to log in (1)...
Log in successful. Welcome lincoln.
/channels
[Gardening] For those with the green thumb 1 users
[Hobbies] For hobbyists of all types 2 users
[Pets] For our furry and feathered friends 0 users
[Weather] Talk about the weather 2 users
[CurrentEvents] Discussion of current events 0 users
/join weather
Welcome to the Weather Channel (3 users)
rufus [Weather]: is it true about the rain in spain?
<bayla has entered Weather>
beanieboy [Weather]: spain? what about spain?
rufus [Weather]: that it's always ya' know raining there
I don't know about spain, but it's raining in NY right now
lincoln [Weather]: I don't know about spain, but it's raining in NY right now
bayla [Weather]: outa here
<bayla has left Weather>
<wondergirl has entered Weather>
/users
beanieboy (on 00:05:24) Channels: Weather
wondergirl (on 00:04:14) Channels: Weather Gardening Hobbies
lincoln (on 00:02:15) Channels: Weather
rufus (on 00:04:47) Channels: Weather
/private wondergirl why do you call yourself "wondergirl"?
wondergirl [**private**]: that's for you to figure out
/join hobbies
Welcome to the Hobbies Channel (3 users)
bayla [Hobbies]: needlepoint? ;-(
bayla [Hobbies]: hi lincoln, decided to join us?
yes, weather was a bore
lincoln [Hobbies]: yes, weather was a bore
beanieboy [Weather]: it's snowing in denver
/quit
In addition to the commands shown in the example, there's also a /part command that allows one to depart a channel. Otherwise the list of subscribed channels just grows every time you join one.
The chat system is message oriented. Clients send prearranged messages to the server to log in, join a channel, send a public message, and so forth. The server sends messages back to the client whenever an event of interest occurs, such as another user posting a public message to a subscribed channel.
In this system, all communications between client and server is via a
series of binary messages. Each message consists of an integer event
code packed together with a message string. For example, to create a
public message using the SEND_PUBLIC message constant, we call pack()
with the format ``na*'':
$message = pack("na*",SEND_PUBLIC,"hello, anyone here?");
to retrieve the code and the message string, we call unpack() with the
same format:
($code,$data) = unpack("na*",$message);
We use the ``n'' format to pack the event code in platform-independent ``network'' byte order. This ensures that clients and servers can communicate even if their hosts don't share the same byte order.
The various event codes are defined as constants in a .pm file that is shared between the client and server source trees. The code for packing and unpacking messages is encapsulated in a module named ChatObjects::Comm. A brief description of each of the messages is given in Table 10.1.
Table 10.1: event codes
Code Argument Description
ERROR <error message> Server reports an error
LOGIN_REQ <nickname> Client requests a login
LOGIN_ACK <nickname> Server acknowledges successful login
LOGOFF <nickname> Client signals a signoff
JOIN_REQ <title> Client requests to join channel <title>
JOIN_ACK <title> <count> Server acknowledges join of channel <title>,
currently containing <count> users
PART_REQ <title> Client requests to depart channel
PART_ACK <title> Server acknowledges departure
SEND_PUBLIC <text> Client sends public message
PUBLIC_MSG <title> <user> <text> User <user> has sent message <text> on channel <title>
SEND_PRIVATE <user> <text> Client sends private message <text> to user <user>
PRIVATE_MSG <user> <text> User <user> has sent private message <text>
USER_JOINS <channel> <user> User has joined indicated channel
USER_PARTS <channel> <user> User has departed indicated channel
LIST_CHANNELS Client requests a list of all channel titles
CHANNEL_ITEM <channel> <count> <desc>
Sent in response to a LIST_CHANNELS request.
Channel <channel> has <count> users and description <desc>
LIST_USERS Client requests a list of users in current channel
USER_ITEM <user> <timeon> <channel 1> <channel 2>...<channel n>
Sent in response to a LIST_USERS request. User <user>
has been online for <timeon> seconds and is subscribed
to channels <channel1> through <channeln>
On the one hand the client will only be communicating with a single
server. On the other, it needs to process input from both the server
and the user. It uses a simple select() loop to multiplex between the
two sources of input.
The object classes used by the server are designed for subclassing. This will enable us to modify the chat system to take advantage of multicasting in the next chapter.
We'll look at the client program first (Figure 19.2). It has two tasks: it accepts commands from the user and transmits them in the proper format to the chat server, and it accepts messages from server and transforms them into human-readable output for the user.
The client uses two dispatch tables to handle user commands and server events. %COMMANDS dispatches on commands typed by the user. Each key is the text of a command (e.g. ``join'') and each value is an anonymous subroutine that is invoked when the command is issued. In most cases, the subroutine simply sends the appropriate event code to the server. Whenever the user types a command, the client parses out the command and any optional arguments, and then passes the command to the dispatch table.
The %MESSAGES global is the corresponding dispatch table for messages received from the server. It has a similar structure to %COMMANDS, except that the keys are numeric event codes.
exit() to perform a clean shutdown. An END{} clause defined
at the bottom of the script logs out of the server before the client
shuts down.
We also define two globals. $nickname contains the user's
nickname, and $server contains the ChatObjects::Comm wrapper.
%COMMANDS and %MESSAGES dispatch tables.
When the main loop dispatches on a user command, it looks the command
up in the %COMMAND table and calls the anonymous subroutine it finds
there, passing it any text that followed the command on the line.
Here is a typical %COMMANDS entry:
join => sub { $server->send_event(JOIN_REQ,shift) },
This is saying that when the user issues the /join command, the
client should call the $server object's send_event() method with a
event code of of JOIN_REQ and whatever arguments followed the
command. In this case the argument is expected to be the name of a
channel to join.
A typical entry in %MESSAGES is this one:
PUBLIC_MSG() => \&public_msg,
This entry tells the script to invoke the subroutine public_msg() when
the event code PUBLIC_MSG is received. The parentheses following
the PUBLIC_MSG constant are necessary because otherwise Perl assumes
that anything to the left of a => symbol is a string.
When the script dispatches to one of these subroutines, it passes the event code as the first argument and the message text as the second. Passing the event code allows the same subroutine to handle different messages. For example, handling of the USER_JOINS and USER_PARTS messages, which are sent to notify the client that another user has joined or departed a channel respectively, is sufficiently similar that it is handled by the same subroutine, join_part().
new() method. When we go over this module we
shall see that its new() method is a thin wrapper that takes whatever
parameters are passed to it, adds Proto => 'udp', and passes
the set to IO::Socket::INET->new().
Notice that we are passing the PeerAddr argument to the
IO::Socket::INET->new(), causing IO::Socket to attempt a connect()
with the indicated server host. On a TCP socket, connect() will
establish a long-term connection to the remote host, but since this is
a UDP socket the behavior of connect() is rather different. The
operating system doesn't try to contact the remote host immediately,
but just records its destination address in the socket. This address
will be used as the destination whenever we call send(), ignoring any
destination address that we provide on the argument list. Recall from
Chapter XX that the other effect of connecting a UDP socket is to
filter out any messages that are sent to the socket from arbitrary
hosts. Since the client is only going exchange messages with the one
server, both these behaviors are what we want.
do_login() to prompt the user
to log in and send the appropriate login message to the server. If
successful, this subroutine returns the user's chosen nickname.
Select() will let us watch both
handles for incoming data.
We create a new IO::Select object initialized to a set containing both
the server socket and STDIN. The server socket is wrapped inside the
ChatObjects::Comm object, so we must retrieve the handle by calling
the object's socket() method.
Each time through the loop we call $select->can_read() to recover
those handles that have data to read. If one of the handles is STDIN,
then we invoke the subroutine do_user() in order to process user
commands. Otherwise we invoke do_server() to process messages
received on the socket.
Notice that the can_read() method call will indicate that STDIN is
ready for reading if the user happened to close the stream by pressing
the end-of-file key. do_user() specifically checks for the EOF
condition and returns false. When this happens we exit the loop,
terminating the program.
do_user() subroutine reads commands from standard input and
dispatches on them. Its argument is the \*STDIN glob reference
returned by select(). Because of the bad interactions between
select() and stdio buffering, we can't use the angle-bracket operator
to read from STDIN. Instead, we use sysread() to fetch the longest
plausible line from standard input and assume that it will correspond
to a line of input. This is a valid assumption provided that the user
is typing at a terminal. If we wanted to take commands from a file or
pipe, we could use the Readline wrapper from Chapter XX.
Each command is parsed into a command and its argument. Any command that doesn't begin with a ``/'' is assumed to be a public message to send to the current channel. Internally we treat this as a command named ``public'' and use the entire command line as its arguments.
We look up the command in the %COMMANDS dispatch table and issue an
error message if it isn't found. Otherwise we invoke the returned
subroutine, passing it the command arguments, if any. Most commands
end up sending a message to the server by calling the global
$server object's send_event() method.
do_server() method is called to handle an incoming message from
the server. The argument it receives from the select() loop is the
socket handle. We don't want to work with the socket directly, so we
call the static method sock2server() in the ChatObjects::Comm module
in order to retrieve the corresponding ChatObjects::Comm object.
We call the ChatObjects::Comm object's recv_event() method to
receive a message from the server and parse it into a event code and
data. We use the code code to look up a handler in the %MESSAGES
dispatch table. If one is found, we invoke it. Otherwise we print a
warning. After invoking the subroutine, do_server() returns the
event code as its function result.
*Footnote: It would be simpler to use the global $server object directly here, but this indirect method bears dividends in the multicast version of the chat system developed in the next chapter.
do_login() subroutine first sends a LOGOFF event if the
$nickname global is already defined. It then prompts the user for
a login name by calling the get_nickname() subroutine, and sends a
LOGIN_REQ message to the server.
The subroutine now waits for a LOGIN_ACK from the server. It is
possible for either the request or the acknowledgement to get lost in
transit, so do_login() repeats the login several times, each time
using select() with a six second timeout to wait for a response. If
no LOGIN_ACK is received after five tries, do_login() gives up.
list_channel() subroutine, which is called when the
client receives a CHANNEL_ITEM message carrying information about a
chat channel that the user can join. The event data in this case
consists of the channel title, a count of the number of users
subscribed to it, and a brief description of the channel's topic. The
subroutine converts this information into a nicely formatted table
entry and prints it to standard output.
Notice that the event code is provided as the first argument to
list_channel() and similar routines. This allows some subroutines to
handle similar messages, such as the join_part() subroutine which
handles both JOIN_ACK and PART_ACK messages.
0 #!/usr/bin/perl -w 1 # file: chat_client.pl 2 # chat client using UDP 3 use strict; 4 use IO::Socket; 5 use IO::Select; 6 use ChatObjects::ChatCodes; 7 use ChatObjects::Comm;
8 $SIG{INT} = $SIG{TERM} = sub { exit 0 };
9 my ($nickname,$server);
10 # dispatch table for commands from the user
11 my %COMMANDS = (
12 channels => sub { $server->send_event(LIST_CHANNELS) },
13 join => sub { $server->send_event(JOIN_REQ,shift) },
14 part => sub { $server->send_event(PART_REQ,shift) },
15 users => sub { $server->send_event(LIST_USERS) },
16 public => sub { $server->send_event(SEND_PUBLIC,shift) },
17 private => sub { $server->send_event(SEND_PRIVATE,shift) },
18 login => sub { $nickname = do_login() },
19 quit => sub { undef },
20 );
21 # dispatch table for messages from the server 22 my %MESSAGES = ( 23 ERROR() => \&error, 24 LOGIN_ACK() => \&login_ack, 25 JOIN_ACK() => \&join_part, 26 PART_ACK() => \&join_part, 27 PUBLIC_MSG() => \&public_msg, 28 PRIVATE_MSG() => \&private_msg, 29 USER_JOINS() => \&user_join_part, 30 USER_PARTS() => \&user_join_part, 31 CHANNEL_ITEM() => \&list_channel, 32 USER_ITEM() => \&list_user, 33 );
34 # Create and initialize the UDP socket 35 my $servaddr = shift || 'localhost'; 36 my $servport = shift || 2027; 37 $server = ChatObjects::Comm->new(PeerAddr => "$servaddr:$servport") or die $@;
38 # Try to log in 39 $nickname = do_login(); 40 die "Can't log in.\n" unless $nickname;
41 # Read commands from the user and messages from the server
42 my $select = IO::Select->new($server->socket,\*STDIN);
43 LOOP:
44 while (1) {
45 my @ready = $select->can_read;
46 foreach (@ready) {
47 if ($_ eq \*STDIN) {
48 do_user(\*STDIN) || last LOOP;
49 } else {
50 do_server($_);
51 }
52 }
53 }
54 # called to handle a command from the user
55 sub do_user {
56 my $h = shift;
57 my $data;
58 return unless sysread($h,$data,1024); # longest line
59 return 1 unless $data =~ /\S+/;
60 chomp($data);
61 my($command,$args) = $data =~ m!^/(\S+)\s*(.*)!;
62 ($command,$args) = ('public',$data) unless $command;
63 my $sub = $COMMANDS{lc $command};
64 return warn "$command: unknown command\n" unless $sub;
65 return $sub->($args);
66 }
67 # called to handle a message from the server
68 sub do_server {
69 die "invalid socket" unless my $s = ChatObjects::Comm->sock2server(shift);
70 die "can't receive: $!" unless
71 my ($mess,$args) = $s->recv_event;
72 my $sub = $MESSAGES{$mess} || return warn "$mess: unknown message from server\n";
73 $sub->($mess,$args);
74 return $mess;
75 }
76 # try to log in (repeatedly)
77 sub do_login {
78 $server->send_event(LOGOFF,$nickname) if $nickname;
79 my $nick = get_nickname(); # read from user
80 my $select = IO::Select->new($server->socket);
81 for (my $count=1; $count <= 5; $count++) {
82 warn "trying to log in ($count)...\n";
83 $server->send_event(LOGIN_REQ,$nick);
84 next unless $select->can_read(6);
85 return $nick if do_server($server->socket) == LOGIN_ACK;
86 $nick = get_nickname();
87 }
88 }
89 # prompt user for his nickname
90 sub get_nickname {
91 while (1) {
92 local $| = 1;
93 print "Your nickname: ";
94 last unless defined(my $nick = <STDIN>);
95 chomp($nick);
96 return $nick if $nick =~ /^\S+$/;
97 warn "Invalid nickname. Must contain no spaces.\n";
98 }
99 }
100 # handle an error message from server
101 sub error {
102 my ($code,$args) = @_;
103 print "\t** ERROR: $args **\n";
104 }
105 # handle login acknowledgement from server
106 sub login_ack {
107 my ($code,$nickname) = @_;
108 print "\tLog in successful. Welcome $nickname.\n";
109 }
110 # handle channel join/part messages from server
111 sub join_part {
112 my ($code,$msg) = @_;
113 my ($title,$users) = $msg =~ /^(\S+) (\d+)/;
114 print $code == JOIN_ACK
115 ? "\tWelcome to the $title Channel ($users users)\n"
116 : "\tYou have left the $title Channel\n";
117 }
118 # handle channel listing messages from server
119 sub list_channel {
120 my ($code,$msg) = @_;
121 my ($title,$count,$description) = $msg =~ /^(\S+) (\d+) (.+)/;
122 printf "\t%-20s %-40s %3d users\n","[$title]",$description,$count;
123 }
124 # handle a public message from server
125 sub public_msg {
126 my ($code,$msg) = @_;
127 my ($channel,$user,$text) = $msg =~ /^(\S+) (\S+) (.*)/;
128 print "\t$user [$channel]: $text\n";
129 }
130 # handle a private message from server
131 sub private_msg {
132 my ($code,$msg) = @_;
133 my ($user,$text) = $msg =~ /^(\S+) (.*)/;
134 print "\t$user [**private**]: $text\n";
135 }
136 # handle user join/part messages from server
137 sub user_join_part {
138 my ($code,$msg) = @_;
139 my $verb = $code == USER_JOINS ? 'has entered' : 'has left';
140 my ($channel,$user) = $msg =~ /^(\S+) (\S+)/;
141 print "\t<$user $verb $channel>\n";
142 }
143 # handle user listing messages from server
144 sub list_user {
145 my ($code,$msg) = @_;
146 my ($user,$timeon,$channels) = $msg =~ /^(\S+) (\d+) (.+)/;
147 my ($hrs,$min,$sec) = format_time($timeon);
148 printf "\t%-15s (on %02d:%02d:%02d) Channels: %s\n",$user,$hrs,$min,$sec,$channels;
149 }
150 # nicely formatted time (hr, min sec)
151 sub format_time {
152 my $sec = shift;
153 my $hours = int( $sec/(60*60) );
154 $sec -= ($hours*60*60);
155 my $min = int( $sec/60 );
156 $sec -= ($min*60);
157 return ($hours,$min,$sec);
158 }
159 END {
160 if (defined $server) {
161 $server->send_event(LOGOFF,$nickname);
162 $server->close;
163 }
164 }
Notice that with the exception of the login message, the client doesn't retransmit any messages or explicitly wait for particular responses. Because this is an interactive application, we rely on the user to notice that the occasional command didn't ``take'' and reissue it. Nor do we mind if an occasional public message doesn't get through.
If necessary, we could add reliability to each outgoing message by
retransmitting it until we got an acknowledgement from the server.
The do_login() subroutine illustrates a simple way of doing this. Of
course this raises the risk of sending the server duplicate messages
in the event that the original message got through and it was the
acknowledgement that was lost in transit. However, duplicate messages
don't matter to the server, because actions such as joining a channel
have no ill effect if repeated.
Let's look at the ChatObjects::Comm module now (Figure 19.3). It is a wrapper around the UDP socket that provides the ability to encode and decode chat system messages.
new() method creates and initializes a new ChatObjects::Comm
object. We call another method, create_socket(), to create the
appropriate socket object, and wrap it in a blessed hash. Before
returning the new object we remember it in the %SERVERS global.
create_socket() methodnew() with a Proto argument of
``udp'' and any other arguments that were passed to us.
sock2server() class method uses %SERVERS to look up a
ChatObjects::Comm object rapidly based on its IO::Socket object.
socket() method does exactly the opposite, returning the
IO::Socket object wrapped by the ChatObjects::Comm.
close() method closes the socket and deletes the
ChatObjects::Comm object from %SERVERS.
send_event() method can be used by the client to send a command to
the server or by the server to send an event code to the client. It
takes three arguments containing the event code, the event data, and
the destination address. The subroutine invokes pack() to pack the
event code and data into the binary form used by the protocol and
sends it down the socket using send(). If a destination address is
provided, we use the four-argument form of send(). Otherwise we
assume that the socket has had a default destination assigned using
connect(), and call the three-argument form of send(). Since send()
is the last call in the subroutine, its result code is implicitly
returned by send_event().
recv_event() function calls recv() to retrieve an event from the
server. The event is unpacked into the event code and data, and these
values are returned along with the peer address.
0 package ChatObjects::Comm; 1 # file: ChatObjects/Comm.pm
2 use strict; 3 use Carp 'croak'; 4 use IO::Socket;
5 my %SERVERS;
6 sub new {
7 my $pack = shift;
8 my $sock = $pack->create_socket(@_) or croak($@);
9 return $SERVERS{$sock} = bless {sock=>$sock},$pack;
10 }
11 sub create_socket { shift; IO::Socket::INET->new(@_,Proto=>'udp') }
12 sub sock2server { shift; return $SERVERS{$_[0]} }
13 sub socket { shift->{sock} }
14 sub close {
15 my $self = shift;
16 delete $SERVERS{$self->socket};
17 close $self->socket;
18 }
19 sub send_event {
20 my $self = shift;
21 my ($code,$text,$address) = @_;
22 $text ||= '';
23 my $msg = pack "na*",$code,$text;
24 if (defined $address) {
25 send($self->socket,$msg,0,$address);
26 } else {
27 send($self->socket,$msg,0);
28 }
29 }
30 sub recv_event {
31 my $self = shift;
32 my $data;
33 return unless my $addr = recv($self->socket,$data,1024,0);
34 my ($code,$text) = unpack("na*",$data);
35 return ($code,$text,$addr);
36 }
37 1;
For completeness, we show the ChatObjects::ChatCodes module in Figure 11.4. It just defines the various constant event codes used by the chat client and server.
0 package ChatObjects::ChatCodes;
1 use strict; 2 require Exporter; 3 use vars qw(@ISA @EXPORT); 4 @ISA = qw(Exporter);
5 @EXPORT = qw( 6 ERROR 7 LOGIN_REQ LOGIN_ACK 8 JOIN_REQ JOIN_ACK 9 PART_REQ PART_ACK 10 SEND_PUBLIC PUBLIC_MSG 11 SEND_PRIVATE PRIVATE_MSG 12 USER_JOINS USER_PARTS 13 LIST_CHANNELS CHANNEL_ITEM 14 LIST_USERS USER_ITEM 15 LOGOFF 16 );
17 use constant ERROR => 10; 18 use constant LOGIN_REQ => 20; 19 use constant LOGIN_ACK => 30; 20 use constant LOGOFF => 40; 21 use constant JOIN_REQ => 50; 22 use constant JOIN_ACK => 60; 23 use constant PART_REQ => 70; 24 use constant PART_ACK => 80; 25 use constant SEND_PUBLIC => 90; 26 use constant PUBLIC_MSG => 100; 27 use constant SEND_PRIVATE => 120; 28 use constant PRIVATE_MSG => 130; 29 use constant USER_JOINS => 140; 30 use constant USER_PARTS => 150; 31 use constant LIST_CHANNELS => 160; 32 use constant CHANNEL_ITEM => 170; 33 use constant LIST_USERS => 180; 34 use constant USER_ITEM => 190;
35 1;
The chat server is more complicated than the client because it must keep track of each user who logs in and each user's changing tchannel membership. When a user enters or leaves a channel, the server must transmit a notification to that effect to every remaining member of the channel. Likewise, when a user sends a public message while enrolled in a channel, that message must be duplicated and sent to each member of the channel in turn.
To simplify user management, we create two utility classes, ChatObjects::User and ChatObjects::Channel. A new ChatObjects::User object will be created each time a user logs in to the system, and destroyed when he logs out. The class remembers the address and port number of the client's socket as well as the user's nickname, login time and channel subscriptions. It also provides method calls for joining and departing channels, sending messages to other users, and listing users and channels. Since most of the server consists of sending the appropriate messages to users, most of the code is found in the ChatObjects::User class.
ChatObjects::Channel is a small class that keeps track of each channel. It maintains the channel's name and description, as well as the list of subscribers. The subscriber list is used in broadcasting public messages and notifying members when another user enters or leaves the channel.
Let's walk through the main body of the server first (Figure 19.5).
new() method. The method takes two arguments
corresponding to the channel title and description.
Here is a typical entry in the dispatch table:
SEND_PUBLIC() => 'send_public',
This is interpreted to mean that whenever a client sends us a
SEND_PUBLIC message, we will call the corresponding ChatObject::User
object's send_public() method.
recv_event() repeatedly. This method calls recv() on the underlying
socket, parses the message, and returns the event code, the event
message and the packed address of the client that sent the message.
Login requests receive special treatment because there isn't yet a
ChatObjects::User object associated with the client address. If the
event code is LOGIN_REQ, then we pass the address, the event text, and
our ChatObjects::Comm object to a do_login() subroutine. It will
create a new ChatObjects::User object and send the client a LOGIN_ACK.
lookup_byaddr() to find a
ChatObjects::User object that is associated with the client's address.
If there isn't one, it means that the client hasn't logged in, and we
issue an error message by sending an event of type ERROR.
In either case, we're finished processing the transaction, so we loop back and wait for another incoming request.
do_login() subroutine is called to handle new user registration.
It receives the peer's packed address, the ChatObjects::Comm object,
and the LOGIN_REQ event data, which happens to be nickname that the
user desires to register under.
It is certainly possible for two users to request the same nickname.
We check for this eventuality by calling the ChatObjects::User class
method lookup_byname(). If there is already a user registered under
this name, then we issue an error. Otherwise we invoke
ChatObjects::User->new() to create a new user object.
0 #!/usr/bin/perl -w 1 # file: chat_server.pl 2 # chat server using UDP 3 use strict; 4 use ChatObjects::ChatCodes; 5 use ChatObjects::Comm; 6 use ChatObjects::User; 7 use ChatObjects::Channel; 8 use constant DEBUG => 0;
9 # create a bunch of channels
10 ChatObjects::Channel->new('CurrentEvents', 'Discussion of current events');
11 ChatObjects::Channel->new('Weather', 'Talk about the weather');
12 ChatObjects::Channel->new('Gardening', 'For those with the green thumb');
13 ChatObjects::Channel->new('Hobbies', 'For hobbyists of all types');
14 ChatObjects::Channel->new('Pets', 'For our furry and feathered friends');
15 # dispatch table 16 my %DISPATCH = ( 17 LOGOFF() => 'logout', 18 JOIN_REQ() => 'join', 19 PART_REQ() => 'part', 20 SEND_PUBLIC() => 'send_public', 21 SEND_PRIVATE() => 'send_private', 22 LIST_CHANNELS() => 'list_channels', 23 LIST_USERS() => 'list_users', 24 );
25 # create the UDP socket 26 my $port = shift || 2027; 27 my $server = ChatObjects::Comm->new(LocalPort=>$port); 28 warn "servicing incoming requests...\n";
29 while (1) {
30 next unless my ($code,$msg,$addr) = $server->recv_event;
31 warn "$code $msg\n" if DEBUG; 32 do_login($addr,$msg,$server) && next if $code == LOGIN_REQ;
33 my $user = ChatObjects::User->lookup_byaddr($addr); 34 $server->send_event(ERROR,"please log in",$addr) && next 35 unless defined $user;
36 $server->send_event(ERROR,"unimplemented event code",$addr) && next
37 unless my $dispatch = $dispatch{$code};
38 $user->$dispatch($msg);
39 }
40 sub do_login {
41 my ($addr,$nickname,$server) = @_;
42 return $server->send_event(ERROR,"nickname already in use",$addr)
43 if ChatObjects::User->lookup_byname($nickname);
44 return unless ChatObjects::User->new($addr,$nickname,$server);
45 }
Most of the server application logic is delegated to the ChatObjects::User module (Figure 19.6). This object mediates all events transmitted to a particular user and keeps track of an array of channels in which a user is enrolled.
Although the user may belong to multiple channels, a single channel is special because it receives all public messages that the user sends out. In this implementation, the current channel is the first element in the array; it is always the channel that the user subscribed to most recently.
We use the ``overload'' pragma to implement this feature, telling Perl
to interpolate the object into double-quoted strings by calling its
nickname() method, and to fall back to the default behavior for all
other operators.
new() methodnew() method creates new ChatObjects::User objects. It is passed
three arguments: the packed address of the user's client, the user's
nickname, and a ChatObjects::Comm object for use in sending messages
to the user. We store these attributes into a blessed hash, along
with a record of the user's login time and an empty anonymous array.
This array will eventually contain the list of channels that the user
belongs to.
Having created the object, we invoke the server object's send_event()
method to return a LOGIN_ACK message to the user, being sure to use
the three-argument form of send_event() so that the message goes to
the correct client. We then stash the new object into the %NICKNAMES
and %ADDRESSES hashes and return the object to the caller.
There turns out to be a slight trick required to make the %ADDRESSES
hash work properly. Occasionally Perl's recv() call returns a packed
socket address that contains extraneous junk in the unused fields of
the underlying C data structure. This junk is ignored by the send()
call, and is discarded when sockaddr_in() is used to unpack the
address into its port and IP address components.
The problem arises when comparing two addresses returned by recv() for
equality, because the presence of differences in the junk data may
cause the addresses to appear to be different, when in fact they share
the same port numbers and IP addresses. In order to avoid this issue,
we call a utility subroutine named key() which turns the packed
address into a reliable key containing the port number and IP address.
lookup_byname() and lookup_byaddr() methods are class methods that
are called to retrieve ChatObjects::User objects based on the nickname
of the user and his client's address, respectively. These methods
work by indexing into %NICKNAMES and %ADDRESSES. For the reasons
explained above, we must pass the packed address to key() in order to
turn it into a reliable value that can be used for indexing.
The users() method returns a list of all currently logged-in users.
timeon() and channels() methods return the user's address,
nickname, login time and channel set. current_channel() returns the
channel that the user subscribed to most recently.
send() method is a convenience method which
accepts an event code and the event data, and passes that to the
ChatObject::Server object's send_event() method. The third argument
to send_event() is the user's stored address to be used as the
destination for the datagram carrying the event.
logout() method is invoked. This method
removes the user from all subscribed channels, and then deletes the
object from the %NICKNAMES and %ADDRESSES hashes. These actions
remove all memory references to the object and cause Perl to destroy
the object and reclaim its space.
join() methodjoin() method is invoked when the user has requested to join a
channel. It is passed the title of the affected channel.
The join() method begins by looking up the selected channel object
using the ChatObjects::Channel class method lookup(). If no channel
with the indicated name is identified, we issue an error event by
calling our send() method. Otherwise, we call our channels() method
to retrieve the current list of channels that the user is enrolled in.
If we are not already enrolled in the channel we call the channel
object's add() method to notify other users that we are joining the
channel. If we already belong to the channel, we delete it from its
current position in the channels array so that it will be moved to the
top of the list in the next part of the code. We make the channel
object current by making it the first element of the channels array,
and send the client a JOIN_ACK event.
part() methodpart() method is called when a user is departing a channel and is
similar to join() in structure and calling conventions.
If the user indeed belongs to the selected channel we call the
corresponding channel object's remove() method to notify other users
that the user is leaving. We then remove the channel from the
channels array and send the user a PART_ACK event. The removed
channel may have been the current channel, in which case we issue a
JOIN_ACK for the new current channel, if any.
send_public() method handles the PUBLIC_MSG event. It takes a
line of text, looks up the current channel, and calls the channels
message() method. If there is no current channel, indicating that the
user is not enrolled in any channel, then we return an error message.
send_private() method handles a request to send a private message
to a user. We receive the data from a PRIVATE_MSG event, and parse it
into the recipient's nickname and the message text. We then call our
lookup_byname() method to turn the nickname into a user object. If no
one by that name is registered, we issue an error message. Otherwise
we call the user object's send() method in order to transmit a
PRIVATE_MSG event directly to the user.
This method takes advantage of the fact that user objects call
nickname() automatically when interpolated into strings. This is the
result of overloading the double-quote operator at the beginning of
the module.
list_users() method generates transmits a series of USER_ITEM
events to the client. Each event contains information about a users
enrolled in the current channel (including the present user).
We begin by recovering the current channel. If none is defined
(because the user is enrolled in no channels at all), we send an ERROR
event. Otherwise, we retrieve all the users on the current channel by
calling its users() method, and transmit a USER_ITEM event containing
the user nickname, the length of time the user has been registered
with the system (measured in seconds), and a space-delimited list of
the channels the user is enrolled in.
Like the user class, ChatObjects::Channel overloads the double-quoted
operator so that its title() method is called when the object is
interpolated into double-quoted strings. This allows us to use the
object reference directly in the data passed to send().
list_channels() returns a list of the available channels by sending
the user a series of CHANNEL_ITEM events. It calls the
ChatObjects::Channel class's channels() method to retrieve the list of
all channels, and incorporates each channel into a CHANNEL_ITEM
event. The event contains the information returned by the channel
objects' info() method. In the current implementation, this consists
of the channel title, the number of enrolled users, and the
human-readable description of the channel.
recv() call can return random junk in
the unusued fields of the socket address structure, complicating the
comparison of client addresses. The key() method normalizes the
address into a string suitable for use as a hash key. Two packets
sent from the same host and socket will have identical keys.
Because we have a method named join(), we must qualify the built-in function of the same name as CORE::join() in order to avoid the ambiguity.
0 package ChatObjects::User; 1 # file: ChatObjects/User.pm
2 use strict; 3 use ChatObjects::ChatCodes; 4 use Socket;
5 use overload ( '""' => 'nickname', 6 fallback => 1 );
7 # Information on a user 8 my %NICKNAMES = (); 9 my %ADDRESSES = ();
10 sub new {
11 my $package = shift;
12 my ($address,$nickname,$server) = @_;
13 my $self = bless {
14 address => $address,
15 nickname => $nickname,
16 server => $server,
17 timeon => time(),
18 channels => [],
19 },$package;
20 $server->send_event(LOGIN_ACK,$nickname,$address);
21 return $NICKNAMES{$nickname} = $ADDRESSES{key($address)} = $self;
22 }
23 sub lookup_byname {
24 shift; # get rid of package name
25 my $nickname = shift;
26 return $NICKNAMES{$nickname};
27 }
28 sub lookup_byaddr {
29 shift; # get rid of package name
30 my $addr = shift;
31 return $ADDRESSES{key($addr)};
32 }
33 sub users { values %NICKNAMES }
34 sub address { shift->{address} }
35 sub nickname { shift->{nickname} }
36 sub channels { @{shift->{channels}} }
37 sub current_channel { shift->{channels}[0] }
38 sub timeon { shift->{timeon} }
39 sub send {
40 my $self = shift;
41 my ($code,$msg) = @_;
42 $self->{server}->send_event($code,$msg,$self->address);
43 }
44 sub logout {
45 my $self = shift;
46 $_->remove($self) foreach $self->channels;
47 delete $NICKNAMES{$self->nickname};
48 delete $ADDRESSES{key($self->address)};
49 warn "logout: ",$self->nickname,"\n" if main::DEBUG();
50 }
51 sub join {
52 my $self = shift;
53 my $title = shift;
54 return $self->send(ERROR,"no channel named $title")
55 unless my $channel = ChatObjects::Channel->lookup($title);
56 # already belongs to channel, so make it current
57 if (grep {$channel eq $_} $self->channels) {
58 my @chan = grep { $channel ne $_ } $self->channels;
59 $self->{channels} = \@chan;
60 } else {
61 $channel->add($self);
62 }
63 unshift @{$self->{channels}},$channel;
64 $self->send(JOIN_ACK,$channel->info);
65 }
66 sub part {
67 my $self = shift;
68 my $title = shift;
69 my $channel = $title ? ChatObjects::Channel->lookup($title) : $self->current_channel;
70 return $self->send(ERROR,"no channel named $title") unless $channel;
71 my @chan = grep { $channel ne $_ } $self->channels;
72 return if @chan == $self->channels; # not a member of that channel!
73 my $was_current = $channel eq $self->current_channel;
74 $self->{channels} = \@chan;
75 $channel->remove($self);
76 $self->send(PART_ACK,$channel->info);
77 if ($was_current && (my $current = $self->current_channel)) {
78 $self->send(JOIN_ACK,$current->info);
79 }
80 }
81 sub send_public {
82 my $self = shift;
83 my $text = shift;
84 if (my $channel = $self->current_channel) {
85 $channel->message($self,$text);
86 } else {
87 $self->send(ERROR,"no current channel");
88 }
89 }
90 sub send_private {
91 my $self = shift;
92 my $msg = shift;
93 my ($recipient,$text) = $msg =~ /(\S+)\s*(.*)/;
94 return $self->send(ERROR,"no nickname given for recipient of private message")
95 unless $recipient;
96 if (my $user = $self->lookup_byname($recipient)) {
97 $user->send(PRIVATE_MSG,"$self $text");
98 } else {
99 $self->send(ERROR,"$recipient: not logged in");
100 }
101 }
102 sub list_users {
103 my $self = shift;
104 my $channel = $self->current_channel;
105 return $self->send(ERROR,"no current channel") unless $channel;
106 foreach ($channel->users) {
107 my $timeon = time() - $_->timeon;
108 my @channels = $_->channels;
109 $self->send(USER_ITEM,"$_ $timeon @channels");
110 }
111 }
112 sub list_channels {
113 my $self = shift;
114 $self->send(CHANNEL_ITEM,$_->info) foreach ChatObjects::Channel->channels;
115 }
116 # utility routine
117 sub key { CORE::join ':',sockaddr_in($_[0]) }
118 1;
Last, we look at the ChatObjects::Channel class (Figure 19.7). The
most important function of this class is to broadcast messages to all
current members of the channel, whenever a member joins, leaves, or
sends a public message. The class does this by iterating across each
of the currently enrolled users, invoking their send() methods to
transmit the appropriate event.
title() method, and tell Perl
to fall back to the default behavior for other operators.
At this point we also define a package global named %CHANNELS. It will hold the definitive list of channel objects indexed by title, for later lookup operations.
new() class method is called to create a new instance of the
ChannelObjects::Channel class. We take the title and description for
the new channel and incorporate them into a blessed hash, along with
an empty anonymous hash that will eventually contain the list of users
enrolled in the channel. We stash the new object in the %CHANNELS
hash and return it.
lookup() method returns the ChatObjects::Channel object having the
indicated title. We retrieve the title from the subroutine argument
array and use it to index into the %CHANNELS array.
The channels() method fetches all the channel titles by returning the
keys of the %CHANNELS hash.
title() and description() methods return the
channel's title and description, respectively. The users() method
returns a list of all users enrolled in the channel. The keys of the
users hash are user nicknames, and its values are the corresponding
ChatObjects::User objects.
info() method provides data to be incorporated into the
CHANNEL_ITEM event. In the current version of ChatObjects::Channel,
info() returns a space-delimited string containing the channel title,
the number of users currently enrolled, and the description of the
channel. In the next chapter we will override info() to return a
multicast address for the channel as well.
send_to_all() method is the crux of the whole application. Given
an event code and the data associated with it, this method will send
the event to all enrolled users. We do this by calling users() to get
the up-to-date list of ChatObject::User objects, and sending the event
code and data to each one via its send() method. This results in one
datagram being sent for each enrolled user, with no issues of blocking
or concurrency control.
add() method is called when a user wishes to join a channel. We
first check that the user is not already a member, in which case we do
nothing. Otherwise, we use the send_to_all() method to send a
USER_JOINS event to each member and add the new user to the users
hash.
remove() method is called to remove a user from the channel. We
check that the user is indeed a member of the channel, delete the user
from the users hash, and then send a USER_PARTS message to all the
remaining enrollees.
message() method is called when a user sends a public message. We
are called with the name of the user who is sending the messages, and
retransmit it to each of the members of the group (including the
sender) with the send_to_all() method.
0 package ChatObjects::Channel; 1 # file: ChatObjects/Channel.pm
2 use ChatObjects::User; 3 use ChatObjects::ChatCodes;
4 use overload ( '""' => 'title', 5 fallback => 1 6 ); 7 my %CHANNELS;
8 sub new {
9 my $pack = shift;
10 my ($title,$description) = @_;
11 return $CHANNELS{lc $title} = bless {
12 title => $title,
13 description => $description,
14 users => {},
15 },$pack;
16 }
17 sub lookup {
18 shift; # get rid of package name
19 my $title = shift;
20 return $CHANNELS{lc $title};
21 }
22 sub channels { values %CHANNELS }
23 sub title { shift->{title} }
24 sub description { shift->{description} }
25 sub users { values %{shift->{users}} }
26 sub info {
27 my $self = shift;
28 my $user_count = $self->users;
29 return "$self $user_count $self->{description}";
30 }
31 sub send_to_all {
32 my $self = shift;
33 my ($code,$data) = @_;
34 $_->send($code,$data) foreach $self->users;
35 }
36 sub add {
37 my $self = shift;
38 my $user = shift;
39 return if $self->{users}{$user}; # already a member
40 $self->send_to_all(USER_JOINS,"$self $user");
41 $self->{users}{$user} = $user;
42 }
43 sub remove {
44 my $self = shift;
45 my $user = shift;
46 return unless $self->{users}{$user}; # not already a member
47 delete $self->{users}{$user};
48 $self->send_to_all(USER_PARTS,"$self $user");
49 }
50 sub message {
51 my $self = shift;
52 my ($sender,$text) = @_;
53 $self->send_to_all(PUBLIC_MSG,"$self $sender $text");
54 }
55 1;
Notice that the server makes no attempt to verify that each user receives the events it transmits. This is typical of a UDP server, and appropriate for an application like this one which doesn't require 100% precision.
There is, however, a more significant problem with the chat server as it is currently written. It is possible that a client might crash for some reason before sending a LOGOFF event to the server, or that the LOGOFF event is sent, but gets lost on the network. In this case, the server will think that the user is logged in and continue to send out messages to the client. Over long periods of time, the server may fill out with such phantom users.
There are a number of solutions to this problem. The server might:
The third solution we listed represents a good compromise between simplicity and effectiveness. It requires small changes to the following files:
The modifications to ChatObjects::ChatCodes are minimal. We simply define a new STILL_HERE constant, and add it to the @EXPORTS list:
@EXPORT = qw(
ERROR
LOGIN_REQ LOGIN_ACK
...
STILL_HERE
);
use constant USER_ITEM => 190;
use constant STILL_HERE => 200;
1;
We next define ChatObjects::TimedUser, a simple subclass of
ChatObjects::User (Figure 19.8). This class overrides the original
new() method to add a ``stillhere'' instance variable. A new
still_here() method updates the variable with the current time, and
inactivity_interval() returns the number of seconds since still_here()
was last called.
0 package ChatObjects::TimedUser; 1 # file: ChatObjects/TimedUser.pm
2 use strict; 3 use ChatObjects::User; 4 use vars '@ISA'; 5 @ISA = 'ChatObjects::User';
6 sub new {
7 my $package = shift;
8 my $self = $package->SUPER::new(@_);
9 $self->{stillhere} = time();
10 return $self
11 }
12 sub still_here {
13 my $self = shift;
14 $self->{stillhere} = time();
15 }
16 sub inactivity_interval {
17 my $self = shift;
18 return time() - $self->{stillhere};
19 }
20 1;
ChatObjects::TimedUser will be used by the server instead of ChatObjects::User.
Next we modify chat_client.pl in order to issue periodic STILL_HERE events. Figure 19.9 shows the first half of the modified script (the rest is identical to the original given in Figure 19.2). The relevant changes are as follows:
select() time outcan_read() method
so that if no data is received within that period of time, we will
still have the opportunity to send the event in a timely fashion.
0 #!/usr/bin/perl -w 1 # file: timed_chat_client.pl 2 # chat client using UDP, with regular STILL_HERE messages 3 use strict; 4 use IO::Socket; 5 use IO::Select; 6 use ChatObjects::ChatCodes; 7 use ChatObjects::Comm;
8 use constant ALIVE_INTERVAL => 30; # send a STILL_HERE every 30 sec
9 $SIG{INT} = $SIG{TERM} = sub { exit 0 };
10 my ($nickname,$server);
11 # dispatch table for commands from the user
12 my %COMMANDS = (
13 channels => sub { $server->send_event(LIST_CHANNELS) },
14 join => sub { $server->send_event(JOIN_REQ,shift) },
15 part => sub { $server->send_event(PART_REQ,shift) },
16 users => sub { $server->send_event(LIST_USERS) },
17 public => sub { $server->send_event(SEND_PUBLIC,shift) },
18 private => sub { $server->send_event(SEND_PRIVATE,shift) },
19 login => sub { $nickname = do_login() },
20 quit => sub { undef },
21 );
22 # dispatch table for messages from the server 23 my %MESSAGES = ( 24 ERROR() => \&error, 25 LOGIN_ACK() => \&login_ack, 26 JOIN_ACK() => \&join_part, 27 PART_ACK() => \&join_part, 28 PUBLIC_MSG() => \&public_msg, 29 PRIVATE_MSG() => \&private_msg, 30 USER_JOINS() => \&user_join_part, 31 USER_PARTS() => \&user_join_part, 32 CHANNEL_ITEM() => \&list_channel, 33 USER_ITEM() => \&list_user, 34 );
35 # Create and initialize the UDP socket 36 my $servaddr = shift || 'localhost'; 37 my $servport = shift || 2027; 38 my $last_alive = 0;
39 $server = ChatObjects::Comm->new(PeerAddr => "$servaddr:$servport") or die $@;
40 # Try to log in 41 $nickname = do_login(); 42 die "Can't log in.\n" unless $nickname;
43 # Read commands from the user and messages from the server
44 my $select = IO::Select->new($server->socket,\*STDIN);
45 LOOP:
46 while (1) {
47 my @ready = $select->can_read(ALIVE_INTERVAL);
48 foreach (@ready) {
49 if ($_ eq \*STDIN) {
50 do_user(\*STDIN) || last LOOP;
51 } else {
52 do_server($_);
53 }
54 }
55 if (time() - $last_alive > ALIVE_INTERVAL) {
56 $server->send_event(STILL_HERE);
57 $last_alive = time();
58 }
59 }
...
Figure 19.10 shows the chat_server.pl script modified to support auto logout of defunct clients. The modifications are as follows:
still_here() and inactivity_interval() methods.
still_here() method when the
STILL_HERE event is received.
$next_check, which is set to the current time plus CHECK_INTERVAL.
auto_logoff() method at regular intervalsauto_logoff() and update $next_check.
auto_logoff() method loops through each currently registered user
returned by the ChatObjects::TimedUser->users() method (which is
inherited from its parent). We call each user object's
inactivity_interval() method to retrieve the number of seconds since
the client has sent a STILL_HERE event. If the interval exceeds
AUTO_LOGOUT, we call the object's logout method to unregister the user
and free up memory.
Unlike the client, we do not time out the call to
$server->recv_event(). If the server is totally inactive, then
defunct clients will not be recognized and pruned until an event is
received and the auto_logoff() function gets a chance to run. On an
active server, this issue will not be noticeable, but if it bothers
you, you can wrap the server object's recv_event() in a call to
select().
0 #!/usr/bin/perl -w 1 # file: timed_chat_server.pl 2 # chat server using UDP, with timed logouts 3 use strict; 4 use ChatObjects::ChatCodes; 5 use ChatObjects::Comm; 6 use ChatObjects::TimedUser; 7 use ChatObjects::Channel;
8 use constant DEBUG => 1; 9 use constant AUTO_LOGOUT => 120; # auto-logout if silent for two minutes 10 use constant CHECK_INTERVAL => 30; # prune silent users every 30 sec
11 # create a bunch of channels
12 ChatObjects::Channel->new('CurrentEvents', 'Discussion of current events');
13 ChatObjects::Channel->new('Weather', 'Talk about the weather');
14 ChatObjects::Channel->new('Gardening', 'For those with the green thumb');
15 ChatObjects::Channel->new('Hobbies', 'For hobbyists of all types');
16 ChatObjects::Channel->new('Pets', 'For our furry and feathered friends');
17 # dispatch table 18 my %DISPATCH = ( 19 LOGOFF() => 'logout', 20 JOIN_REQ() => 'join', 21 PART_REQ() => 'part', 22 SEND_PUBLIC() => 'send_public', 23 SEND_PRIVATE() => 'send_private', 24 LIST_CHANNELS() => 'list_channels', 25 LIST_USERS() => 'list_users', 26 STILL_HERE() => 'still_here', 27 );
28 # create the UDP socket 29 my $port = shift || 2027; 30 my $server = ChatObjects::Comm->new(LocalPort=>$port); 31 warn "servicing incoming requests...\n";
32 my $next_check = time() + CHECK_INTERVAL;
33 while (1) {
34 next unless my ($code,$msg,$addr) = $server->recv_event;
35 warn "$code $msg\n" if DEBUG; 36 do_login($addr,$msg,$server) && next if $code == LOGIN_REQ;
37 my $user = ChatObjects::TimedUser->lookup_byaddr($addr); 38 $server->send_event(ERROR,"please log in",$addr) && next 39 unless defined $user;
40 $server->send_event(ERROR,"unimplemented event code",$addr) && next
41 unless my $dispatch = $DISPATCH{$code};
42 $user->$dispatch($msg);
43 } continue {
44 if (time() > $next_check) {
45 auto_logoff();
46 $next_check = time() + CHECK_INTERVAL;
47 }
48 }
49 sub auto_logoff {
50 warn "Inactivity check...\n" if DEBUG;
51 foreach (ChatObjects::TimedUser->users) {
52 next if $_->inactivity_interval < AUTO_LOGOUT;
53 warn "Autologout of $_\n" if DEBUG;
54 $_->logout;
55 }
56 }
57 sub do_login {
58 my ($addr,$nickname,$server) = @_;
59 return $server->send_event(ERROR,"nickname already in use",$addr)
60 if ChatObjects::TimedUser->lookup_byname($nickname);
61 return unless ChatObjects::TimedUser->new($addr,$nickname,$server);
62 }
The UDP protocol is ideal for lightweight message-oriented servers that do not require a high degree of reliability. The Internet chat system described iin this chapter is a good example of such an application.
Although the chat system is fully functional, there are many missing features. For one thing, the system doesn't provide a way to list all the users currently logged in, to get information on a named user, or to notify you when a specific user logs into the system (called a ``hot list'' in some systems). These features would be straightforward to add.
Another deficiency of the system is that it doesn't provide anything in the way of long-term user registration and authentication. Anyone can log in using any nickname, and as soon as the system is killed and restarted, all information on registered users is lost. The only consistency checking performed by the system is to prevent two concurrent users from choosing the same nickname.
In order to support user authentication and persistent registration, you would have to add some sort of database backend to the system. Implementations could range in complexity from simple DBM files to sophisticated relational databases.
Lastly, several real-world chat systems provide Internet ``relay'' functionality. Instead of burdening a single chat server with the responsibility of managing all registered users, relay systems distribute the load amongst multiple servers. Messages and other events posted to one server are relayed to the other servers so that they can broadcast the event to their users. You could add this feature to the current implementation by having each server log into the other servers as if it were a client. When a server receives an event from another server, it simply relays it to its users, which might include a mixture of users and other servers. However, you'd have to write code to prevent events being relayed in a never-ending loop.
Another way to reduce the burden on the chat server is to replace the current user-at-a-time method of sending events to a channel's enrollees with a system that sends the event to all enrollees with a single system call. This is the topic of the next chapter.