一个比较好用的cgi探针

如果要测试服务器是不是支持cgi程序运行，需要一款探针测试。现在网上找到一款探针，飞天探针，非常方便！程序代码如下：

#!/usr/bin/perl
#把上面一行修改成Perl所在路径
#-----------------------------------
#   飞天精彩CGI探针-   V1.0
#
#  本程序由 “飞天精彩” 网站提供
#  在其他同类程序参考下改写而成
#
#  作者：飞天虾
#  网址：http://www.vvbbs.com
#  
# 任何网站或个人可以使用本程序
#但请不要修改任何版权信息！谢谢
#
#  本探针可以探测：
#1.当前目录的绝对路径
#2.服务器时间
#3.服务器环境变量
#4.Perl版本
#5.服务器操作系统
#6.服务器常用程序的位置（sendmail等）
#7.服务器操作系统支持的功能（flock等）
#8.服务器已安装的Perl模块
# 如果您发现程序不完善或有任何建议，请
#与作者飞天虾（[email protected]）
#
#   版本更新：请关注飞天精彩网站
#   http://www.vvbsb.com
#
#参考程序 彬彬服务器环境探测器   V1.0
#         九天小虫CGI环境探针
# 
#---------不要修改以下内容---------

$vvbbs="$ENV{'QUERY_STRING'}";
if ($vvbbs eq mk) {&vvbbsmk}
elsif ($vvbbs eq "flock") {&flock}
elsif ($vvbbs eq "crypt") {&crypt}
elsif ($vvbbs eq "alarm") {&alarm}
elsif ($vvbbs eq "fork") {&fork}
else{&vvbbscy}

sub vvbbscy{
@ltime=localtime;
$year=@ltime[5] + 1900;
$month=@ltime[4];
$day=@ltime[3];
$hour=@ltime[2];
$min=@ltime[1];
$sec=@ltime[0];
$servertime="$year年$month月$day日 $hour:$min:$sec";
unless ($ENV{'SERVER_PORT'} eq "80"){$port=":$ENV{'SERVER_PORT'}"}

&header;
print qq(
    
        服务器的有关参数
    
    
■ CGI 常用信息


   


   

        
信息名称
        
内容
    
     

        
Perl版本
        
$]
    
    

        
服务器操作系统
        
$^O
    
    

        
程序文件绝对路径
        
$ENV{'SCRIPT_FILENAME'}
    
    

        
程序文件URL
        
http://$ENV{'SERVER_NAME'}$port$ENV{'SCRIPT_NAME'}
    
    

        
服务器域名
        
$ENV{'SERVER_NAME'}
    
    

        
服务器时间
        
$servertime
    




);
@envs = keys (%ENV);
%TRAN=(
"HTTP_ACCEPT_ENCODING","客户机能接受的编码",
"HTTP_ACCEPT_CHARSET","客户机能接受的语言代码",
"HTTP_ACCEPT_LANGUAGE","客户机能接受的语言类型",
"HTTP_ACCEPT","客户机可以接受的文件类型",
"HTTP_CONNECTION","当前连接状态",
"HTTP_HOST","服务器域名",
"HTTP_REFERER","调用当前程序的URL地址",
"HTTP_USER_AGENT","系统配置信息",
"CONTENT_LENGTH","输出内容长度",
"COMPUTERNAME","服务器计算机名称",
"DOCUMENT_ROOT","服务器文档根目录",
"GATEWAY_INTERFACE","CGI接口版本",
"NUMBER_OF_PROCESSORS","服务器CPU数量",
"PATH","路径",
"QUERY_STRING","查询字符串",
"REMOTE_ADDR","客户机IP地址",
"REMOTE_HOST","客户机名称",
"REMOTE_PORT","客户机请求端口",
"REQUEST_METHOD","客户机请求方法",
"REQUEST_URI","客户机请求的URL",
"WINDIR","Windows目录",
"SYSTEMROOT","系统启动目录",
"SYSTEMDRIVE","系统硬盘",
"COMSPEC","环境变量解释器",
"USERPROFILE","用户方案文件",
"LOCAL_ADDR","主机IP地址",
"HTTP_COOKIE","浏览器Cookie",
"SCRIPT_FILENAME","脚本文件绝对路径",
"SCRIPT_NAME","脚本文件URL地址",
"SERVER_ADMIN","管理员电子邮件地址",
"SERVER_NAME","服务器域名",
"SERVER_PORT_SECURE","HTTPS端口",
"SERVER_PORT","HTTP端口",
"SERVER_PROTOCOL","服务器访问协议",
"SERVER_SOFTWARE","服务器软件的名称及版本",
"REMOTE_USER","用户名字信息",
"URI","URL地址",
"NAME","名称信息",
"PROCESSOR_ARCHITECTURE","CPU类型",
"PROCESSOR_IDENTIFIER","CPU编号标识",
"PROCESSOR_LEVEL","CPU生产级别",
"PROCESSOR_REVISION","CPU生产版本",
"SERVER_SIGNATURE","服务器签名",
"SERVER_ADDR","服务器IP地址"
);

print qq(

■ CGI 环境变量


   

);
foreach (@envs){
print qq(
     );}
print qq(    

  

        
变量名称
        
参考翻译
        
变量值
    

        
$_
        
$TRAN{$_}
        
$ENV{$_}
    



);

$test_sendmail=`which sendmail`;
unless ($test_sendmail=~"/"){$test_sendmail="未安装"}

$test_qmail=`which qmail-inject`;
unless ($test_qmail=~"/"){$test_qmail="未安装"}

$test_date=`which date`;
unless ($test_date=~"/"){$test_date="未安装"}

$test_fly=`which fly`;
unless ($test_fly=~"/"){$test_fly="未安装"}

print qq(

■ CGI 程序路径


   


 

        
程序名称
        
所在路径
    
    

        
SENDMAIL程序
        
$test_sendmail
    
    

        
QMAIL程序
        
$test_qmail
    
   

        
DATE程序
        
$test_date
    
    

        
FLY程序
        
$test_fly
    



);

print qq(

■ 系统支持情况


   


    
  

        
功能
        
详细信息
        
支持情况
    
     

        
crypt()
        
将密码进行不可逆转的加密
        

    
      

        
flock()
        
在多用户环境下避免多个用户同时对同一文件进行操作引起的损坏
        

    
      

        
alarm()
        
延迟一段时间后向系统用户发出警报
        

    
      

        
fork()
        
建立新的子进程
        

    




);

&footer;
}

sub vvbbsmk{
&header;
use File::Find;

foreach (@INC)
{
    @mods = ();
    $dir = $_;
    find(\&process, $_);
}

print $list, "\n";

sub process{
    return unless /\.pm$/;
    $filename=$File::Find::name;
    $all.=$filename . "; ";
}
print qq(

   


);
print qq(
    


        
所有PERL模块列表
    

        
$all
    
    

);
&footer;
}


sub header{
print "Content-type:text/html\n\n";
print qq(







$js


 飞天精彩  改写的CGI探针-V1.0


是否支持CGI

出现以下情况即表示您的空间不支持CGI：

1、访问本文件时提示下载。

2、访问本文件时看到类似“#!/usr/bin/perl”等的文字。



 
);
}

sub footer{
print qq(

■ 模块及其他


   


    

        
常用信息
         
Perl模块
         
飞天精彩
        
版本更新
        




 
飞天CGI服务器探针V1.0

飞天精彩制作 版权所有© 2002-2003


);
exit;
}

sub flock{
flock(STDIN,2);
flock(STDIN,8);
&makepic;
exit;
}

sub crypt{
$a=crypt(AA,"12345");
&makepic;
exit;
}

sub alarm{
alarm(60);
&makepic;
exit;
}

sub fork{
$a=fork;
&makepic;
exit;
}

sub takebitmap {
if ($_[0]==0) {return $n0[$_[1]];}   
elsif ($_[0]==1) {return $n1[$_[1]];}   
elsif ($_[0]==2) {return $n2[$_[1]];} 
elsif ($_[0]==3) {return $n3[$_[1]];} 
elsif ($_[0]==4) {return $n4[$_[1]];} 
elsif ($_[0]==5) {return $n5[$_[1]];} 
elsif ($_[0]==6) {return $n6[$_[1]];} 
elsif ($_[0]==7) {return $n7[$_[1]];} 
elsif ($_[0]==8) {return $n8[$_[1]];} 
elsif ($_[0]==9) {return $n9[$_[1]];} 
}

sub makepic{
$len=1;
@n0 = ("c3","99","99","99","99","99","99","99","99","c3");
@bitmap=();
for($i=0;$i<10;$i++) {
   for($j=0;$j<$len;$j++) {
      $n="0";
      $bytes=&takebitmap($n,$i); 
      push(@bitmap,$bytes);              
   }
}
for ($i=0;$i<$len*3;$i++) {
    if ($colortype==0) {
       unshift(@bitmap,"ff");    
       push(@bitmap,"ff");       
    }
    else {
       unshift(@bitmap,"00");
       push(@bitmap,"00");
    }
}
print "Content-type: image/x-xbitmap\n\n";
printf ("#define count_width %d\n#define count_height 16\n",$len*8);
printf STDOUT "static char count_bits[] = {\n";
for($i = 0; $i < ($#bitmap+1); $i++) {
   print("0x$bitmap[$i]");
   if ($i != $#bitmap) {
     print(",");
     if (($i+1) % 7 == 0) {
       print("\n");
     }
   }
}
print("};\n");
}