Alwanza: Web Spy

#!/usr/bin/perl # spy.cgi by Meryll Larkin # Written January 10, 2004 # Last update August 13, 2006 # Sets and retrieves browser cookies from index.html on Alwanza # Parses user stats and puts user stats into database # Generates spy.cgi page as a debugging page # Displays the visitor count in the iframe on index.html # Increments the visitor count # update 8/13/06 - parses HTTP_USER_AGENT into PLATFORM # (PLATFORM added as a column to alwanza_site database, all_stat table # changed regex for "host" (for ip address) to multiline use strict; use Cwd; use DBI; use CGI qw(:standard); use SPYDB; # custom module by Meryll Larkin use SPYCOUNT; # custom module by Meryll Larkin my $C_MAX_COUNT = 4; # maximum number of count numbers to keep in a cookie my $V_DIGITS = 5; # number of digits in visitor count my $C_SZ_LIMIT; # cookie size limit = # number of visitor numbers collected plus 1 for each comma, # minus 1 because no comma at end of string $C_SZ_LIMIT = (($V_DIGITS + 1) * $C_MAX_COUNT) - 1; my $SPYDB = SPYDB->new; my $COUNTER = SPYCOUNT->new; my $debug = 0; my $backgroundColor = "black"; my $textColor="white"; my $pg = new CGI(); my $url= $pg->url(-path_info=>1); my $hed_back="black"; # header background color my $table_back="black"; # table cell background color my $Default_URL = url; my $boo_silentSurfer = 0; my ($longDate, $day_sort, $wk_day, $timeHM) = &GetSetDate; my $visitCount = $COUNTER->get_count(); my $surfer = $ENV{REMOTE_ADDR} || "192.168.1.30"; $surfer =~ s/\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\b/$1/; # Remove home and work IPs so as not to fill up database with # my own IPs if (($surfer !~ /^192\.168/) && ($surfer !~ /^216\.39\.185\.1\d$/) && ($surfer !~ /^128\.95\.73/)) # add any requested omits here { $visitCount++; $COUNTER->set_count($visitCount); } else { $boo_silentSurfer = 1; } my $displayCount = $COUNTER->get_display($visitCount); my ($cookie, $c_value, $headvisitor, $count) = &BakeCookie($visitCount, $C_SZ_LIMIT, $C_MAX_COUNT); #set new cookie print header(-cookie => $cookie); # print "Content-type: text/html\n\n"; not needed we are using print header instead print qq| Alwanza: Web Spy |; print qq| |; $displayCount =~ s/^,//; # remove leading commas from display $displayCount =~ s/,$//; # remove trailing commas from display print $displayCount; print "\n\n

\n\n"; print qq|

|; print "Visit Count = $visitCount\n"; print "

Cookie = $cookie\n"; print "

Cookie value for display = $c_value\n"; print "

headvisitor = $headvisitor\n"; print "

count = $count\n"; print "

ENV{HTTP_COOKIE} = $ENV{HTTP_COOKIE}\n"; print "

ENV{REMOTE_ADDR} = $surfer\n"; print "

ENV{HTTP_USER_AGENT} = $ENV{HTTP_USER_AGENT}\n"; print "

ENV{HTTP_REFERER} = $ENV{HTTP_REFERER}\n"; print "

ENV{HTTP_HOST} = $ENV{HTTP_HOST}\n"; print "

The email address for the webmaster of your server (or the webmaster of your ISP):\n"; print "
ENV{SERVER_ADMIN} = $ENV{SERVER_ADMIN}\n"; print "

The full qualified domain name of the server hosting your internet connection:\n"; print "
ENV{SERVER_NAME} = $ENV{SERVER_NAME}\n"; print "

The software used by the server hosting your internet connection\n"; print "
ENV{SERVER_SOFTWARE} = $ENV{SERVER_SOFTWARE}\n"; print "\n

\n"; print "\n

\n"; if (!$boo_silentSurfer) { my $origin; if (!$origin) { my $host = `host $surfer`; chomp ($host); my $hostString = $host; # To my surprise, 'host' can be a multiline answer with several # different 'pointers' (one per line) # we'll use the last one by default (that's what the s at the end does) $hostString =~ s/^.*pointer//s; $hostString = "NULL" if ($hostString eq $host); $hostString =~ s/^.*\d//; # remove everything thru the last number $hostString =~ s/^[\.*\s*]//; # remove leading dots and spaces $hostString =~ s/[\.*\s*]$//; # remove trailing dots and spaces $origin = $hostString; } my $User_Agent = $ENV{HTTP_USER_AGENT} || "Hidden"; my $platform = "Hidden"; $platform = &parse_platform($User_Agent) unless ($User_Agent eq "Hidden"); my @record = ("COUNT", $visitCount, "REMOTE_ADDR", $ENV{REMOTE_ADDR}, "REMOTE_PORT", $ENV{REMOTE_PORT}, "WK_DAY", $wk_day, "DAY", $longDate, "TIME", $timeHM, "HTTP_HOST", $ENV{HTTP_HOST}, "HTTP_USER_AGENT", $User_Agent, "HTTP_REFERER", $ENV{HTTP_REFERER}, "ORIGIN", $origin, "DAY_SORT", $day_sort, "COOKIE", $c_value, "PLATFORM", $platform ); my $field; foreach $field(@record) { $field = "NULL" if (not defined $field); } my $userStats = $SPYDB->set_visitor(@record); } print "\n\n"; print "\n"; $cookie =""; $c_value =""; exit 0; # ********************************************************************* sub GetSetDate { my @moIndex = qw| Jan Feb Mar Apr May Jun Jul Aug Sept Oct Nov Dec |; my @wkIndex = qw| Sun Mon Tues Wed Thur Fri Sat |; my ($min, $hour, $dayOmonth, $mon, $year, $wkday) = (localtime(time))[1,2, 3,4,5,6]; $year += 1900; $min = ($min < 10) ? "0" . $min : $min; $min = "00" if ($min < 1); my $min_str = $min; $min = ($hour < 12) ? $min . " AM" : $min . " PM"; my $hr_str = ($hour < 10) ? "0" . $hour : $hour; $hour = ($hour >12 ) ? $hour - 12 : $hour; my $timeHM = $hour . ":" . $min; my $wk_day = $wkIndex[$wkday]; my $mon_str = ($mon < 9) ? ("0" . ($mon + 1)) : ($mon + 1); my $day_str = ($dayOmonth < 10) ? ("0" . $dayOmonth) : $dayOmonth; my $longDate = $moIndex[$mon] . " " . $dayOmonth . " " . $year; my $day_sort = $year . $mon_str . $day_str . $hr_str . $min_str; return ($longDate, $day_sort, $wk_day, $timeHM); } # ********************************************************* sub BakeCookie { my ($count, $SZ_LIMIT, $C_MAX_COUNT) = @_; my $cookiename = 'alwanza_cookie'; # retrieve previous counts from cookie, if it exists # $c_value is what will be displayed in stats.cgi # $new_c_val is what will be set as the new cookie my $c_value = cookie($cookiename) || "NULL"; chomp $c_value; my $cookie = "NULL"; my $headvisitor = 0; my $new_c_val; $headvisitor = substr($c_value,0,$SZ_LIMIT) if ($c_value =~ /\d+/); if (($c_value =~ /\d+/) && ($headvisitor ne $count)) { # cookie already exists, and count is not yet # part of it. First clean it up in case we had bad coding # in past $c_value =~ s/,+/,/g; # turn multiple adjacent commas into one # CASE: cookie exceeds maximum size if ((length($c_value) > $SZ_LIMIT) && ($c_value =~ /\d+/)) { my @cvalue = split (",",$c_value); my @sorted_cvalue = reverse sort {$a <=> $b} @cvalue; my $i; for ($i = 0; $i < $C_MAX_COUNT; $i++) { $new_c_val .= ",$sorted_cvalue[$i]" if ($cvalue[$i] =~ /\d+/); } $new_c_val =~ s/,+$//; # remove final comma(s) $new_c_val =~ s/^,+//; # remove leading comma(s) $c_value = $new_c_val; $new_c_val = $count . "," .$c_value; } # CASE: cookie within size limit elsif ((length($c_value) <= $SZ_LIMIT) && ($c_value =~ /\d+/)) { $new_c_val = $count . "," .$c_value; } } elsif ($headvisitor eq $count) { $c_value = "NULL"; $new_c_val = $c_value; } else { # visitor has no cookie # if we get here, $c_value is already NULL $new_c_val = $count; } $new_c_val =~ s/,+$//; # remove final comma(s) $cookie = cookie(-name => $cookiename, -value => $new_c_val, -expires => "+2y"); return ($cookie, $c_value, $headvisitor, $count); } # ****************************************************************** sub parse_platform { my $p_str = shift; my $platform = $p_str; my $os = $p_str; my $browser = $p_str; if ($p_str =~ /Windows/i) { $os =~ s/$Windows\;// if ($p_str =~ /Windows.*Windows/); $os =~ /(Windows[^$\;]*)/; $os =~ /(Windows[^\^)^\^;]*)/; my $temp = $1; $os = $temp; $os = "Windows XP" if ($temp =~ /NT\s*5\.1/); $os = "Windows Vista" if ($temp =~ /NT\s*6\.\d+/); } if ($p_str =~ /MSIE/) { $browser =~ /MS(IE[^\;]*)/; my $temp = $1; $browser= $temp; } $os = "Macintosh" if ($p_str =~ /Macintosh/); $os = "Mac_PowerPC" if ($p_str=~ /Mac_PowerPC/); $os = "Linux" if ($p_str =~ /Linux/); $os = "SunOS" if ($p_str =~ /SunOS/); $browser = "Netscape" if ($p_str =~ /Gecko.*Netscape/); if (($p_str =~ /Netscape/) && ($p_str !~ /Gecko/)) { $browser = "Netscape"; } if ($browser =~ /Netscape/) { # $p_str =~ /Netscape.+(\d+.\d+).*/; $p_str =~ /Netscape(.+\d+.\d+).*/; my $temp = $1; $temp =~ s|.*\/||; $browser .= " " . $temp; } elsif (($p_str =~ /Gecko/) && ($p_str !~ /Netscape/)) { $browser = "Gecko"; } $browser = "Konqueror" if ($p_str =~ /Konqueror/); $browser = "Firefox" if ($p_str =~ /Firefox/); $browser .= " and AOL" if ($p_str =~ /AOL/); if (($os ne $p_str) && ($browser ne $p_str)) { $platform = $browser . " on " . $os; } else { $platform =~ s/\W*Mozilla\W*\d+\.\d\s*\///i; $platform =~ s/Mozilla\W*5.0//; $platform =~ s/Mozilla\W4.0//; $platform =~ s/$\s*compatible//; $platform =~ s/compatible//; $platform =~ s/\(.*$//; # remove first parenthesis clause $platform =~ s/$//g; # remove all opening parenthesis $platform =~ s/$//g; # remove all closing parenthesis $platform =~ s/\;//g; # remove all semicolons # remove urls (to keep column size small) $platform =~ s/\+http\:\/\/www.google.com\/bot.html//; $platform =~ s/http\:\/\/[\w\.\/]*//; $platform = ' ' if ($platform =~ /^\s?$/); } $platform =~ s/^\s*//; return $platform; } # ****************************************************************** sub Debug1 { print "\n

\n"; print "url = $url
\n"; print "HTTP_REFERER = $ENV{HTTP_REFERER}
\n"; print "REMOTE_ADDR = $ENV{REMOTE_ADDR}
\n"; print "REMOTE_PORT = $ENV{REMOTE_PORT}
\n"; print "HTTP_HOST = $ENV{HTTP_HOST}
\n"; print "UNIQUE_ID = $ENV{UNIQUE_ID}
\n"; print "HTTP_USER_AGENT = $ENV{HTTP_USER_AGENT}
\n"; print "SERVER_NAME = $ENV{SERVER_NAME}
\n"; print "SERVER_SOFTWARE = $ENV{SERVER_SOFTWARE}
\n"; print "

\n"; }