作者：CppExplore 网址：http://www.cppblog.com/CppExplore/
最近为了测试自己的程序，又避免和其它模块联调，用perl写了几个陪测程序，拿来秀一下。工具就是工具而已，我无意于创造华丽的轮子，陪测工具够用就好。这几个陪测程序演示了udp/tcp server、udp/tcp client，希望对大家能有点帮助。
第一个：radius server。近来的项目都是一期项目，radius只做认证，因此陪测程序也只做了认证，加accout也是很简单的事情。radius是个很简单的协议，简单描述下：client发送请求包的结构如下：8位code表示请求类型，8位packetid表示包的顺序号，16位包长度，128位标识，后边跟属性，8位属性名，8位属性长度，后面接属性value，后面继续属性。server端接收到以后，回复包结构：8位code表示回复类型，8位packetid，16位长度，128位标识，后面属性。注意这里的128位标识不是client发来的，它是该包的code＋packetid＋client的标识＋该包后面属性＋公用密钥后md5计算，取前128位的结果。
#!/usr/bin/perl
use Socket;
use Digest::MD5 qw(md5 md5_hex md5_base64);
print "radius server start
"."\n";
open(fp1,"./server_config");
$/="\r\n";
while($a=<fp1>)
{
if($a=~/port=/)
{
$a=~s/port=//;
chomp($port=$a);
print "port=".$port;
}
if($a=~/secret=/)
{
$a=~s/secret=//;
chomp($secret=$a);
print "secret=".$secret;
}
}
socket(sockmain,PF_INET,SOCK_DGRAM,0)||die "socket error:$!\n";
setsockopt(sockmain, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ||die "setsockopt: $!";
bind(sockmain, sockaddr_in($port, INADDR_ANY)) ||die "bind: $!";
while(1)
{
$hispaddr=recv(sockmain,$buf,1024,0);
print "a client connect"."\n";
my $requestTypeord=ord(substr($buf,0,1));
print '$requestTypeord='.$requestTypeord."\n";
my $packetId=ord(substr($buf,1,1));
print '$packetId='.$packetId;
my $packet_length=ord(substr($buf,2,1))*256+ord(substr($buf,3,1));
print '$packet_length='.$packet_length."\n";
my $identifier=substr($buf,4,16);
$location=20;
while($location<$packet_length)
{
$attribute=ord(substr($buf,$location,1));
print "\n".'$attribute='.$attribute."\n";
$attribute_length=ord(substr($buf,$location+1,1));
print '$attribute_length='.$attribute_length."\n";
$value=substr($buf,$location+2,$attribute_length-2);
print '$value='.$value."\n";
$location+=$attribute_length;
}
$data=chr(2).chr($packetId).chr(0).chr(20).$identifier.$secret;
$data=md5($data);
$response=chr(2).chr($packetId).chr(0).chr(20).substr($data,0,16);
send(sockmain,$response,0,$hispaddr);
print "send access sucess!"."\n";
}
print "close."."\n";
close ($main_sock);其中，./server_config是配置文件，里面配置了两项，端口和公用密钥。
port=6011
secret=12345678
第二个：http sever。我们部门的项目对各个网元server的管理命令采用http协议，也就有了这个和后面的http client陪测程序：client发送参数使用post方式，server回送的数据内容采用xml。
#!/usr/bin/perl
use Socket;
$SIG{CHLD} ="IGNORE";
print "http server start\n";
$\="\r\n";
my %map;
open(fp1,"./server_config");
$/="\r\n";
while($a=<fp1>)
{
if($a=~/cmd=/)
{
$a=~s/cmd=//;
chomp($cmd=$a);
$value="";
while($b=<fp1>)
{
$b=~s/{//;
$b=~s/\s*(\w*)\s*/$1/;
chomp($b);
if($b=~/}/)
{
$b=~s/}//;
$value.=$b;
last;
}
$value.=$b;
}
$map{$cmd}=$value;
print $cmd."=".$value."\n";
}
if($a=~/port=/)
{
$a=~s/port=//;
chomp($port=$a);
print "port=".$port;
}
}
socket(sockmain,PF_INET,SOCK_STREAM,0)||die "socket error:$!\n";
setsockopt(sockmain, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) ||die "setsockopt: $!";
bind(sockmain, sockaddr_in($port, INADDR_ANY)) ||die "bind: $!";
listen(sockmain,5)|| die "listen: $!";
while (accept($new_sock,sockmain) )
{
$pid = fork();
die "cann't fork " unless defined($pid);
if ($pid == 0)
{
print ">>>>>>>>>>>>>>>>\n";
recv($new_sock,$buf,1024,0);
print "$buf";
$len=index($buf,"POST",0);
$len2=index($buf,' HTTP/1.1',$len);
$new_cmd=substr($buf,$len+6,$len2-$len-6);
print $new_cmd;
$msg="<?xml version=\"1.0\" encoding=\"UTF-8\"?><response command=\"".
$new_cmd."\">".
$map{$new_cmd}.
"</response>";
$result="HTTP/1.1 200 OK\r\n".
"Content-Length: ".length($msg)."\r\n".
"Content-Type: text/xml; charset=UTF-8\r\n".
"\r\n".$msg;
send($new_sock,$result,0);
print "<<<<<<<<<<<<<<<<<\n";
print $result."\n";
exit(0);
}
}
print "close.\n";
close ($main_sock);
其中./server_config是配置文件，里面配置了端口，需要响应的命令以及响应的内容。
port=9120
cmd=DeviceRegister
{
<result code="0">OK</result>
}
第三个：http client。再copy代码就太罗唆了，呵呵。还是老样子，先读取配置文件，拿到要连接的ip:port,要发送的命令，post的参数，然后构造http信令，connect到server，send就好了，之后再recv下server的响应。
第四个：rtsp client。思路也在上一篇文章里说了，不再罗唆了。这个和前几个不同的是，这个陪测脚本是我上个项目主要的业务测试脚本，是业务的发起者。因此（1）配置文件名作为参数传递进去 （2）配置文件可以配置各种信令的以及各种发送流程（3）使用一个新的脚本调用大量使用不同配置文件的如此脚本，用来做稳定性压力测试