#!/usr/bin/perl

use CGI::Carp qw(fatalsToBrowser);
use Digest::MD5 qw(md5_hex);

use strict;

my $gLogDb = "pagelog.db";
my $gNoLogDb = "nolog.db";

my %FORM;
ParseFormData(\%FORM);

my $time = time();
my $target = TextToHtml($FORM{'target'});
my $referrer = TextToHtml($FORM{'referrer'});
my $language = TextToHtml($FORM{'language'});
my $winsize = TextToHtml($FORM{'winsize'});
my $userAgent = TextToHtml($FORM{'userAgent'});
my $ipHash = $ENV{'REMOTE_ADDR'}; $ipHash = md5_hex($ipHash) if ($ipHash ne '');
my $errorCode = TextToHtml($FORM{'errorCode'});

my $log = 1;

if (open(NOLOG_DB, "$gNoLogDb"))
{
	my @Lines = <NOLOG_DB>;
	close(NOLOG_DB);

	for my $Line (@Lines)
	{
		chomp $Line;
		my ($nolog_language, $nolog_winsize, $nolog_userAgent, $nolog_referrer) = split(/\|/, $Line);

		if
		(
			('*' eq $nolog_language  || '' eq $nolog_language  eq $language  || index($language,  $nolog_language)  != -1)
		&&	('*' eq $nolog_winsize   || '' eq $nolog_winsize   eq $winsize   || index($winsize,   $nolog_winsize)   != -1)
		&&	('*' eq $nolog_userAgent || '' eq $nolog_userAgent eq $userAgent || index($userAgent, $nolog_userAgent) != -1)
		&&	('*' eq $nolog_referrer  || '' eq $nolog_referrer  eq $referrer  || index($referrer,  $nolog_referrer)  != -1)
		)
		{
			$log = 0;
			last;
		}
	}
}

if ($log)
{
	open(PAGELOG_DB, ">>$gLogDb");
	flock PAGELOG_DB, 2;
	print PAGELOG_DB "$time|$target|$referrer|$language|$winsize|$userAgent|$ipHash|$errorCode\n";
	close(PAGELOG_DB);
}

print <<EOM;
Content-type: text/html; charset=utf-8

<!DOCTYPE html>
<html>
	<head>
		<meta charset="UTF-8" />
		<meta http-equiv="content-type" content="text/html; charset=UTF-8">
		<meta name="viewport" content="width=device-width, initial-scale=1.0">
		<title>Hello!</title>
	</head>
	<body>
		<h1>Hello!</h1>
		<p>Thank you for visiting my website! You called this script because you'd like to know for what it is. So here are the details:</p>
		<p>This script is called automatically each time a page is requested from this server. It collects some common data your browser provides:</p>
		<ul>
			<li><b>window.location:</b> the requested page on this server (e.g.: https://example.com/page)</li>
			<li><b>document.referrer:</b> the address of the page that linked to the requested page (e.g.: https://www.google.com/)</li>
			<li><b>navigator.language:</b> the browser's preferred language setting (e.g.: de-DE)</li>
			<li><b>window.innerWidth:</b> width of the browser window in pixels (e.g.: 1280)</li>
			<li><b>window.innerHeight:</b> height of the browser window in pixels (e.g.: 768)</li>
			<li><b>navigator.userAgent:</b> name of browser and OS (e.g.: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36)</li>
			<li><b>ipHash:</b> MD5 checksum of the remote address (e.g.: 252e96c981636b0d115372802e5a0183), used to enumerate visitors (e.g. 1, 2, 3, ...)</li>
		</ul>
		<p>This data is stored together with a time stamp in a log file on this server. It helps me to improve this website and will not be shared with any other third party.</p>
	</body>
</html>
EOM

exit 0;

##############
# Funktionen #
##############

#
# Überträgt die mittels "POST" an das Formular übergebenen Daten
# in den Hash, dessen Referenz der Funktion übergeben wird. Der
# Zugriff auf die Daten erfolgt dann mit $Hashname{'Feldname'}.
#
sub ParseFormData
{
	my $FormHashRef = shift;

	my $formdata;

	read(STDIN, $formdata, $ENV{'CONTENT_LENGTH'});

	my @pairs = split(/&/, $formdata);

	for my $pair (@pairs)
	{
		my ($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/meg;
		${$FormHashRef}{$name} = $value;
	}
}

#
# Hilfsfunktion zum Maskieren aller HTML-(&, ", <, >) und DB-(Satztrenner, Feldtrenner)
# eigenen Zeichen, damit diese nicht vom Browser bzw. vom Script "interpretiert" werden,
# sondern als diese Zeichen dargestellt werden. Mit dieser Funktion sollten alle
# Textstrings, die in die DB geschrieben werden, zuvor in HTML konvertiert werden.
# Später nach dem Laden aus der DB können die Strings dann unmittelbar auf einer
# HTML-Seite angezeigt werden, ohne daß sie zuvor erneut konvertiert werden müssen.
#
sub TextToHtml
{
	my $text = shift;

	$text =~ s/\&/&amp;/g;
	$text =~ s/\"/&quot;/g;
	$text =~ s/\</&lt;/g;
	$text =~ s/\>/&gt;/g;

	$text =~ s/\r\n/<br>/g;
	$text =~ s/\r/<br>/g;
	$text =~ s/\n/<br>/g;

	$text =~ s/\|/&#124;/g;		# Feldtrenner für DB-Dateien

	$text;
}

