#!/usr/bin/perl # # VersaCounter (version 1.0) # # Copyright (c) 1998 Michael Chavel (chavel@aquilo.net) # You may use this program for PERSONAL AND NON-PROFIT PURPOSES ONLY! # # The most recent version of this program and documentation can # be found at http://www.aquilo.net ### # use in web page # with Server Side Includes: # [an error occurred while processing this directive] # # without Server Side Includes: # [an error occurred while processing this directive] # # (change the script name vcounter to vcounter.cgi as necessary.) # # options include: # page=PAGE_NAME The NAME can be any text string you like (no spaces). # If unspecified the pages path/name is taken from # the DOCUMENT_URI environment variable (SSI) # or the HTTP_REFERER variable (non-SSI). # style=STYLE_NAME The style of digits to be used in the counter. # "text" is the default. Other options are given by # the names of the subdirectories in the $digits_dir. # Currently: "LED", "LED_g", "LED_r", "odometer", # "odometer_sm", "curly", "rosewood"... # More GIFs can be added, just create the coresponding # directory and the "size" file containing: # x (all digits within a # style must be the same size). # show=counter displays "[counter value]" (default action) # show=all displays "[counter value] hits since [date initalized]" # show=date displays just the "[date initialized]", no counter increment # show=nothing displays nothing, but does increment the counter file # hidden=1 same effect # invisible=1 same effect # digits=N pads the counter with left zeros to be at least N digits # commas=0 remove commas from text counter # trans=r,g,b rgb color to make transparent # link=1 adds a hyperlink around the counter to $LINKURI # align=[top][middle][bottom] alignment of text after counter (bottom default) # increment=0 no counter increment (in case of multiple counters on a page) # block=N block incrementing from consecutive reloads for N seconds # header=0 when calling this script from another CGI script (passing # the page name via the URI_DOCUMENT variable and options # via the QUERY_STRING variable) set header=0, allowing # the calling script to output the HTTP header. # the next two options only need to be given (if desired) upon initial use: # start=NUM initialize counter to the starting value NUM # start_date=DATE initialize counter to the starting date DATE (any format) ### use 5.004; use CGI qw(:cgi); use Fcntl qw(:flock); use GD; ### site defaults: $site_URI = 'https://goldengears.tripod.com/home.html'; # URI of this site $wd = '/'; # full directory path to the root of site $digits_dir = 'digits/'; # dir of GIF digits (relative to $wd) $log_dir = 'logs/'; # dir for log files (relative to $wd) $image_dir = 'logs/'; # dir for counter images (relative to $wd) $error_log ="$wd$log_dir".'error.log'; $auto_init = 1; # allow automatic creation of counters for new pages %valid_servers = ('www.bigschool.edu'=> 1, # valid **remote** servers 'www.greatstuff.com'=> 1 # for counters (1=yes 0=no) ); $link = $site_URI.'/cgi-bin'; # hyperlink to place around counter $resolve = 0; # resolve IP addresses to DNS names in logs $hr_adjust = 0; # add this to local hour for starting date $text_string = 'hits since'; # text displayed between # counter and date for show=all ### user overrideable defaults: $show = 'counter'; $style = 'text'; # for SSI usage $imagestyle = 'odometer'; # for non SSI usage $pad_to = 0; $align = 'bottom'; $commas = 1; $invisible = 0; $increment = 1; $log = 1; $http_header= 1; $block_time = 60*60; # block counter from incrementing from consequtive # hits by the same host within 360 seconds (= 1 hour) ### # uncomment to log errors #open (ERROR, "> $error_log") || bail("cannot open error file:$!"); #flock(ERROR, LOCK_EX) || bail("cannot flock error file: $!"); $remote_host = $ENV{'REMOTE_HOST'}; $SSI_URI = $ENV{'DOCUMENT_URI'} if ($ENV{'DOCUMENT_URI'}); $referer = $ENV{'HTTP_REFERER'}; $referer =~ s/^$site_URI(.)/$1/o; # remove $site_URI if not a remote web page $string = param('page') || $SSI_URI || $referer; # page to be counted $string =~ s/\%7E/~/g; # fix any URL escaped '~' characters if ($string =~ /\/$/) { # chop off any trailing /'s in page identifier chop($string); }; $string =~ tr/\?\&/||/; # substitute '|' for '?' and '&' $string =~ s/^http:\/\/(.)/$1/; # remove http:// ($page, @query) = (split(/\|/, $string)); # split page name from query string $end = index($page, '/'); # (if present) $host = substr($page, 0, $end) if $end>0; $page =~ tr/\//_/; # substitute '_' for '/' $link .= '?page='.$page; $style = $imagestyle if (!$SSI_URI); $time=time(); # parse options from the query string $show = param('show') if (length(param('show'))); $style = param('style') if (param('style')); $pad_to = param('digits') if (length(param('digits'))); $commas = param('commas') if (length(param('commas'))); $transparent = param('trans') if (length(param('trans')));; $link = 0 if (!param('link')); $align = param('align') if (param('align')); $invisible = 1 if ($show =~ m/nothing/i || $show eq '0'); $invisible = 1 if (param('invisible') || param('hidden')); $increment = param('increment') if (length (param('increment'))); $increment = 0 if ($show =~ m/date/); $block_time = param('block') if (length(param('block'))); $log = param('log') if (length(param('log'))); $http_header = param('header') if (length(param('header'))) ; $init = param('start'); $init_date = param('start_date'); if ($http_header) { # output http header unless being called from a CGI script if (length($SSI_URI)) { print "Content-type: text/html\n" ; # http header for SSI mode print "Pragma: no-cache\n"; print "Expires: now\n\n"; } else { $| = 1; binmode STDOUT; print "Content-type: image/gif\n" ; # http header for image tag print "Pragma: no-cache\n"; print "Expires: now\n\n"; if ($invisible) { # output blank (transparent gif) $blank = new GD::Image(1,1); $backgrnd = $blank->colorAllocate(0,0,0); $blank->transparent($backgrnd); print $blank->gif; } else { bail('cannot display text without SSI') if (lc($style) eq 'text'); $link = 0; # not SSI mode: so no link $commas = 0; # no commas $show = 'counter'; # ignore 'date' and 'all' requests }; }; }; if (valid($host) ) { if ((-e "$wd$log_dir$page")) { &update_counter; # get date and count for page } elsif ($auto_init == 1) { &new_counter; # or make file for new counter } else { bail("counter does not exist: $! "); # or die if auto_init disabled }; } else { bail("invalid counter URL from $host"); }; if (!$invisible) { if (lc($show) eq 'date') { # if show=date just print date print "$date"; } else { # otherwise... $count_length = length($count); # pad $count if smaller than $pad_to for ($i = $pad_to;$i>$count_length;$i--) { $count = "0$count"; }; if (lc($style) ne 'text') { # build counter GIF and HTML image tag &build_gif_image; if ($SSI_URI) { open(COUNT_GIF, "> $wd$image_dir$page".'-.gif') || bail("cannot open gif file $wd$image_dir$page".'-.gif'."$!"); print COUNT_GIF "$image_gif"; close(COUNT_GIF) || bail("cannot close gif file $wd$image_dir$page".'-.gif:'."$!"); $count = 'Counter Image'; ### # One could handle the SSI operation this way, without using # the Gd.pl module. But, it seems less elegant. # # $counter=''; # $new_cnt_length = length($count); # for ($i=0; $i<$new_count_length ; $i++) { # $number = substr($count,$i,1); # $counter .= ''; # }; # $count = $counter; ### } else { $count = $image_gif; }; } elsif ($commas) { $new_cnt_length = length($count); $gsd = $new_cnt_length - $count_length; for ($j=$new_cnt_length-3; $j>$gsd; $j-=3) { $three_places = substr($count,$j,3); $left = substr($count,0,$j); if (!$comma_count) { $comma_count = ','.$three_places; } else { $comma_count = ','.$three_places.$comma_count; }; }; $count = $left.$comma_count if ($left); }; if ($link) { # add link, if specified $count = ''.$count.''; }; if (lc($show) eq 'all') { # print counter with date print "$count $text_string $date"; } else { # or just the counter print "$count"; }; }; }; &update_log if ($log && $increment); #close(ERROR); sub update_counter { # subroutine to update count file open(COUNT,"+< $wd$log_dir$page") || # open corresponding count file bail("cannot open $wd$log_dir$page: $!"); flock(COUNT, LOCK_EX) || bail ("cannot flock $wd$log_dir$page: $!"); chomp($line = ); ($count,$date,$previous_host,$previous_time, $init, $init_time) = split(/\|/,$line); $increment = 0 if ( (lc($remote_host) eq lc($previous_host)) && ($time-$previous_time < $block_time) ); if ($increment) { $count++ ; # increment counter value and save seek(COUNT, 0, 0) || bail("cannot rewind $wd$log_dir$page: $!"); print COUNT "$count\|$date\|$remote_host\|$time\|$init\|$init_time\n"; truncate(COUNT, tell(COUNT)) || bail("cannot truncate $wd$log_dir$page: $!"); }; close(COUNT) || bail("cannot close $wd$log_dir$page: $!"); } sub update_log { # subroutine to update log file if ($resolve && $remote_host =~ m/^\d+\.\d+\.\d+\.\d+$/) { $rhost = hostname($remote_host) || $remote_host; # resolve IP address to DNS name } else { $rhost = $remote_host; }; open(LOG,">> $wd$log_dir$page".'.log') || bail("cannot open $wd$log_dir$page".".log: $!"); flock(LOG, LOCK_EX) || bail ("cannot flock $wd$log_dir$page" .".log:: $!"); print LOG "$time|$rhost\|$referer\|$ENV{'HTTP_USER_AGENT'}\n"; close(LOG) || bail("cannot close $wd$log_dir$page".".log: $!"); } sub new_counter { # subroutine to initalize a new counter @months = ("January","February","March","April","May","June","July", "August","September","October","November","December"); ($mday,$mon,$year) = (localtime($time+$hr_adjust*3600))[3,4,5]; $year += 1900; #Y2K OK! $date = $init_date || "$months[$mon] $mday, $year"; $count = $init || '1'; open(COUNT,"> $wd$log_dir$page") || bail("cannot create $wd$log_dir$page: $!"); flock(COUNT, LOCK_EX) || bail ("cannot flock $wd$log_dir$page: $!"); print COUNT "$count\|$date\|$remote_host\|$time\|$init\|$time\n"; close(COUNT) || bail ("cannot close $wd$log_dir$page: $!"); } sub build_gif_image { # subroutine to build GIF image of counter # from individual digit GIFs and save $new_cnt_length = length($count); open(SIZE, "$wd$digits_dir$style/size") || bail("cannot find digit style $style: $!") ; ($digit_width, $digit_height) = split (/x/,); $image_width = $digit_width*$new_cnt_length; close(SIZE) || bail(); $image = new GD::Image($image_width,$digit_height); for ($i=0; $i<$new_cnt_length ; $i++) { $number = substr($count,$i,1); open (DIGIT, "$wd$digits_dir$style/$number".'.gif') || bail(); $digit = newFromGif GD::Image(DIGIT); $image->copy($digit, $i*$digit_width,0, 0,0, $digit_width,$digit_height); close(DIGIT) || bail(); }; if ($transparent) { ($r,$g,$b) = split(/\,/, $transparent); $trn_color = $image->colorClosest($r,$g,$b); $image->transparent($trn_color); }; $image_gif = $image->gif; } sub hostname { my (@bytes, $packedaddr, $host_name ); @bytes = split(/\./, $_[0]); $packedaddr = pack("C4",@bytes); $host_name = (gethostbyaddr($packedaddr, 2))[0]; return($host_name); } sub valid { # function to validate remote host if ($valid_servers{$_[0]} || length($_[0])==0) { return 1; } else { return 0; }; } sub bail { # function to output errors to browser my $error = "@_"; print "Error:", $error; print ERROR "$error\n"; # while (($key, $val) = each %ENV) { # for testing only # print ERROR "$key = $val\n"; # # }; # die $error; }