#!/usr/bin/perl -w

# we don't use common gateway interface
# use CGI qw(:standard);

# we use database interface
package IPTracker;

use strict;
use warnings;

use Apache2::Connection;
use Apache2::Request;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK);

use DBI;
use Encode;
use CGI qw/:html :form/;
use Socket qw(:DEFAULT :crlf);
use utf8;
use Time::Local;
use Digest::MD5 qw(md5 md5_hex md5_base64);
# use IO::File;


sub handler {
        my $r = shift;

        my $c = $r->connection();
        my $remote = $c->remote_ip();

	if ($remote =~ /^::[0-9]*\./) {
		my @rem = split(/:/, $remote);
		$remote = $rem[2];
	}
        my $req = Apache2::Request->new( $r );

        my $hin = $r->headers_in();
        my $hout = $r->headers_out();

	# connect to db
        my $dbh = DBI->connect(
		$r->dir_config('db'),
		$r->dir_config('user'),
		$r->dir_config('pass'),
                { RaiseError => 1, AutoCommit => 1 });

	#$dbh->do('SET time_zone=GMT');
	$dbh->do("SET NAMES 'utf8'");
	my $sth;



	my $output = '';
	$output .= '# Registered IP Addresses'.$CRLF;
	$output .= '# Script written by Michael John Wensley Copyright 2002 - 2006'.$CRLF;
	$output .= '# comments to email: iptracker at wensley spot org fullstop uk'.$CRLF;
	$output .= '# ___ ___ ' . $CRLF;
	if ($req->param('remove')) {
		$output .= '# \\\'/ \\\'/ '.$CRLF;
	} else { 
		$output .= '# \\^/ \\^/ '.$CRLF;
	}
	if ($req->param('desc')) {
		$output .= '#    >     '.$CRLF;
	} else {
		$output .= '#    <     '.$CRLF;
	}
	if ($req->param('remove')) {
		$output .= '#    _    '.$CRLF;

	} else {
		$output .= '#  \\___/  '.$CRLF;
	}

	# grab the db password and bite off trailing newline
	#local *FILE;
	#open(FILE, "< /home/michael/secure/dbpasswd.txt") or die "Can\'t open file";
	#my $password = <FILE>;
	#chomp $password;
	#close FILE;

	if ($req->param('name')) {
	    $output .= '# '.$CRLF;
	    $output .= '# Text '.$req->param('name').' associated with IP address '.
		$remote.' '.$CRLF;
    
	    # checkensure numbers, colons dots, and letters ONLY.
	    # put new entry into database
	    # can't forge ipaddress, can forge name. Letters only.

	    $sth =  $dbh->prepare('REPLACE INTO ip VALUES (?, ?, NOW())');
	    $sth->execute( $remote, $req->param('name'));
	}

	if ($req->param('remove')) {
		$output .= '# '.$CRLF;
		$output .= '# Removed IP addresses that match '.$remote.' '.$CRLF;
		$sth =  $dbh->prepare('DELETE FROM ip WHERE ip=?');
		$sth->execute( $remote );
	}

	$output .= $CRLF;
	my $query = "SELECT ip, name, date FROM ip ORDER BY date";
	if ($req->param('desc')) {
		$query = $query . ' DESC';
	}
	if ($req->param('limit') && ($req->param('limit') =~ /^\d{1,3}$/)) {
		$query = $query . ' LIMIT '. $req->param('limit');
	}
	$sth = $dbh->prepare($query);
	$sth->execute( );
	my @row;
	my $newest = 0;
	while ( @row = $sth->fetchrow_array ) {
	    # for my $element (@row) {
	    # 	$output .= $element, '\t';
	    # }
	    (my $year,my $mon,my $mday, my $hour, my $min, my $sec) = split(/[ :-]/,$row[2]);
	    my $linetime = timelocal($sec,$min,$hour,$mday,$mon - 1,$year);
	    $newest = $linetime if ($linetime > $newest);
	    $output .= $row[0] . "\t" . $row[1] . "\t" . '# ' . $row[2] . $CRLF;
	}
	
	(my $sec,my $min,my $hour,my $mday,my $mon,my $year,my $wday,my $yday) = gmtime($newest);
	my @days = qw( Sun Mon Tue Wed Thu Fri Sat );
	my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
	my %mhash = qw( Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5 Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11 );

	my $lgm = 0;
#	if (http('If-Modified-Since')) {
	if ($hin->get('If-Modified-Since')) {
		(undef, my $lmday, my $lmon, my $lyear, my $lhour, my $lmin, my $lsec, my $ltz) = split(/[ :]/,$hin->get('If-Modified-Since'));
		if (defined($ltz) && ($ltz eq 'GMT') && defined $mhash{$lmon}) {
			# catch errors
			eval { $lgm = timegm($lsec, $lmin, $lhour, $lmday, $mhash{$lmon}, $lyear); };
		}
	}
	if ($lgm > $newest) {
		#print 'Status: 304 Not Modified'.$CRLF;
		$r->status(304);
	} else {
		# we use unicode but http requires length in bytes.
		$hout->set('Last-Modified', sprintf('%s, %02d %s %04d %02d:%02d:%02d', $days[$wday], $mday, $months[$mon], $year + 1900, $hour, $min, $sec)." GMT");
		$hout->set('Content-MD5' => md5_base64(Encode::encode_utf8($output)).'==');
		$hout->set('Content-Length', do { use bytes; length($output) });
		$r->content_type('text/plain; charset=UTF-8');
		$r->print($output);
	}

	$dbh->disconnect;
	return Apache2::Const::OK;
}

1;