#!/usr/bin/perl -w
use strict;
(%main::params,@main::ERR,@main::WARN,@main::MSG,@main::DBG) = ((),(),(),(),());
$main::LogFile = $ENV{'DOCUMENT_ROOT'}.'/redirect_log.txt';
$main::OneparamOnly = 'ref';
Err: {
next Err unless(&parsingRequest());
last Err;
} continue {
&main::browseResponse();
}
exit;
#_____________________________________________________________________________________
#http://www.plantime.msk.ru/cgi-bin/url.cgi?www.keyelement.ru
#_____________________________________________________________________________________
sub parsingRequest()
{
&main::getDataForm(\%main::params);
unless(defined$main::params{$main::OneparamOnly}){
push(@main::ERR,"Не указан url");
}
else{
unless($main::params{$main::OneparamOnly} =~ m/((((ht|f)tp):(\/\/))?([a-z0-9.:@*()~#\]\[_?=&\/\\-])+)/o){
push(@main::ERR,"Указан неправильный url");
}
else{
my $href = $main::params{$main::OneparamOnly}; #$1 if($1);
$href = 'http://'.$href if($href!~m/^(((ht|f)tp):(\/\/))/o);
# $pathToFile = (($main::params{$main::OneparamOnly} =~ m/^([\/\w\-\.:#\?]+)$/o)?"$1":'');
return &main::Logs() && &main::locate($href) if($href);
&main::browseResponse();
return print "
".$href."!!!!!";
}
}
return 0;
}
#_____________________________________________________________________________________
sub Logs
{
my @date = localtime(time); $date[4]++;
my $Time = "$date[4]/$date[3]/$date[5]";
my $str = ($main::buff?$main::buff: $main::params{$main::OneparamOnly});
open(LOG,'>>'.$main::LogFile) || &Error("Cannot Write Log File : $main::LogFile, Error $!\n");
print LOG "[$Time] - $ENV{'REMOTE_HOST'} -> ".$str."\n";
close(LOG);
}
#_____________________________________________________________________________________
sub locate
{
my $url = shift @_;
print "Status:301 Moved\n";
print "Date: $ENV{'DATE'}\n" if(exists$ENV{'DATE'});
print "Location: ".$url."\n\n";
print "Content-type: text/html\n";
print "Connection: close\n\n";
return 1;
}
#_____________________________________________________________________________________
sub getDataForm
{
my $dataForm = shift @_;
my $handle = shift @_;
my @tmpGet = ();
my $buff = '';
my($key,$value)= ('','');
$handle ||= \*STDIN;
if($ENV{QUERY_STRING}){
@tmpGet= ( $main::OneparamOnly ? ($ENV{QUERY_STRING}) : split (/&/, $ENV{'QUERY_STRING'}));
if($main::OneparamOnly){
@tmpGet= ($ENV{'QUERY_STRING'});
}else{
@tmpGet= split (/&/, $ENV{'QUERY_STRING'});
}
foreach my $el (@tmpGet)
{
$el =~ s/%([0-9A-F][0-9A-F])/pack("C",hex($1))/ge;
$el =~ tr/+/ /;
unless($main::OneparamOnly){
($key,$value) = split(/=/, $el);
}else{
$value = $el;
}
$dataForm->{($key?$key:$main::OneparamOnly)}= $value;
push(@main::ERR,($key?$key:$main::OneparamOnly)."=".$value);
}
}elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read $handle,$buff,$ENV{'CONTENT_LENGTH'};
@tmpGet = (@tmpGet,split (/&/, $buff));
$main::buff = $buff; # if( $main::conf{'AllOprToLogFile'} );
}
return $dataForm;
}
#_____________________________________________________________________________________
sub browseResponse
{
print "Content-type: text/html\n";
print "Cache-Control: no-cache\n\n";
print "