简单的CGI二级域名跳转程序

　　用PERL制作简单的二级域名跳转程序 　出自：Netfolie

　　相信大家都申请过某些站点上提供的免费二级域名，例如网易的youname.yeah.net、youname.126.com等，这是用什么方法来实现的？现在我就用一个简单的二级域名跳转程序来为大家解开这一头雾水。 首先让我们来看看下面的程序，下面的方法是通过默认首页来调用CGI程序达到判断分析并跳转，我们把一页面置于默认的首页（底下有介绍）当我们访问站点时例如：http：//www.cpcw.com的时候，默认首页通过JAVASCIPT调用CGI程序，在程序里我们通过环境变量取得浏览器里输入的URL，对URL通过判断，得出是否二级域名，如果是二级域名就打开我们存储二级域名的文本，获取制定的URL，然后跳转。如果不是二级域名，就跳转到程序里设置的页面。这样，一个简单扼要的二级域名跳转程序就实现了。 　　

　　####程序开始####

　　$myurl="cpcw.com"; # 变量赋值 域名的后序

　　$head="/home/cpcw/"; # 变量赋值 纪录域名文档的目录路径

　　$urlfile="file.txt"; # 变量赋值 纪录域名文档文件名

　　$myhome= "http://www.cpcw.com/main.htm"; # 变量赋值 主页的真实URL

　　@geturl = split(/&/, $ENV{'QUERY_STRING'});#使用split函数拆分脚本参数或者表单输入项，然后赋予@ocpurl

　　foreach (@geturl) {

　　($name,$value) = split(/=/, $_);

　　&setfrom($name, $value);

　　}#循环拆分数组@geturl把其中的值分别赋予变量name和value并调用子程序setfrom对变量加以处理

　　read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

　　@pairs = split(/&/, $buffer);

　　foreach (@pairs) {

　　($name, $value) = split(/=/, $_);

　　&setfrom($name, $value);

　　}#读取用POST递交的表单, 标准输入口的字节数，循环拆分字节赋予变量name和value并调用子程序setfrom对变量加以处理

　　$url =&getvar('url' ,'\n‖');

　　$id =&getvar('id' ,'\n‖');

　　$url ="$myurl" if (!($url =~ /.*\:.*\..*/ ));#从递交的表单里提取相对应的值赋予变量

　　$userip=$ENV{'REMOTE_ADDR'};#提取递交脚本的主机IP地址赋予变量

　　$url=~s/Http:\/\///g;

　　$url=~s/HTtp:\/\///g;

　　$url=~s/HTTp:\/\///g;

　　$url=~s/HTTP:\/\///g;

　　$url=~s/http:\/\///g;

　　$url=~s/hTTP:\/\///g;

　　$url=~s/htTP:\/\///g;

　　$url=~s/httP:\/\///g;

　　$url=~s/hTtP:\/\///g;

　　$url=~s/HtTp:\/\///g;

　　$url=~s/HttP:\/\///g;

　　$url=~s/hTTp:\/\///g;

　　$url=~s/HTtP:\/\///g;

　　$url=~s/htTp:\/\///g;

　　$url=~s/HtTP:\/\///g;

　　$url=~s/hTtp:\/\///g;

　　#把所有可能输入的http://方式都替换成空

　　if (/$url/i != ~$myurl){

　　&error("域名不正确");

　　exit 0;

　　}

　　@name1=split(/\./,$url);

　　$name2=$name1[0];

　　$name2=~tr/A-Z/a-z/;

　　#对从浏览器输入的$url变量做一些处理

　　open (FILE,"$head$urlfile");

　　@line=;

　　close (FILE);

　　#打开我们存储数据的文件并作赋值给@line

　　foreach (@line){

　　@line1=split(/\/,$_);

　　if ($line1[0] eq $name2){

　　$urllink=$line1[1];

　　}

　　}

　　if ($url =~/^$myurl/i){

　　$urllink=$myhome;

　　}

　　if(!($urllink)){

　　printf "无该域名";

　　exit 0;

　　}

　　print "Location: $urllink\n\n";

　　exit 0;

　　sub setfrom {#对变量$name和$value做一些处理和过滤

　　$na