Redir 1.01

Redir 1.01

#!/usr/bin/perl -wT
###
###
### 欢迎来到 DarkHexerDesignSripting (DDS)!
###
### This is my first Perl-Script and in addition this is the first
### version that I offer for YOU to download and use.
### This script is provided "as is". Further developments might
### be available later. I do not accept the responsibility
### for any harm or damage this script might do.
### It is tested and works fine but on other server
### configurations it might not work.
###
### How to install and use it...
###
### You downloaded 4 files:
### ".htaccess" copy to your rootpath and change the path set in
###       file if necessary. Note that the parameter for
###       the cgi-script must set to "?redir=1".
### "redir.txt" copy both to your cgi-bin. chmod TXT to 766
### "redir.cgi" chmod CGI to 755!
### "ad.html" (can be renamed) copy to any html-directory.
###
### change $ADURL in THIS file ... real URL of your ad-html.
### that should be it..
###
### have fun and link to "redir.cgi" to start your 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"))
{
###
### New User addition.
### Here is a little bug... I don't check whether those params are
### defined, so the error-log will get some new lines, but program
### does not stop.
###
   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))
   {
###
### everything seems to be ok so... add new user!
###
    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;
   }
###
### prompt user to give needed data (or change if wrong)
###
   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>";
###
### find out whether everything is in the right order!
###
   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;
###
### If everything works good (login, new account, delete and so on)
### BUT everytime you want to access a forwarded page and you get a
### 404-error use the next print line to find out which part of
### the RedirectUrl (given by server on 404-Error) the
### "Membername" is.
###
### email me if you have problems with that : [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

###
### This sub reads the userdata and converts it into some arrays
### to give me a easier way to work with it
###
{
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

###
### This sub writes the userdata to a file
###
{
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);