原作者:Brian Slesinsky 1997年5月7日
編譯者:【Perl之旅】Nighthawk 2000年7月15日
Brian Slesinsky原來是HotWired公司的工程師，后來他離開公司忙于自己事業(yè)。

前言:

我對在線聊天沒有什么興趣,說是實(shí)在的,與電子郵件和網(wǎng)絡(luò)會(huì)議系統(tǒng)相比,聊天室顯得很膚淺.但是寫一個(gè)聊天室服務(wù)程序倒是一件很有意思的事情.我將告訴你如何來寫一個(gè)小型的聊天室服務(wù)程序,可能會(huì)很簡陋,有很多要擴(kuò)展的地方.

先決條件:

你必須有很好的Perl編程的知識,一臺服務(wù)器,安裝Perl 5.002或更高的版本.注意大多數(shù)ISP不會(huì)允許普通用戶運(yùn)行聊天室程序.但是你也許可以通過一個(gè)MODEN連接來與少數(shù)幾個(gè)用戶試試你的聊天室系統(tǒng). (如果你從CPAN獲得了最新版本的IO:Select,這個(gè)聊天室程序可以在Windows環(huán)境下使用).

你還需要一個(gè)telnet客戶端程序,因?yàn)槲覀円脕碜隽奶焓业目蛻舳?



Socket簡易編程:

開始聊天,你需要在internet上建立一個(gè)連接,對Perl程序員來說,這意味著要和socket打交道.而以前這是很困難的,因?yàn)槟悴坏貌皇褂胮ack()來建立一個(gè)C結(jié)構(gòu)來進(jìn)行底層的系統(tǒng)調(diào)用.但在最新版的Perl中我們可以使用IO::Socket包,很容易地打開一個(gè)socket. 當(dāng)用戶連接聊天服務(wù)器時(shí),telnet程序在指定的端口打開一個(gè)連接,所以服務(wù)器也必須在那個(gè)端口打開一個(gè)socket,監(jiān)聽所有進(jìn)來的連接.下面如何通過IO::Socket來做到這一點(diǎn):

????use IO::Socket;

????my $listening_socket =
????????IO::Socket::INET->new(Proto => 'tcp',
??????????????????????????????LocalPort => 2323,
??????????????????????????????Listen => 1,
??????????????????????????????Reuse => 1) or die $!;

所有參量的含義:

Proto: 定義網(wǎng)絡(luò)所用的協(xié)議 - 在這里我們用的是TCP. 在internet上通常有兩種協(xié)議用得比較廣泛 - TCP 和 UDP. TCP適用于穩(wěn)定的連接,可以重新發(fā)送丟失的數(shù)據(jù)包,而UDP用于那些不用重發(fā)數(shù)據(jù)包的場合(如實(shí)時(shí)音頻數(shù)據(jù)流).

LocalPort: 定義連接的端口號.

Listen: 我們將監(jiān)聽來自其它計(jì)算機(jī)的連接,而不是自己建立一個(gè)連接.所以用戶要先telnet到端口2323,然后運(yùn)行了聊天服務(wù)程序的計(jì)算機(jī)來建立連接.

Reuse: 這個(gè)選項(xiàng)意思是如果我們"殺掉"聊天服務(wù)程序然后再重新啟動(dòng),將能夠馬上重新使用原來的端口,而不用等待以前那個(gè)連接完全結(jié)束.



我們正等待某個(gè)連接的到來.... 一個(gè)連接到來以后,我們需要accept這個(gè)新的連接:

$socket = $listening_socket->accept;

一旦我們建立了一個(gè)連接,我們可以發(fā)送一些文字給這個(gè)用戶(還不完全是,請看本文的結(jié)尾部分):

$socket->send("hello\r\n") or print "connection closed at other end\n";

我們也可以接收用戶發(fā)來的信息:

$socket->recv($line, 80);
if($line eq "") {
print "connection closed at other end\n";
}

最后我們完成了連接,可以關(guān)閉它:

$socket->close;

大部分程序只在一個(gè)時(shí)刻處理一個(gè)用戶.如果用戶還沒有準(zhǔn)備好,程序就沒有什么好做的.所以Perl程序沒有從讀到什么東西,它就停下來等待直到用戶準(zhǔn)備好. (這叫blocking I/O.)

這種方式不能用于聊天服務(wù)程序,用戶不可能排著隊(duì)來.一個(gè)用戶可能離開去喝些咖啡,但其它用戶還在拼命地敲打鍵盤(聊天),服務(wù)程序還得處理他們的信息.

解決這個(gè)問題的一個(gè)辦法是為每個(gè)用戶創(chuàng)建一個(gè)入口(entity),或者用fork()創(chuàng)建另外一個(gè)進(jìn)程,或者用多線程編程方法(遺憾地是Perl還用不了).這樣系統(tǒng)就可以為多個(gè)用戶服務(wù), 但每個(gè)用戶有他自己的入口(entity)等待他輸入命令. 但是進(jìn)程的系統(tǒng)開銷比較大,如果很多用戶登錄的話,系統(tǒng)資源很快會(huì)變得不足.最好是用一個(gè)進(jìn)程來處理所有人的請求.

我們真正需要的是要知道誰正在等待服務(wù),必須馬上處理(除非沒有一個(gè)人想聊天).這就是select()函數(shù)所要做的.

象socket函數(shù)一樣,select()曾經(jīng)也是很難用,所以大多數(shù)程序員都盡量避免使用它. 但Perl給它加了一個(gè)面向?qū)ο缶幊痰陌b,叫做IO::Select,使得使用非常簡單.

假設(shè)我們要等待兩個(gè)sockets, $thing1 and $thing2. 首先我們創(chuàng)建一個(gè)包含兩個(gè)socket的select()對象:

$select = IO::Select->new($thing1,$thing2);

下一步,當(dāng)我們需要知道誰有數(shù)據(jù)要處理時(shí),我們就查詢select對象:

my @ready = $select->can_read;

這個(gè)調(diào)用將等待直到$thing1或$thing2中任何一個(gè)準(zhǔn)備好, 它將返回一個(gè)包含socket的數(shù)組. (如果它們都準(zhǔn)備好了,@ready將包含兩個(gè)socket.) 一旦有了準(zhǔn)備好的socket, 我們一個(gè)一個(gè)地讀取數(shù)據(jù)找出它們發(fā)送的是是什么:

?? for $socket (@ready) {
????????$socket->recv($line,80);
????????if($line eq "") { die "they hung up on me"; }
????????print "someone sent $line.??Sending it back.\n";
????????$socket->send($line) or die "hey, where did they go?";
?? }

現(xiàn)在我們有足夠的片段來寫我們的第一個(gè)聊天服務(wù)程序. 這個(gè)聊天室里的交談沒有什么意思,除非你中意和自己聊天 - 服務(wù)程序會(huì)把你說的全部回送. 但它將告訴你如果結(jié)合socket和select()來建立一個(gè)一個(gè)時(shí)刻只能做一件事的服務(wù)器.下面是程序源碼:

#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

#創(chuàng)建一個(gè)socket然后監(jiān)聽一個(gè)端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
?? LocalPort => 2323,
?? Listen => 1,
?? Reuse => 1) or die $!;

# 開始$select只包含我們監(jiān)聽的socket
my $select = IO::Select->new($listen);

my @ready;

#等待,直到有事情發(fā)生
while(@ready = $select->can_read) {

????my $socket;

????# 處理每個(gè)準(zhǔn)備好了的socket
????for $socket (@ready) {

# 如果被監(jiān)聽的socket準(zhǔn)備好了,接收一個(gè)新的連接
if($socket == $listen) {
????my $new = $listen->accept;
????$select->add($new);
????print $new->fileno . ": connected\n";
} else {

????# 否則讀入一行文字,然后發(fā)送回去
????my $line="";
????$socket->recv($line,80);
????$line ne "" and $socket->send($line) or do {

# 如果沒有什么可發(fā)送和接收的,中斷連接
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
????};
}
????}
}



廣播:

接下來的工作是把聊天信息發(fā)送給所有的用戶(不光是你自己),也就是所謂"廣播".

我們可以用$select, 它new()或add()來返回所有給$select的sockets,從而得知"所有用戶"到底是誰.我們來修改下程序:


????????????$socket->recv($line,80);
????????????if($line eq "") {
????????????????print $socket->fileno . ": disconnected\n";
????????????????$select->remove($socket);
????????????????$socket->close;
????????????};
????????????my $socket;

????????????# 向所有用戶廣播.如果send()失敗了就關(guān)閉連接.
????????????
????????????for $socket ($select->handles) {
????????????????next if($socket==$listen);
????????????????$socket->send($line) or do {
????????????????????print $socket->fileno . ": disconnected\n";????????
????????????????????$select->remove($socket);
????????????????????$socket->close;
????????????????};
????????????}

下面是這個(gè)聊天程序的所有代碼:


#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;

#創(chuàng)建一個(gè)socket監(jiān)聽端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
?? LocalPort => 2323,
?? Listen => 1,
?? Reuse => 1) or die $!;

#$select只包含我們正在監(jiān)聽的socket
my $select = IO::Select->new($listen);

my @ready;

# 等待
while(@ready = $select->can_read) {

????my $socket;

????# 處理每個(gè)準(zhǔn)備好的端口
????for $socket (@ready) {

# 如果被監(jiān)聽的端口準(zhǔn)備好,接收一個(gè)新的連接
if($socket == $listen) {
????my $new = $listen->accept;
????$select->add($new);
????print $new->fileno . ": connected\n";
} else {

????# 讀入一行文字
????# 如果recv()失敗,關(guān)閉連接
????my $line="";
????$socket->recv($line,80);
????if($line eq "") {
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
????};
????my $socket;

????# 向所有人廣播,如果send()失敗則關(guān)閉連接.
????for $socket ($select->handles) {
next if($socket==$listen);
$socket->send($line) or do {
????print $socket->fileno . ": disconnected\n";
????$select->remove($socket);
????$socket->close;
};
????}
}
????}
}

1;
????????????


我是誰?



我們的聊天程序還有一個(gè)問題,就是我們不知道是誰在說話.真正的聊天室服務(wù)器能讓你知道誰是誰,在發(fā)言后面把他們的名字顯示出來.

如果我們只能在一個(gè)時(shí)刻做一件事情,請求一個(gè)handle的較為直接的程序代碼就象這個(gè)樣子:

???????? my $new = $listen->accept;
????????????$select->add($new);
????????????print $new->fileno . ": connected\n";
????????????$new->write("choose a handle> ");
????????????$handle[$new->fileno] = $new->recv;
????????????

問題是,我們不能要服務(wù)器停下來等待用戶輸入,我們需要把用戶在那里的信息保存下來,當(dāng)一個(gè)用戶在輸入的時(shí)候,可以處理其他用戶,當(dāng)這個(gè)用戶輸入完了以后在回來.完成這些功能的代碼可以分為兩部分:

sub login {
????????????my($new) = @_;
????????????$select->add($new);
????????????print $new->fileno . ": connected\n";
????????????$new->write("choose a handle> ");
????????????save_where_we_are();
????????}

????????sub get_handle {
????????????my($socket) = @_;
????????????$handle[$socket->fileno] = $socket->recv;
????????}
????????
#!/usr/local/bin/perl -wT
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 $!;
$ENV{'PATH'} = "/usr/bin";
my $date = `date`;
warn "started on $port on $date";
my $select = IO::Select->new($listen);
my @chatters;

# 在win32中,注釋掉下面這句
$SIG{'PIPE'} = 'IGNORE';

my @ready;
while(@ready = $select->can_read) {
????print "going: ".join(', ',map {$_->fileno} @ready) . "\n";
????my $socket;
????for $socket (@ready) {
if($socket == $listen) {
????my $new_socket = $listen->accept;
????Chatter->new($new_socket, $select, \@chatters);
} else {
????my $chatter = $chatters[$socket->fileno];
????if(defined $chatter) {
&{$chatter->nextsub}();
????} else {
print "unknown chatter\n";
????}
}
????}
}

package Chatter;
use strict;

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

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;

歡迎你來到我的聊天室.

使用指南:
請注意這個(gè)聊天室程序不完全兼容telnet協(xié)議,所以有些telnet客戶端程序可能不工作,抱歉!
如果你輸入的字符都分行顯示,請退出然后試一試其它的telnet客戶端程序,最好發(fā)一個(gè)電子郵件
(bslesins-code\@hotwired.com)告訴我你用的是什么程序.

我們已經(jīng)試過下面的客戶端程序,它們都能很好的工作:
??- "telnet" on Solaris
??- "telnet" on IRIX
??- CRT on Windows 95
我們已經(jīng)收到報(bào)告,微軟的Telnet不能工作.

另外,有些人登錄以后可能去干別的事情了,所以他們不會(huì)馬上看到你的信息.所以輸入以后,保持telnet
窗口開著,等待一會(huì)兒.

關(guān)閉你的telnet窗口就可以退出.或者假如你是在Unix命令行運(yùn)行telnet的話,按Control-]然后在提示中按"close"鍵.

__Brian__

END
????$welcome =~ s:\n:\r\n:g;
????$self->write($welcome);

????$self->write("choose a handle> ");

????$self->{'nextsub'} = sub { $self->get_handle };
}

sub get_handle {
????my($self) = @_;

????my $handle = $self->read or return;
????$handle =~ tr/ -~//cd;
????$self->{'handle'} = $handle;
????$self->broadcast("[$handle is here]");
????$self->log("handle: $handle");
????$self->{'nextsub'} = sub { $self->chat };
}

sub chat {
????my($self) = @_;

????my $line = $self->read;
????return if($line eq "");
????$line =~ tr/ -~//cd;
????my $handle = $self->handle;
????$self->broadcast("$handle> $line");
}

sub broadcast {
????my($self,$msg) = @_;

????my $socket;
????for $socket ($self->select->handles) {
my $chatter = $self->chatters->[$socket->fileno];
$chatter->write("$msg\r\n") if(defined $chatter);
????}
}

sub read {
????my($self) = @_;

????my $buf="";
????$self->socket->recv($buf,80);
????$self->leave if($buf eq "");
????return $buf;
}

sub write {
????my($self,$buf) = @_;
????$self->socket->send($buf) or $self->leave;
}

sub leave {
????my($self) = @_;

????print "leave called\n";

????$self->chatters->[$self->socket->fileno] = undef;
????$self->select->remove($self->socket);
????my $handle = $self->handle;
????$self->broadcast("[$handle left]") if(defined $handle);
????$self->log("disconnected");
????$self->socket->close;
}

sub log {
????my($self,$msg) = @_;
????my $fileno = $self->socket->fileno;
????print "$fileno: $msg\n";
}

__END__

# and here's a chat server in 4 lines :-)

#!/usr/local/bin/perl -- minchat: run and telnet to port 5555 - bslesins
sub p{print@_}$SIG{CHLD}=sub{wait};socket S,2,2,6;bind S,pack(Snx12,2,5555);
listen S,5;while(accept C,S){if(!fork){open(STDOUT,">&C");p"name:";$n=substr
,0,-2;$f=fork||exec"tail -f chatlog";open W,">>chatlog";select(W);$|=1;p
"[$n here]\r\n";while(){p"$n> $_";}p"[$n gone]\r\n";kill 15,$f;exit}}



如何保存用戶位置信息呢? 一個(gè)方法是保存一個(gè)子程序的指針,而這個(gè)子例程包含了下一步該做什么:

$nextsub[$socket->fileno] = &get_handle;

這樣我們就可以在@nextsub中適當(dāng)?shù)娜肟谡业轿覀兂霭l(fā)的位置. 綜合以上所述,我們把程序整理如下.





剩下的工作:

我們的聊天室程序還不是一個(gè)完整的作品,如果你象把它放在你的服務(wù)器上工作,還有許多事情要做.他們是:

輸入緩沖區(qū): 關(guān)于recv()函數(shù),它并不總是每次接收一行數(shù)據(jù).一個(gè)真正的聊天服務(wù)器需要把recv()的結(jié)果添加到緩沖區(qū)中,并找到折行字符,把它分成幾行.

輸出緩沖區(qū): 如果有人掛起它的telnet進(jìn)程太長時(shí)間,調(diào)用send()會(huì)中斷它.但可以用select()來發(fā)現(xiàn)一個(gè)socket是否已經(jīng)準(zhǔn)備好.

更好地支持telnet協(xié)議

加入常用的命令:幫助,列出在聊天室中的用戶名單,退出等等

用戶賬號密碼保護(hù)

多個(gè)聊天房間

權(quán)限控制

私人聊天房間

等等...