Das Prinzip des Seins

    #!/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|<html>
    <head><title>Alwanza: Web Spy</title></head>
    |;

    print qq|
    <!-- embedded stylesheet -->
    <style type="text/css">
    <!--

    .hed {
         font-family:      verdana,lucida,geneva,arial;
         font-size:        10pt;
         font-weight:      bold;
         color:            $textColor;
         background-color: $hed_back;
    }

    .txt {
         font-family:       verdana,lucida,geneva,arial;
         font-size:         10pt;
         color:             $textColor;
         background-color:  $table_back;
    }

    .reg {
         font-family:       verdana,lucida,geneva,arial;
         font-size:         9pt;
         color:             $textColor;
         background-color:  $table_back;
    }
    -->
    </style>

    <meta name="robots" content="noindex">
    <meta name="MSSmartTagsPreventParsing" content="true">

    </head>
    <body bgcolor="$backgroundColor" text="$textColor">
    |;

    $displayCount =~ s/^,//;  # remove leading commas from display
    $displayCount =~ s/,$//;  # remove trailing commas from display
    print $displayCount;

    print "\n\n<br /><br /><br /><br />\n\n";
    print qq|<table><tr><td class="hed">
    |;
    print "Visit Count  = $visitCount\n";
    print "<br /><br />Cookie = $cookie\n";
    print "<br /><br />Cookie value for display = $c_value\n";
    print "<br /><br />headvisitor = $headvisitor\n";
    print "<br /><br />count = $count\n";
    print "<br /><br />ENV{HTTP_COOKIE} = $ENV{HTTP_COOKIE}\n";
    print "<br /><br />ENV{REMOTE_ADDR} = $surfer\n";
    print "<br /><br />ENV{HTTP_USER_AGENT} = $ENV{HTTP_USER_AGENT}\n";
    print "<br /><br />ENV{HTTP_REFERER} = $ENV{HTTP_REFERER}\n";
    print "<br /><br />ENV{HTTP_HOST} = $ENV{HTTP_HOST}\n";
    print "<br /><br />The email address for the webmaster of your server (or the webmaster of your ISP):\n";
    print "<br />ENV{SERVER_ADMIN} = $ENV{SERVER_ADMIN}\n";
    print "<br /><br />The full qualified domain name of the server hosting your internet connection:\n";
    print "<br />ENV{SERVER_NAME} = $ENV{SERVER_NAME}\n";
    print "<br /><br />The software used by the server hosting your internet connection\n";
    print "<br />ENV{SERVER_SOFTWARE} = $ENV{SERVER_SOFTWARE}\n";

    print "\n<br /><br /><br /><br />\n";
    print "\n</td></tr></table>\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</body>\n</html>";
    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 = '&nbsp;' if ($platform =~ /^\s?$/);
       }
       $platform =~ s/^\s*//;
       return $platform;
    }

    # ******************************************************************   
    sub Debug1 {
       print "\n<br /><br />\n";
       print "url = $url<br />\n";
       print "HTTP_REFERER = $ENV{HTTP_REFERER}<br />\n";
       print "REMOTE_ADDR = $ENV{REMOTE_ADDR}<br />\n";
       print "REMOTE_PORT = $ENV{REMOTE_PORT}<br />\n";
       print "HTTP_HOST = $ENV{HTTP_HOST}<br />\n";
       print "UNIQUE_ID = $ENV{UNIQUE_ID}<br />\n";
       print "HTTP_USER_AGENT = $ENV{HTTP_USER_AGENT}<br />\n";
       print "SERVER_NAME = $ENV{SERVER_NAME}<br />\n";
       print "SERVER_SOFTWARE = $ENV{SERVER_SOFTWARE}<br />\n";
       print "<br /><br />\n";
    }