求助,socket

[marmot]

最近要用perl写socket的server 和client，无奈不入门，求高手指点迷津，介绍相关文章，并高分索要可用的例子源程序。拜托
email: [e-mail]

[xiangqian]

cloud.o-red.com

[wildhorse01]

如何用PERL编写聊天室服务器程序

原作者: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程序没有从<stdin>读到什么东西,它就停下来等待直到用户准备好. (这叫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协议

加入常用的命令:帮助,列出在聊天室中的用户名单,退出等等

用户账号密码保护

多个聊天房间

权限控制

私人聊天房间

等等...

<完>

[Itboy]

xiangqian(天阁流云)　我看过那里的聊天室了
相当的棒,那里可以得到代码呢,能告诉我吗
Email:[e-mail]