URL转向
#!/usr/bin/perl -wT
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### 这是我的第一个翻译的Perl程序,而且是最新版本,
### 在这里可以提供免费下载及使用。
### 如果由于此脚本对您产生任何损害,本人盖不负责。
### 在本人服务器上,该程序测试和工作都很不错, 
### 不过对一些其他服务器可能会不能正常工作。
###
### 如何安装和使用...
###
### 你必须下载4个文件:
### ".htaccess" 复制到你的根目录下,如果有必要的话请改变文件所设置的路径。
###       注意对cgi脚本参数应设置为"?redir=1".
### "redir.txt" 复制到cgi-bin目录下. chmod 改为 766 
### "redir.cgi" chmod 改为 755
### "ad.html" (可以重命名) 复制到任何html目录中。
###
### 改变文件中的 $ADURL 为您的实际 url.
### that should be it..
###
### 请使用"redir.cgi" 来进行WebForward
###
### http://www.darkhexer.de/dds


$ADURL ="http://www.darkhexer.de/exe/ad.html";






use CGI qw(:standard);
my @eintrag;
print "content-type:text/html\n\n";
if (param("add"))
{
###
### 添加新用户.
### 这儿可能有些小bug...
###
   datenlesen ();
   my $falsch=0;
   my $li = param("li");
   my $pw = param("pw");
   my $url = param("url");
   my $mail = param("mail");
   my $head = param("head");
   $li =~ s/[^a-z0-9]*//g;
   $pw =~ s/[^a-zA-Z0-9]*//g;
   $url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
   $mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
   $head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
###
### find out whether everything is in the right order!
###
   if ($li ne param("li")){
    $falsch=1;
    print"Wrong login-name! Use a-z and 0-9 only!<br>";
   }
   if ($pw ne param("pw")){
    $falsch=1;
    print"Wrong password! User a-z, A-Z and 0-9 only!<br>";
   }
   if ($url ne param("url")){
    $falsch=1;
    print"Wrong adress! Use a-z, A-Z, 0-9 and / only!<br>";
   }
   if ($mail ne param("mail")){
    $falsch=1;
    print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!<br>";
   }
   if ($head ne param("head")){
    $falsch=1;
    print"Wrong headline! Use a-z, A-Z, 0-9 and \".\" only!<br>";
   }
   $i=0;
   while ($Name[$i]){
    #print $Name[$i];
    if ($li eq $Name[$i]){
      $falsch=1;
      print"This login already exists!<br>";
      last;
    }
    $i++;
   }

   if (param("li") && param("pw") && param("url") && param("mail") && ($falsch ne 1))
   {
###
### 看上去可以了... 新用户加入!
###
    datenschreiben ();
    open (Datei, ">>redir.txt");
    print Datei param("li"),";;";
    print Datei param("url"),";;";
    print Datei param("pw"),";;";
    print Datei param("head"),";;";
    print Datei param("mail"),";;\n";
    close (Datei);
    print "Account created.<br>You can now ";
    print"<a href=\"redir.cgi\">login</a>\n";
    print" to your account.";
    exit;
   }
###
### 提示用户给出需要的数据(如果错误的话就改变)
###
   print "You can create a new account:<br>";
   print "Please fill out all fields!";
   print "<form action=\"redir.cgi\" method=\"POST\">";
   print "<p>Desired login<br><input type=\"text\" size=\"20\" name=\"li\" value=\"",param("li"),"\"></p>\n";
   print "<p>Gew黱schtes Passwort<br><input type=\"text\" size=\"20\" name=\"pw\" value=\"",param("pw"),"\"></p>\n";
   print "<p>URL of your site<br><input type=\"text\" size=\"20\" name=\"url\" value=\"",param("url"),"\"></p>\n";
   print "<p>Desired headline<br><input type=\"text\" size=\"20\" name=\"head\" value=\"",param("url"),"\"></p>\n";
   print "<p>Your email-adress<br><input type=\"text\" size=\"20\" name=\"mail\" value=\"",param("mail"),"\"></p>\n";
   print "<input type=\"hidden\" name=\"add\" size=\"16\" value =\"add\">\n";
   print "<p><input type=\"submit\" name=\"B1\">\n<input ";
   print "type=\"reset\" name=\"B2\"></p>" ;
   print "</form>";
   exit;

}


if (param("li") && param("pw"))
###
### This part is used to give the Users the possibility to
### log into their accounts to change data or delete account
###
{
  datenlesen ();
  $ReqLi = param("li");
  $ReqPw = param("pw");
  $i=0;
  while ($Name[$i])
  {
   if (($Name[$i] eq $ReqLi)&&($Password[$i] eq $ReqPw))
   {
    $LiOK=1;
    $Nummer = $i;
    last;
   }
   $i++;
  }
  if ($LiOK)
###
### Login is OK, so start edit window
###

  {
   my $falsch=0;
   my $pw="";
   if (param("np")){
    $pw = param("np");
   }
   else {
    $pw = $Password[$Nummer];
   }
   my $url = param("url");
   my $mail = param("mail");
   my $head = param("head");
   $pw =~ s/[^a-zA-Z0-9]*//g;
   $url =~ s/[^a-zA-Z0-9\/\.\:]*//g;
   $mail =~ s/[^a-zA-Z0-9\.\@\-]*//g;
   $head =~ s/[^a-zA-Z0-9\.\-\ ]*//g;
   if ($pw eq param("np")){
    $ReqPw = param("np");
    $Password[$Nummer] = param("np");
   }
   else{
    $ReqPw = $Password[$Nummer];
   }
   if (param("url")){
    $Adresse[$Nummer]=param("url");
    if (substr($Adresse[$Nummer],length($Adresse[$Nummer])-1,1) eq "/"){ 
     $Adresse[$Nummer]= substr ($Adresse[$Nummer],0,length($Adresse[$Nummer])-1)
    }
   }
   if ($Adresse[$Nummer] eq "*delete*"){
    datenschreiben ($Nummer);
    print "Account gel鰏cht";
    exit;
   }
   if (param("mail")){
    $eMail[$Nummer]=param("mail");
   }

   if (param("head")){
    $Head[$Nummer]=param ("head");
   }
   print"Login as ",$ReqLi,"<br>";
   print"You can now change your account-data.<br>";
###
### 找出是否每项都正确!
###
   if (($pw ne param("np")) && (param("np"))){
    $falsch=1;
    print"Wrong password! Use a-z, A-Z and 0-9 only!<br>";
   }
   if ($url ne param("url")){
    $falsch=1;
    print"Wrong URL! Use a-z, A-Z, 0-9 and / only!<br>";
   }
   if ($mail ne param("mail")){
    $falsch=1;
    print"Wrong email-adress! Use a-z, A-Z, 0-9, \".\" and \"@\" only!<br>";
   }
   if ($head ne param("head")){
    $falsch=1;
    print"Wrong headline! use a-z, A-Z, 0-9 and \".\" only!<br>";
   }


   if ($falsch ne 1){
    datenschreiben ();
   }
   else {
    print"<br>Data not saved!.<br>";
   }

   print"<form action=\"redir.cgi\" method=\"POST\">" ;
   print"<p>Password <input type=\"text\" size=\"20\" name=\"np\" value=\"",$Password[$Nummer],"\"></p>\n";
   print"<p>URL <input type=\"text\" size=\"20\" name=\"url\" value=\"",$Adresse[$Nummer],"\"></p>\n";
   print"<p>Headline <input type=\"text\" size=\"20\" name=\"head\" value=\"",$Head[$Nummer],"\"></p>\n";
   print"<p>eMail <input type=\"text\" size=\"20\" name=\"mail\" value=\"",$eMail[$Nummer],"\"></p>\n";
   print"<input type=\"hidden\" name=\"li\" size=\"16\" value =\"",$ReqLi,"\">\n";
   print"<input type=\"hidden\" name=\"pw\" size=\"16\" value =\"",$ReqPw,"\">\n";
   print"<p><input type=\"submit\" name=\"B1\">\n<input ";
   print"type=\"reset\" name=\"B2\"></p>" ;
   print"</form>";
   print"<p><a href=\"redir.cgi\">Logout</a><br><br>\n";
   print"To delete your account type in \"*delete*\" for your URL.</p>";
  

  }
  else
  {
   print "Login or password not ok!<br>\n";
   print "Click back on your browser and try again";
  }
  exit;
}
else
{
  if (!param("redir") && !param("add"))
  {                 
   print"Please type in your login and password.<br>";
   print"<form action=\"redir.cgi\" method=\"POST\">" ;
   print"<p>Login: <input type=\"text\" size=\"20\" name=\"li\"></p>\n";
   print"<p>Password: <input type=\"text\" size=\"20\" name=\"pw\"></p>\n";
   print"<p><input type=\"submit\" name=\"B1\">\n<input ";
   print"type=\"reset\" name=\"B2\"></p>" ;
   print"</form>";
   print"<p><a href=\"redir.cgi?add=1\">New account</a><br>\n";
   print"<a href=\"http://www.darkhexer.de/dds/\">Powered by DDS</a></p>";

  }
}


if (param("redir"))
###
### This is the main part of the script - here lies the key
### of the actual web-forwarding
###

{
  @Url = split(/\//,$ENV{'REDIRECT_URL'});
  $UrlNum = 1;
###
### 如果每项工作都不错(登录, 新帐号, 删除等)
###
### 如果有问题的话,请联系我: [email protected]
###
### print $Url[0],";",$Url[1],";",$Url[2],";",$Url[3],";",$Url[4],";",$Url[5];
  $Url[$UrlNum]=lc $Url[$UrlNum];
  datenlesen ();
  $i=0;
  $erfolgreich=0;
  while ($Adresse[$i]){
   if ($Name[$i] eq $Url[$UrlNum]){
    $NewUrl = $Adresse[$i];
    $j = $UrlNum+1;
    for(@Url)
    {
     if (defined $Url[$j]) {$NewUrl = $NewUrl."/".$Url[$j]};
     $j++;
    }
    $erfolgreich = 1;
    last;
   }
   $i++;
  }        
  if ($erfolgreich eq 0){
   print "File not found!";
   print " ",@Url;
  }
 
  if ($erfolgreich eq 1){
   print"<html><head><title>",$Head[$i],"</title></head>\n";
   print"<frameset rows=\"100%,*\" border=0 framespacing=0 frameborder=0>\n";
   print"<frame src=\"",$NewUrl,"\" name=\"DarkHexerDesignScripting\">\n";
   print"<frame src=\"",$ADURL,"\" name=\"REDIRADFRAME\"noresize ";
   print"marginwidth=0 marginheight=0 frameborder=0 framespacing=0 border=0>\n";
   print"</frameset></frameset></body></html>";
   
  }
}

sub datenlesen

### 读取用户数据,并转变为数组以便让我更容易工作
###
{
  open (Datei, "redir.txt") || die "File not found";
  while(<Datei>)
  {
   push(@eintrag,$_);
  }
  close(Datei);
  $i=0;
  for (@eintrag)
  {
   my @Data = split(/;;/,$eintrag[$i]);
   $Name[$i]=$Data[0];
   $Adresse[$i]=$Data[1];
   $Password[$i]=$Data[2];
   $Head[$i]=$Data[3];
   $eMail[$i]=$Data[4];
   $i++;
  }

}

sub datenschreiben

###
### 将用户数据写入文件
###
{
  open (Datei, ">redir.txt");
  $i=0;
  my $del = $_[0];
  for (@Name)
  {
   if ( (!defined $del) || ($del ne $i) )
   {
    print Datei $Name[$i],";;";
    print Datei $Adresse[$i],";;";
    print Datei $Password[$i],";;";
    print Datei $Head[$i],";;";
    print Datei $eMail[$i],";;\n";
   }
   $i++;
  }
  close (Datei);

}