#!/usr/bin/perl
#####################################################################
# ipcounter version 3.23
# Copyright 2000-2001 Marc Rasell ipcounter@rasell.com
# Created February 2000 last modified 11 Nov 2001
# http://www.rasell.com/ipcounter
#####################################################################
# COPYRIGHT NOTICE
# Copyright 2000-2001 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/HOST's 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
#
# you might need to create the log files ipcounter.log and ipcounter.err manually and
# set the file permissions to allow read/write access for everyone
#
#####################################################################
# Define variables
# stop the program being run from other web sites
@referers = ("outofthesoil.com","madeinhisimage.net","poemsgalore.com","underhisshadow.com","godswheel.com","gloryofhismajesty.com");
# administrators password to restrict access
$password = "password";
# log path (optional) if none supplied defaults to the same directory as the script
$log_path = "";
# script name (no need to alter unless you change the name of the script)
$script_name = "ipcounter.pl";
# There is no need to edit below this line
#####################################################################
# Other variables
# path to the student number and password list
$log_file = "$log_path/$script_name.log";
# error log
$error_log = "$log_path/$script_name.err";
if (!$log_path)
{
$program_name = $0;
$log_file = "$program_name.log";
$error_log = "$program_name.err";
}
# 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;
# 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, 2))
{
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";
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 && $history[2] eq $host)
{
$unique_visitor = 0;
}
}
if ($unique_visitor)
{
$count++;
print HISTORY "$date|$ip|$host\n" or error_log("can't write to $log_file: $!", "hide");
}
close (HISTORY) or error_log("can't close $log_file: $!", "hide");
print "$count people have visited since June 2002!";
}
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";