原作者:Brian Slesinsky 1997年5月7日
編譯者:【
Perl之旅】Nighthawk 2000年7月15日
Brian Slesinsky原來是HotWired公司的工程師，后來他離開公司忙于自己事業。
前言:
我對在線聊天沒有什么興趣,說是實在的,與電子郵件和網絡會議系統相比,聊天室顯得很膚淺.但是寫一個聊天室服務程序倒是一件很有意思的事情.我將告訴你如何來寫一個小型的聊天室服務程序,可能會很簡陋,有很多要擴展的地方.
先決條件:
你必須有很好的Perl編程的知識,一臺服務器,安裝Perl 5.002或更高的版本.注意大多數ISP不會允許普通用戶運行聊天室程序.但是你也許可以通過一個MODEN連接來與少數幾個用戶試試你的聊天室系統. (如果你從CPAN獲得了最新版本的IO:Select,這個聊天室程序可以在Windows環境下使用).
你還需要一個telnet客戶端程序,因為我們要用來做聊天室的客戶端.
Socket簡易編程:
開始聊天,你需要在internet上建立一個連接,對Perl程序員來說,這意味著要和socket打交道.而以前這是很困難的,因為你不得不使用pack()來建立一個C結構來進行底層的系統調用.但在最新版的Perl中我們可以使用IO::Socket包,很容易地打開一個socket. 當用戶連接聊天服務器時,telnet程序在指定的端口打開一個連接,所以服務器也必須在那個端口打開一個socket,監聽所有進來的連接.下面如何通過IO::Socket來做到這一點:
????use IO::Socket;
????my $listening_socket =
????????IO::Socket::INET->new(Proto => 'tcp',
??????????????????????????????LocalPort => 2323,
??????????????????????????????Listen => 1,
??????????????????????????????Reuse => 1) or die $!;
所有參量的含義:
Proto: 定義網絡所用的協議 - 在這里我們用的是TCP. 在internet上通常有兩種協議用得比較廣泛 - TCP 和 UDP. TCP適用于穩定的連接,可以重新發送丟失的數據包,而UDP用于那些不用重發數據包的場合(如實時音頻數據流).
LocalPort: 定義連接的端口號.
Listen: 我們將監聽來自其它計算機的連接,而不是自己建立一個連接.所以用戶要先telnet到端口2323,然后運行了聊天服務程序的計算機來建立連接.
Reuse: 這個選項意思是如果我們"殺掉"聊天服務程序然后再重新啟動,將能夠馬上重新使用原來的端口,而不用等待以前那個連接完全結束.
我們正等待某個連接的到來.... 一個連接到來以后,我們需要accept這個新的連接:
$socket = $listening_socket->accept;
一旦我們建立了一個連接,我們可以發送一些文字給這個用戶(還不完全是,請看本文的結尾部分):
$socket->send("hello\r\n") or print "connection closed at other end\n";
我們也可以接收用戶發來的信息:
$socket->recv($line, 80);
if($line eq "") {
print "connection closed at other end\n";
}
最后我們完成了連接,可以關閉它:
$socket->close;
大部分程序只在一個時刻處理一個用戶.如果用戶還沒有準備好,程序就沒有什么好做的.所以Perl程序沒有從讀到什么東西,它就停下來等待直到用戶準備好. (這叫blocking I/O.)
這種方式不能用于聊天服務程序,用戶不可能排著隊來.一個用戶可能離開去喝些咖啡,但其它用戶還在拼命地敲打鍵盤(聊天),服務程序還得處理他們的信息.
解決這個問題的一個辦法是為每個用戶創建一個入口(entity),或者用fork()創建另外一個進程,或者用多線程編程方法(遺憾地是Perl還用不了).這樣系統就可以為多個用戶服務, 但每個用戶有他自己的入口(entity)等待他輸入命令. 但是進程的系統開銷比較大,如果很多用戶登錄的話,系統資源很快會變得不足.最好是用一個進程來處理所有人的請求.
我們真正需要的是要知道誰正在等待服務,必須馬上處理(除非沒有一個人想聊天).這就是select()函數所要做的.
象socket函數一樣,select()曾經也是很難用,所以大多數程序員都盡量避免使用它. 但Perl給它加了一個面向對象編程的包裝,叫做IO::Select,使得使用非常簡單.
假設我們要等待兩個sockets, $thing1 and $thing2. 首先我們創建一個包含兩個socket的select()對象:
$select = IO::Select->new($thing1,$thing2);
下一步,當我們需要知道誰有數據要處理時,我們就查詢select對象:
my @ready = $select->can_read;
這個調用將等待直到$thing1或$thing2中任何一個準備好, 它將返回一個包含socket的數組. (如果它們都準備好了,@ready將包含兩個socket.) 一旦有了準備好的socket, 我們一個一個地讀取數據找出它們發送的是是什么:
?? 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?";
?? }
現在我們有足夠的片段來寫我們的第一個聊天服務程序. 這個聊天室里的交談沒有什么意思,除非你中意和自己聊天 - 服務程序會把你說的全部回送. 但它將告訴你如果結合socket和select()來建立一個一個時刻只能做一件事的服務器.下面是程序源碼:
#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
#創建一個socket然后監聽一個端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
?? LocalPort => 2323,
?? Listen => 1,
?? Reuse => 1) or die $!;
# 開始$select只包含我們監聽的socket
my $select = IO::Select->new($listen);
my @ready;
#等待,直到有事情發生
while(@ready = $select->can_read) {
????my $socket;
????# 處理每個準備好了的socket
????for $socket (@ready) {
# 如果被監聽的socket準備好了,接收一個新的連接
if($socket == $listen) {
????my $new = $listen->accept;
????$select->add($new);
????print $new->fileno . ": connected\n";
} else {
????# 否則讀入一行文字,然后發送回去
????my $line="";
????$socket->recv($line,80);
????$line ne "" and $socket->send($line) or do {
# 如果沒有什么可發送和接收的,中斷連接
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
????};
}
????}
}
廣播:
接下來的工作是把聊天信息發送給所有的用戶(不光是你自己),也就是所謂"廣播".
我們可以用$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()失敗了就關閉連接.
????????????
????????????for $socket ($select->handles) {
????????????????next if($socket==$listen);
????????????????$socket->send($line) or do {
????????????????????print $socket->fileno . ": disconnected\n";????????
????????????????????$select->remove($socket);
????????????????????$socket->close;
????????????????};
????????????}
下面是這個聊天程序的所有代碼:
#!/usr/local/bin/perl -wT
require 5.002;
use strict;
use IO::Socket;
use IO::Select;
#創建一個socket監聽端口
my $listen = IO::Socket::INET->new(Proto => 'tcp',
?? LocalPort => 2323,
?? Listen => 1,
?? Reuse => 1) or die $!;
#$select只包含我們正在監聽的socket
my $select = IO::Select->new($listen);
my @ready;
# 等待
while(@ready = $select->can_read) {
????my $socket;
????# 處理每個準備好的端口
????for $socket (@ready) {
# 如果被監聽的端口準備好,接收一個新的連接
if($socket == $listen) {
????my $new = $listen->accept;
????$select->add($new);
????print $new->fileno . ": connected\n";
} else {
????# 讀入一行文字
????# 如果recv()失敗,關閉連接
????my $line="";
????$socket->recv($line,80);
????if($line eq "") {
print $socket->fileno . ": disconnected\n";
$select->remove($socket);
$socket->close;
????};
????my $socket;
????# 向所有人廣播,如果send()失敗則關閉連接.
????for $socket ($select->handles) {
next if($socket==$listen);
$socket->send($line) or do {
????print $socket->fileno . ": disconnected\n";
????$select->remove($socket);
????$socket->close;
};
????}
}
????}
}
1;
????????????
我是誰?
我們的聊天程序還有一個問題,就是我們不知道是誰在說話.真正的聊天室服務器能讓你知道誰是誰,在發言后面把他們的名字顯示出來.
如果我們只能在一個時刻做一件事情,請求一個handle的較為直接的程序代碼就象這個樣子:
???????? my $new = $listen->accept;
????????????$select->add($new);
????????????print $new->fileno . ": connected\n";
????????????$new->write("choose a handle> ");
????????????$handle[$new->fileno] = $new->recv;
????????????
問題是,我們不能要服務器停下來等待用戶輸入,我們需要把用戶在那里的信息保存下來,當一個用戶在輸入的時候,可以處理其他用戶,當這個用戶輸入完了以后在回來.完成這些功能的代碼可以分為兩部分:
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;
歡迎你來到我的聊天室.
使用指南:
請注意這個聊天室程序不完全兼容telnet協議,所以有些telnet客戶端程序可能不工作,抱歉!
如果你輸入的字符都分行顯示,請退出然后試一試其它的telnet客戶端程序,最好發一個電子郵件
(bslesins-code\@hotwired.com)告訴我你用的是什么程序.
我們已經試過下面的客戶端程序,它們都能很好的工作:
??- "telnet" on Solaris
??- "telnet" on IRIX
??- CRT on Windows 95
我們已經收到報告,微軟的Telnet不能工作.
另外,有些人登錄以后可能去干別的事情了,所以他們不會馬上看到你的信息.所以輸入以后,保持telnet
窗口開著,等待一會兒.
關閉你的telnet窗口就可以退出.或者假如你是在Unix命令行運行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}}
如何保存用戶位置信息呢? 一個方法是保存一個子程序的指針,而這個子例程包含了下一步該做什么:
$nextsub[$socket->fileno] = &get_handle;
這樣我們就可以在@nextsub中適當的入口找到我們出發的位置. 綜合以上所述,我們把程序整理如下.
剩下的工作:
我們的聊天室程序還不是一個完整的作品,如果你象把它放在你的服務器上工作,還有許多事情要做.他們是:
輸入緩沖區: 關于recv()函數,它并不總是每次接收一行數據.一個真正的聊天服務器需要把recv()的結果添加到緩沖區中,并找到折行字符,把它分成幾行.
輸出緩沖區: 如果有人掛起它的telnet進程太長時間,調用send()會中斷它.但可以用select()來發現一個socket是否已經準備好.
更好地支持telnet協議
加入常用的命令:幫助,列出在聊天室中的用戶名單,退出等等
用戶賬號密碼保護
多個聊天房間
權限控制
私人聊天房間
等等...