1#!/usr/local/bin/perl 2#------------------------------------------------------- 3# Save the click done on managed hits into a trace file 4# and return to browser a redirector to tell browser to visit this URL. 5# Ex: <a href="http://athena/cgi-bin/awredir/awredir.pl?tag=TAGFORLOG&key=ABCDEFGH&url=http://212.43.217.240/%7Eforumgp/forum/list.php3?f=11">XXX</a> 6# Where ABCDEFGH is md5(YOURKEYFORMD5.url) 7# 8# This program is free software; you can redistribute it and/or modify 9# it under the terms of the GNU General Public License as published by 10# the Free Software Foundation; either version 2 of the License, or 11# (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program. If not, see <http://www.gnu.org/licenses/>. 20#------------------------------------------------------- 21 22#use DBD::mysql; 23use Digest::MD5 qw(md5 md5_hex md5_base64); 24 25 26#------------------------------------------------------- 27# Defines 28#------------------------------------------------------- 29use vars qw/ $REVISION $VERSION /; 30$REVISION='20140126'; 31$VERSION="1.2 (build $REVISION)"; 32 33use vars qw / $DIR $PROG $Extension $DEBUG $DEBUGFILE $REPLOG $DEBUGRESET $SITE $REPCONF /; 34($DIR=$0) =~ s/([^\/\\]*)$//; ($PROG=$1) =~ s/\.([^\.]*)$//; $Extension=$1; 35$DEBUG=0; # Debug level 36$DEBUGFILE="$PROG.log"; # Debug output (A log file name or "screen" to have debug on screen) 37$REPLOG="$DIR"; # Debug directory 38 39$TRACEBASE=0; # Set to 1 to track click on links that point to extern site into a database 40$TRACEFILE=0; # Set to 1 to track click on links that point to extern site into a file 41$TXTDIR="$DIR/../../../logs"; # Directory where to write tracking file (if TRACEFILE=1) 42$TXTFILE="awredir.trc"; # Tracking file (if TRACEFILE=1) 43$EXCLUDEIP="127.0.0.1"; 44 45# Put here a personalised value. 46# If you do not want to use the security key in link to avoid use of awredir by an external web 47# site, you can set this to the empty string, but be warned that this is a security hole as everybody 48# can use awredir on your site to redirect to any web site (including illegal web sites). 49$KEYFORMD5='YOURKEYFORMD5'; 50# Put here url pattern you want to allow event if parameter key is not provided. 51$AUTHORIZEDWITHOUTKEY=''; 52 53 54#------------------------------------------------------- 55# Functions 56#------------------------------------------------------- 57 58sub error { 59 print "Content-type: text/html; charset=iso-8859-1\n"; 60 print "\n"; 61 print "<html>\n"; 62 print "<head>\n"; 63 print "</head>\n"; 64 print "\n"; 65 print "<body>\n"; 66 print "<center><br>\n"; 67 print "<font size=2><b>AWRedir</b></font><br>\n\n"; 68 print "<font color=#880000>$_[0].</font><br><br>\n"; 69 print "Setup (setup or logfile permissions) may be wrong.\n"; 70 $date=localtime(); 71 print "<CENTER><br><font size=1>$date - <b>Advanced Web Redirector $VERSION</b><br>\n"; 72 print "<br>\n"; 73 print "</body>"; 74 print "</html>"; 75 die; 76} 77 78#------------------------------------------------------------------------------ 79# Function: Decode an URL encoded string 80# Parameters: stringtodecode 81# Input: None 82# Output: None 83# Return: decodedstring 84#-------------------------------------------------------------------- 85sub DecodeEncodedString { 86 my $stringtodecode=shift; 87 $stringtodecode =~ s/\+/ /g; 88 $stringtodecode =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Decode encoded URL 89 return $stringtodecode; 90} 91 92#------------------------------------------------------------------------------ 93# Function: Clean a string of HTML tags to avoid 'Cross Site Scripting attacks' 94# and clean | char. 95# Parameters: stringtoclean 96# Input: None 97# Output: None 98# Return: cleanedstring 99#------------------------------------------------------------------------------ 100sub CleanXSS { 101 my $stringtoclean = shift; 102 103 # To avoid html tags and javascript 104 $stringtoclean =~ s/</</g; 105 $stringtoclean =~ s/>/>/g; 106 $stringtoclean =~ s/|//g; 107 108 # To avoid onload=" 109 $stringtoclean =~ s/onload//g; 110 return $stringtoclean; 111} 112 113 114#------------------------------------------------------- 115# MAIN 116#------------------------------------------------------- 117 118if ($DEBUG) { 119 open(LOGFILE,">$REPLOG/$PROG.log"); 120 print LOGFILE "----- $PROG $VERSION -----\n"; 121} 122 123if (! $ENV{'GATEWAY_INTERFACE'}) { # Run from command line 124 print "----- $PROG $VERSION (c) Laurent Destailleur -----\n"; 125 print "This script is absolutely not required to use AWStats.\n"; 126 print "It's a third tool that can help webmaster in their tracking tasks but is\n"; 127 print "not used by AWStats engine.\n"; 128 print "\n"; 129 print "This tools must be used as a CGI script. When called as a CGI, it returns to\n"; 130 print "browser a redirector to tell it to show the page provided in 'url' parameter.\n"; 131 print "So, to use this script, you must replace HTML code for external links onto your\n"; 132 print "HTML pages from\n"; 133 print "<a href=\"http://externalsite/pagelinked\">Link</a>\n"; 134 print "to\n"; 135 print "<a href=\"http://mysite/cgi-bin/awredir.pl?key=ABCDEFGH&url=http://externalsite/pagelinked\">Link</a>\n"; 136 print "\n"; 137 print "For your web visitor, there is no difference. However this allow you to track\n"; 138 print "clicks done on links onto your web pages that point to external web sites,\n"; 139 print "because an entry will be seen in your own server log, to awredir.pl script\n"; 140 print "with url parameter, even if link was pointing to another external web server.\n"; 141 print "\n"; 142 sleep 2; 143 exit 0; 144} 145 146if ((! $AUTHORIZEDWITHOUTKEY) && ($KEYFORMD5 eq 'YOURKEYFORMD5')) { 147 error("Error: You must change value of constant KEYFORMD5 in awredir.pl script."); 148} 149 150# Extract tag 151$Tag='NOTAG'; 152if ($ENV{QUERY_STRING} =~ /tag=\"?([^\"&]+)\"?/) { $Tag=$1; } 153 154$Key='NOKEY'; 155if ($ENV{QUERY_STRING} =~ /key=\"?([^\"&]+)\"?/) { $Key=$1; } 156 157# Extract url to redirect to 158$Url=$ENV{QUERY_STRING}; 159if ($Url =~ /url=\"([^\"]+)\"/) { $Url=$1; } 160elsif ($Url =~ /url=(.+)$/) { $Url=$1; } 161$Url = DecodeEncodedString($Url); 162$UrlParam=$Url; 163 164# Sanitize parameters 165$Tag=CleanXSS($Tag); 166$Key=CleanXSS($Key); 167$UrlParam=CleanXSS($UrlParam); 168 169 170if (! $UrlParam) { 171 error("Error: Bad use of $PROG. To redirect an URL with $PROG, use the following syntax:<br><i>/cgi-bin/$PROG.pl?url=http://urltogo</i>"); 172} 173 174if ($Url !~ /^http/i) { $Url = "http://".$Url; } 175if ($DEBUG) { print LOGFILE "Url=$Url\n"; } 176 177if ((! $AUTHORIZEDWITHOUTKEY || $UrlParam !~ /$AUTHORIZEDWITHOUTKEY/) && $KEYFORMD5 && ($Key ne md5_hex($KEYFORMD5.$UrlParam))) { 178# error("Error: Bad value for parameter key=".$Key." to allow a redirect to ".$UrlParam." - ".$KEYFORMD5." - ".md5_hex($KEYFORMD5.$UrlParam) ); 179 error("Error: Bad value for parameter key=".$Key." to allow a redirect to ".$UrlParam.". Key must be hexadecimal md5(KEYFORMD5.".$UrlParam.") where KEYFORMD5 is value hardcoded into awredir.pl. Note: You can remove use of key by setting KEYFORMD5 to empty string in script awredir.pl"); 180} 181 182# Get date 183($nowsec,$nowmin,$nowhour,$nowday,$nowmonth,$nowyear,$nowwday,$nowyday,$nowisdst) = localtime(time); 184if ($nowyear < 100) { $nowyear+=2000; } else { $nowyear+=1900; } 185$nowsmallyear=$nowyear;$nowsmallyear =~ s/^..//; 186if (++$nowmonth < 10) { $nowmonth = "0$nowmonth"; } 187if ($nowday < 10) { $nowday = "0$nowday"; } 188if ($nowhour < 10) { $nowhour = "0$nowhour"; } 189if ($nowmin < 10) { $nowmin = "0$nowmin"; } 190if ($nowsec < 10) { $nowsec = "0$nowsec"; } 191 192if ($TRACEBASE == 1) { 193 if ($ENV{REMOTE_ADDR} !~ /$EXCLUDEIP/) { 194 if ($DEBUG == 1) { print LOGFILE "Execution requete Update sur BASE=$BASE, USER=$USER, PASS=$PASS\n"; } 195 my $dbh = DBI->connect("DBI:mysql:$BASE", $USER, $PASS) || die "Can't connect to DBI:mysql:$BASE: $dbh->errstr\n"; 196 my $sth = $dbh->prepare("UPDATE T_LINKS set HITS_LINKS = HIT_LINKS+1 where URL_LINKS = '$Url'"); 197 $sth->execute || error("Error: Unable execute query:$dbh->err, $dbh->errstr"); 198 $sth->finish; 199 $dbh->disconnect; 200 if ($DEBUG == 1) { print LOGFILE "Execution requete Update - OK\n"; } 201 } 202} 203 204if ($TRACEFILE == 1) { 205 if ($ENV{REMOTE_ADDR} !~ /$EXCLUDEIP/) { 206 open(FICHIER,">>$TXTDIR/$TXTFILE") || error("Error: Enable to open trace file $TXTDIR/$TXTFILE: $!"); 207 print FICHIER "$nowyear-$nowmonth-$nowday $nowhour:$nowmin:$nowsec\t$ENV{REMOTE_ADDR}\t$Tag\t$Url\n"; 208 close(FICHIER); 209 } 210} 211 212# Redir html instructions 213print "Location: $Url\n\n"; 214 215if ($DEBUG) { 216 print LOGFILE "Redirect to $Url\n"; 217 close(LOGFILE); 218} 219 2200; 221