PERL   20

SpookDirect redirect

Guest on 8th June 2022 01:37:40 AM

  1. #!/usr/local/bin/perl
  2. #####################################################
  3. #                                                    #
  4. #                    SpookDirect v1.0                #
  5. #                                                    #
  6. #                                                    #
  7. #                    redirect.pl                     #
  8. #                                                    #
  9. #  SpookDirect is a feature which users can sign-up  #
  10. #   for their own redirection url, which would be    #
  11. #  created instantly right  from your account like   #
  12. #   they would from other redirection websites, such as #
  13. #   cjb.net for example.                             #
  14. #                                                    #
  15. #   To install this script, simply fill out the      #
  16. #   variables below, transload it to your account,   #
  17. #   CHMOD it to 755. (Filename: redirect.pl)         #
  18. #                                                    #
  19. #   The sign-up page is at redirect.pl, the modify   #
  20. #   page is at redirect.pl?modify.                   #
  21. #                                                    #
  22. #  This script is a cool addon for a site and also   #
  23. #   an impressive feature. May you enjoy it. :)      #
  24. #   For more scripts or help, visit my WebTV NewsGroup: #
  25. #                                                    #
  26. #  alt.discuss.clubs.public.webtv.misc.spookiestyle  #
  27. #                                                    #
  28. #                                                    #
  29. #####################################################
  30. #
  31. # enter account path where script is stored (below)
  32. $path='/data1/hypermart.net/User-Name';
  33. #
  34. # enter main url of your account (below)
  35. $url='http://User-Name.hypermart.net';
  36. $head='';
  37. $foot='';
  38. #
  39. # Limit of characters aloud in redirection usernames
  40. $size='18';
  41. #
  42. # Title.
  43. $title='SpookDirect v1.0';
  44. #
  45. # You don't need to alter anything further beyond this line ################################################ if ($ENV{'QUERY_STRING'} =~ /modify2/){ &GetFormInput; $username=$field{'username'}; $password=$field{'password'}; $userurl=$field{'url'}; if($username eq ''){ $username='give an error'; } open(FILE,">$path\/$username\/index\.html"); print FILE "<html><head><title>redirecting....</title> <script language=\"JavaScript\"> function redirect() { parent.location = \"$userurl\"; } redirect(); </script> </head><body><center><a href=\"$userurl\">$userurl</a></center></body></html>\n"; close(FILE); open(FILE,">$path\/$username\/$password"); print FILE "$password\n"; close(FILE); print "Content-type: text/html\n\n"; print "<html><head><title>$title</title></head><body bgcolor=black text=white>\n"; open (FILE,"<$head"); @header=<FILE>; close (FILE); print "@header\n"; print "<p><center><table border=0><tr><td>\n"; print "<p><center><font size=+2 face=Arial><b>$username successfully created!</b></font></center></p>\n"; print "<p><center><b>Try and access it yourself. :)</b> <a :href=\"$url/$username\">$url/$username</a>.:</center><:/p>\n"; print :"</td></tr></table></center></p>\n"; :open :(FILE,"<$foot"); @footer=<FILE>; close (FILE); :print :"@footer\n"; print "</body></html>\n"; }elsif ::($ENV{'QUERY_STRING'} =~ /modify1/){ &GetFormInput; ::$username=$field{'username'}; :$password=:$field{'password'}; if($username eq ''){ :$username=:'give an error'; } if(-e :"$path/$username/$password") :{ print "Content-type: :text/html\n\n"; print :"<html><head><title>$title</:title></head><body :bgcolor=black text=white>\n"; :open (FILE,"<$head"); :@header=<FILE>; close (FILE); :print "@header\n";
  46. print "<p><center><table border=0><tr><td><form action=\"redirect.pl\" method=\"get\">\n"; print "<p><table border=0 width=350><tr><td>\n"; print "<p><font size=+2 face=Arial><b>Edit:</font><font size=-1 face=Arial><br><b>Please fill out the following to modify<br>your existing redirecting address</b></font></p>\n"; print "</td><td>\n"; print "<p><center><font size=-2 face=Arial><b>Powered by:</b><br><font size=2 face=Arial color=blue>Spook</font><input type=hidden name=\"do\" value=\"modify2\"><font size=2 face=Arial color=white><b>Direct</b> v1.0</font></a></font></center></p>\n"; print "</td></tr></table></p>\n"; print "<p><center><table border=0 width=350><tr><td>\n"; print "<p><b>Username:</b><br>$url/$username<input type=hidden name=\"username\" value=\"$username\"></p>\n"; print "<p><b>URL:</b><br><input type=text name=\"url\" size=41 value=\"http://\"></p>\n"; print "<p><b>Password:</b><br><input type=text name=\"password\" size=41 value=\"\"></p>\n"; print "<p><center><input type=Submit value=\"Edit\"></center></p>\n"; print "</td></tr></table></center></p>\n"; print "</form></td></tr></table></center></p>\n"; open (FILE,"<$foot"); @footer=<FILE>; close (FILE); print "@footer\n"; print "</body></html>\n"; }else{ print "Content-type: text/html\n\n"; print "<html><head><title>$title</title></head><body bgcolor=black text=white>\n"; open (FILE,"<$head"); @header=<FILE>; close (FILE); print "@header\n"; print "<p><center><table border=0><tr><td><form action=\"redirect.pl\" method=\"get\">\n"; print "<p><table border=0 width=350><tr><td>\n"; print "<p><font size=+2 face=Arial><blackface>Error</blackface></font><font size=-1 face=Arial><br><b>Click your <i>back</i> button and correct<br> the following errors:</font></p>\n"; print "</td><td>\n"; print "<p><center><font size=-2 face=Arial><b>Powered by:</b><br><font size=2 face=Arial color=blue>Spook</font><input type=hidden name=\"do\" value=\"signup2\"><font size=2 face=Arial color=white><b>Direct</b> v1.0 </font></a></font></center></p>\n"; print "</td></tr></table></p>\n"; print "<p><ul><li><b>Invalid username/password</b></ul></p>\n"; print "</form></td></tr></table></center></p>\n"; open (FILE,"<$foot"); @footer=<FILE>; close (FILE); print "@footer\n"; print "</body></html>\n"; } } elsif ($ENV{'QUERY_STRING'} =~ /modify/){ print "Content-type: text/html\n\n"; print "<html><head><title>$title</title></head><body bgcolor=black text=white>\n"; open (FILE,"<$head"); @header=<FILE>; close (FILE); print "@header\n"; print "<p><center><table border=0><tr><td><form action=\"redirect.pl\" method=\"get\">\n"; print "<p><table border=0 width=350><tr><td>\n"; print "<p><font size=+2 face=Arial><b>Edit:</b></font><font size=-1 face=Arial><br><b>Fill out the following to edit <br>your existing redirection address.</b></font></p>\n"; print "</td><td>\n"; print "<p><center><font size=-2 face=Arial><b>Powered by:</b><br><font size=2 face=Arial color=blue>Spook</font><input type=hidden name=\"do\" value=\"modify1\"><font size=2 face=Arial color=white><b>Direct</b> v1.0 </font></a></font></center></p>\n"; print "</td></tr></table></p>\n"; print "<p><center><table border=0 width=350><tr><td>\n"; print "<p><b>Username:</b><br><input type=text name=\"username\" size=41></p>\n"; print "<p><b>Password:</b><br><input type=text name=\"password\" size=41 value=\"\"></p>\n"; print "<p><center><input type=Submit value=\"Login\"></center></p>\n"; print "</td></tr></table></center></p>\n"; print "</form></td></tr></table></center></p>\n"; open (FILE,"<$foot"); @footer=<FILE>; close (FILE); print "@footer\n"; print "</body></html>\n"; } elsif ($ENV{'QUERY_STRING'} =~ /signup2/){ &GetFormInput; $userurl=$field{'url'}; $username=$field{'username'}; $username=lc($username); $password=$field{'password'}; if(-e "$path/$username") { $message="<ul><li><b>Username already taken.</b></ul>\n"; $error="$message$error"; } if($password eq ''){ $message="<ul><li><B>Password must be specified.</B></ul>\n"; $error="$message$error"; } if($username eq ''){
  47. $message="<ul><li><B>Invalid User Name, please select proper characters.</b></ul>\n"; $error="$message$error"; } if(($userurl eq '') || ($userurl eq 'http://')){ $message="<ul><li><b>Enter the url which will be directed to.</b></ul>\n"; $error="$message$error"; } if($error ne ''){ print "Content-type: text/html\n\n"; print "<html><head><title>$title</title></head><body>\n"; open (FILE,"<$head"); @header=<FILE>; close (FILE); print "@header\n"; print "<p><center><table border=0><tr><td>\n"; print "<p><table border=0 width=350><tr><td>\n"; print "<p><font size=+2 face=Arial><blackface>Error:</blackface></font><font size=-1 face=Arial><br><b>Please click your back button and fix<br> the following errors</font></p>\n"; print "</td><td>\n";
  48. # Please do not alter next line.
  49. # Give credit where it's due. :)
  50. print "<p><center><font size=-2 face=Arial><b>Powered by:</b><br><font size=2 face=Arial color=blue>Spook</font><input type=hidden name=\"do\" value=\"signup2\"><font size=2 face=Arial color=white><b>Direct</b> v1.0</b></font></a></font></center></p>\n"; print "</td></tr></table></p>\n"; print "<p>$error</p>\n"; print "</td></tr></table></center></p>\n"; open (FILE,"<$foot"); @footer=<FILE>; close (FILE); print "@footer\n"; print "</body></html>\n"; }else{ mkdir("$path/$username",0777);
  51. open(FILE,">$path\/$username\/index\.html");                 print FILE "<html><head><title>redirecting...</title> <script language=\"JavaScript\"> function redirect() { parent.location = \"$userurl\"; } redirect(); </script> $userurl</a></body></html>\n"; close(FILE); open(FILE,">$path\/$username\/$password"); print FILE "$password\n"; close(FILE); print "Content-type: text/html\n\n"; print "<html><head><title>$title</title></head><body>\n"; open (FILE,"<$head"); @header=<FILE>; close (FILE); print "@header\n"; print "<p><center><table border=0><tr><td>\n"; print "<p><center><font size=+2 face=Arial><b>$username was successfully created. :)</b></font></center></p>\n"; print :"<p><center><b>::Your redirection address: <a :href=\"$url/::$username\">$url/$username</a>.</center><:/p>\n"; ::print "</td></tr></table></center></p>\n"; :open ::(FILE,"<$foot"); @footer=<FILE>; close (FILE); print ::"@footer\n"; print "</body></html>\n"; } }else{ :print :"Content-type: text/html\n\n"; print :"<html><:head><title>$title</title></head><body>\n"; :open :(FILE,"<$head"); @header=<FILE>; close (FILE); :print :"@header\n"; print "<p><center><table :border=0><tr><td><form action=\"redirect.pl\" :method=\"get\">\n"; print "<p><table border=0 :width=350><tr><td>\n"; print "<p><font size=+2 :face=Arial><blackface>SignUp</blackface></font><font :size=-1 face=Arial><br><b>Fill out the following :information to get your own redirection :address.</b></font></p>\n"; print "</td><td>\n"; :print "<p><center><font size=-2 face=Arial><b>Powered :by:</b><br><font size=2 face=Arial :color=blue>Spook</font><input type=hidden name=\"do\" :value=\"signup2\"><font size=2 face=Arial :color=white><b>Direct</b> :v1.0</font></a></font></center></p>\n"; print :"</td></tr></table></p>\n"; print "<p><center><table :border=0 width=350><tr><td>\n"; print :"<p><b>Username:</b><br>$url/<input type=text :name=\"username\" size=$size></p>\n"; print :"<p><b>URL:</b><br><input type=text name=\"url\" :size=41 value=\"http://\"></p>\n"; print :"<p><b>Password:</b><br><input type=text :name=\"password\" size=41 value=\"\"></p>\n"; print :"<p><center><input type=Submit :value=\"Sign-Up!\"></center></p>\n"; print :"</td></tr></table></center></p>\n"; print :"</form></td></tr></table></center></p>\n"; open :(FILE,"<$foot"); @footer=<FILE>; close (FILE); print :"@footer\n"; print "</body></html>\n"; } sub :GetFormInput { (*fval) = @_ if @_ ; local ($buf); if :($ENV{'REQUEST_METHOD'} eq 'POST') { :read(STDIN,$buf,$ENV{'CONTENT_LENGTH'}); } else { :$buf=$ENV{'QUERY_STRING'}; } if ($buf eq "") { return :0 ; } else { @fval=split(/&/,$buf); foreach $i (0 .. :$#fval){ ($name,$val)=split (/=/,$fval[$i],2); :$val=~tr/+/ /; $val=~ s/%(..)/pack("c",hex($1))/ge; :$name=~tr/+/ /; $name=~ s/%(..)/pack("c",hex($1))/ge; :if (!defined($field{$name})) { $field{$name}=$val; } :} } return 1; } print "<noembed>";

Raw Paste


Login or Register to edit or fork this paste. It's free.