#!/usr/bin/perl
#####################################################################
# ipcounter version 3.34
# Copyright 2000-2002 Marc Rasell
# Created February 2000 last modified 6 Mar 2003
# http://www.rasell.plus.com/ipcounter
#####################################################################
# COPYRIGHT NOTICE
# Copyright 2000-2002 Marc Rasell All Rights Reserved.
#
# ipcounter may be used and modified free of charge by anyone so
# long as this copyright notice and the comments above remain
# intact.
#
# By using this code you agree to indemnify Marc Rasell
# from any liability that might arise from its use.
#
# Selling the code for this program without prior written consent is
# expressly forbidden.
#
# Obtain permission before redistributing this software over the
# Internet or in any other medium. In all cases copyright and header
# must remain intact.
#####################################################################
# Instructions
#
# counts unique IP per day
# the same script can be used for all pages
#
# counter link ->
# (visible counting using SSI)
# OR (invisible counting without SSI)
#
# login link ->
# http://yourdomain.com/cgi-bin/ipcounter.pl?login
#
#####################################################################
# Define variables
# referers - set to your web site domain(s)
@referers = ("pinkemostar.com");
# administrators password
$password = "elliot13";
# log path - the path to the logs folder (create a sub directory in your cgi-bin and chmod 777)
$log_path = "/usr/pkg/libexec/cgi-bin/jess_ipcounter";
# log date determines how often new log files are created
# options = "month" or "year" or "once"
$log_date = "year";
# script name (no need to alter unless you change the name of the script)
$script_name = "ipcounter.pl";
# log name (no need to alter unless you want to change the name of the log files)
$log_name = "ipcounter";
# log host (option to log the remote host of visitors)
# options = "on" or "off"
$log_host = "on";
# There is no need to edit below this line
#####################################################################
# Other variables
# maximum amount of data that can be sent to the program
$max_data = 1024;
# ip and host of visitor
$ip = $ENV{'REMOTE_ADDR'};
$host = $ENV{'REMOTE_HOST'};
# use Fcntl symbolic names
use Fcntl qw(:DEFAULT :flock);
#
#####################################################################
# print http header
&print_header;
# get date
&get_date;
# create log files
&create_log_names;
# check referring url
&check_url;
# parse form
&parse_form;
# main subroutine
&main;
# exit program
exit;
#####################################################################
sub error
{
local ($error);
$error = $_[0];
print <<"HTML";
Error!
Error!
An error has occured: $error
HTML
exit;
}
sub parse_form
{
local(@pairs,$buffer,$pair,$name,$value);
# stop overload of data from form
if ($ENV{'CONTENT_LENGTH'} > $max_data)
{
error_log('data overload', 'die');
}
if (uc($ENV{'REQUEST_METHOD'}) eq 'GET')
{
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif (uc($ENV{'REQUEST_METHOD'}) eq 'POST')
{
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else
{
error_log('request_method', 'die');
}
foreach $pair (@pairs)
{
($name, $value)=split(/=/, $pair);
$name=~ tr/+/ /;
$name=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex ($1))/eg;
$value=~ tr/+/ /;
$value=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex ($1))/eg;
# remove metacharacters
$name = remove_meta($name);
$value = remove_meta($value);
$contents{$name}=$value;
}
}
sub lockfile
{
my $count = 0;
my $handle = shift;
until (flock($handle, LOCK_NB | LOCK_EX))
{
select (undef, undef, undef, 0.1);
if (++$count>50)
{
error_log('server busy, try again later', 'die');
}
}
}
sub error_log
{
open (LOG, ">>$error_log") or
error "can't open $error_log: $! \n$_[0]";
lockfile(LOG);
seek LOG, 0, 2 or die "can't seek to end of $error_log: $!";
print LOG $_[0] . "|DATE:$date|TIME:$time|IP:$ip|HOST:$host\n" or die "can't write to $error_log: $!";
close(LOG) or die "can't close $error_log: $!";
if ($_[1] ne 'warn')
{
if ($_[1] eq 'hide') {&error('an internal error has occured');}
else {&error($_[0]);}
}
}
sub get_date
{
local(@days,@months,$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$month);
@days = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
if ($mday < 10) {$mday = "0$mday";}
if ($mon < 10) {$mon = "0$mon";}
$month = ++$mon;
$date = "$mday/$month/$year";
$current_month = "$year/$month";
$current_log_month = "$year$month";
$current_log_year = $year;
if ($hour < 10) {$hour = "0$hour";}
if ($min < 10) {$min = "0$min";}
if ($sec < 10) {$sec = "0$sec";}
$time = "$hour\:$min\:$sec";
}
sub remove_meta
{
$_[0] =~ tr/&;`'\"|*?~<>^()[]{}$\n\r/_/;
return $_[0];
}
sub login
{
print <<"HTML";
IP Counter
HTML
}
sub count
{
local($unique_visitor,$line,@history,$count);
sysopen (HISTORY, "$log_file", O_CREAT | O_RDWR) or error_log("can't open $log_file: $!", "hide");
lockfile(HISTORY);
seek HISTORY, 0, 0 or die "can't seek to start of $log_file: $!";
$unique_visitor = 1;
$count = 0;
while ()
{
$count++;
$line = $_;
chomp $line;
@history = split (/\|/, $line);
if ($history[0] eq $date && $history[1] eq $ip)
{
$unique_visitor = 0;
}
}
if ($unique_visitor)
{
$count++;
if ($log_host eq "on")
{
print HISTORY "$date|$ip|$host\n" or error_log("can't write to $log_file: $!", "hide");
}
elsif ($log_host eq "off")
{
print HISTORY "$date|$ip\n" or error_log("can't write to $log_file: $!", "hide");
}
else
{
error_log('invalid log host option', 'die');
}
}
close (HISTORY) or error_log("can't close $log_file: $!", "hide");
print "$count";
}
sub admin
{
local($count,$line,@history,%dates,@split_date,$month,%months,$year,%years,$key);
&check_password;
sysopen (HISTORY, "$log_file", O_CREAT | O_RDONLY) or error_log("can't open $log_file: $!", "hide");
lockfile(HISTORY);
seek HISTORY, 0, 0 or die "can't seek to start of $log_file: $!";
$count = 0;
while ()
{
$line = $_;
chomp $line;
@history = split (/\|/, $line);
$history_date = $history[0];
@split_date = split (/\//, $history_date);
$month = $split_date[2] . "/" . $split_date[1];
$year = $split_date[2];
$count++;
if ($month eq $current_month) {$dates{$history_date}++;}
$months{$month}++;
$years{$year}++;
}
close (HISTORY) or error_log("can't close $log_file: $!", "hide");
print <<"HTML1";