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/</&lt;/g;
105	$stringtoclean =~ s/>/&gt;/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