1 rizwank 1.1 #!/usr/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&url=http://212.43.217.240/%7Eforumgp/forum/list.php3?f=11">XXX</a>
6 #-------------------------------------------------------
7
8 #use DBD::mysql;
9
10
11 #-------------------------------------------------------
12 # Defines
13 #-------------------------------------------------------
14 use vars qw/ $REVISION $VERSION /;
15 $REVISION='$Revision: 1.5 $'; $REVISION =~ /\s(.*)\s/; $REVISION=$1;
16 $VERSION="1.1 (build $REVISION)";
17
18 use vars qw / $DIR $PROG $Extension $DEBUG $DEBUGFILE $REPLOG $DEBUGRESET $SITE $REPCONF /;
19 ($DIR=$0) =~ s/([^\/\\]*)$//; ($PROG=$1) =~ s/\.([^\.]*)$//; $Extension=$1;
20 $DEBUG=0; # Debug level
21 $DEBUGFILE="$PROG.log"; # Debug output (A log file name or "screen" to have debug on screen)
22 rizwank 1.1 $REPLOG="$DIR"; # Debug directory
23
24 $TRACEBASE=0; # Set to 1 to track click on links that point to extern site into a database
25 $TRACEFILE=0; # Set to 1 to track click on links that point to extern site into a file
26 $TXTDIR="$DIR/../../../logs"; # Directory where to write tracking file (if TRACEFILE=1)
27 $TXTFILE="awredir.trc"; # Tracking file (if TRACEFILE=1)
28 $EXCLUDEIP="127.0.0.1";
29
30
31 #-------------------------------------------------------
32 # Functions
33 #-------------------------------------------------------
34
35 sub error {
36 print "Content-type: text/html; charset=iso-8859-1\n";
37 print "\n";
38 print "<html>\n";
39 print "<head>\n";
40 print "</head>\n";
41 print "\n";
42 print "<body>\n";
43 rizwank 1.1 print "<center><br>\n";
44 print "<font size=2><b>AWRedir</b></font><br>\n\n";
45 print "<font color=#880000>$_[0].</font><br><br>\n";
46 print "Setup (setup or logfile permissions) may be wrong.\n";
47 $date=localtime();
48 print "<CENTER><br><font size=1>$date - <b>Advanced Web Redirector $VERSION</b><br>\n";
49 print "<br>\n";
50 print "</body>";
51 print "</html>";
52 die;
53 }
54
55 #-------------------------------------------------------
56 # MAIN
57 #-------------------------------------------------------
58
59 if ($DEBUG) {
60 open(LOGFILE,">$REPLOG/$PROG.log");
61 print LOGFILE "----- $PROG $VERSION -----\n";
62 }
63
64 rizwank 1.1 if (! $ENV{'GATEWAY_INTERFACE'}) { # Run from command line
65 print "----- $PROG $VERSION (c) Laurent Destailleur -----\n";
66 print "This script is absolutely not required to use AWStats.\n";
67 print "It's a third tool that can help webmaster in their tracking tasks but is\n";
68 print "not used by AWStats engine.\n";
69 print "\n";
70 print "This tools must be used as a CGI script. When called as a CGI, it returns to\n";
71 print "browser a redirector to tell it to show the page provided in 'url' parameter.\n";
72 print "So, to use this script, you must replace HTML code for external links onto your\n";
73 print "HTML pages from\n";
74 print "<a href=\"http://externalsite/pagelinked\">Link</a>\n";
75 print "to\n";
76 print "<a href=\"http://mysite/cgi-bin/awredir.pl?url=http://externalsite/pagelinked\">Link</a>\n";
77 print "\n";
78 print "For your web visitor, there is no difference. However this allow you to track\n";
79 print "clicks done on links onto your web pages that point to external web sites,\n";
80 print "because an entry will be seen in your own server log, to awredir.pl script\n";
81 print "with url parameter, even if link was pointing to another external web server.\n";
82 print "\n";
83 sleep 2;
84 exit 0;
85 rizwank 1.1 }
86
87 # Extract tag
88 $Tag='NOTAG';
89 if ($ENV{QUERY_STRING} =~ /tag=\"?([^\"&]+)\"?/) { $Tag=$1; }
90
91 # Extract url to redirect to
92 $Url=$ENV{QUERY_STRING};
93 if ($Url =~ /url=\"([^\"]+)\"/) { $Url=$1; }
94 elsif ($Url =~ /url=(.+)$/) { $Url=$1; }
95
96 if ($Url !~ /^http/i) { $Url = "http://".$Url; }
97 if (! $Url) {
98 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>");
99 }
100 if ($DEBUG) { print LOGFILE "Url=$Url\n"; }
101
102 # Get date
103 ($nowsec,$nowmin,$nowhour,$nowday,$nowmonth,$nowyear,$nowwday,$nowyday,$nowisdst) = localtime(time);
104 if ($nowyear < 100) { $nowyear+=2000; } else { $nowyear+=1900; }
105 $nowsmallyear=$nowyear;$nowsmallyear =~ s/^..//;
106 rizwank 1.1 if (++$nowmonth < 10) { $nowmonth = "0$nowmonth"; }
107 if ($nowday < 10) { $nowday = "0$nowday"; }
108 if ($nowhour < 10) { $nowhour = "0$nowhour"; }
109 if ($nowmin < 10) { $nowmin = "0$nowmin"; }
110 if ($nowsec < 10) { $nowsec = "0$nowsec"; }
111
112 if ($TRACEBASE == 1) {
113 if ($ENV{REMOTE_ADDR} !~ /$EXCLUDEIP/) {
114 if ($DEBUG == 1) { print LOGFILE "Execution requete Update sur BASE=$BASE, USER=$USER, PASS=$PASS\n"; }
115 my $dbh = DBI->connect("DBI:mysql:$BASE", $USER, $PASS) || die "Can't connect to DBI:mysql:$BASE: $dbh->errstr\n";
116 my $sth = $dbh->prepare("UPDATE T_LINKS set HITS_LINKS = HIT_LINKS+1 where URL_LINKS = '$Url'");
117 $sth->execute || error("Error: Unable execute query:$dbh->err, $dbh->errstr");
118 $sth->finish;
119 $dbh->disconnect;
120 if ($DEBUG == 1) { print LOGFILE "Execution requete Update - OK\n"; }
121 }
122 }
123
124 if ($TRACEFILE == 1) {
125 if ($ENV{REMOTE_ADDR} !~ /$EXCLUDEIP/) {
126 open(FICHIER,">>$TXTDIR/$TXTFILE") || error("Error: Enable to open trace file $TXTDIR/$TXTFILE: $!");
127 rizwank 1.1 print FICHIER "$nowyear-$nowmonth-$nowday $nowhour:$nowmin:$nowsec\t$ENV{REMOTE_ADDR}\t$Tag\t$Url\n";
128 close(FICHIER);
129 }
130 }
131
132 # Redir html instructions
133 print "Location: $Url\n\n";
134
135 if ($DEBUG) {
136 print LOGFILE "Redirect to $Url\n";
137 close(LOGFILE);
138 }
139
140 0;
|
Return to
awredir.pl
CVS log
Up to [RizwankCVS] / geekymedia_web / awstats-6.3 / wwwroot / cgi-bin