#!/usr/bin/perl
use CGI::Carp "fatalsToBrowser";
# Falls Internal Error 500 vor der zweiten Zeile das "#" Zeichen wegmachen!

BEGIN {
	eval { $died_in_eval = 1; require GD; };
	if ($@) {
		$gd = 0;
	}else{
		$gd = 1;
		import GD;
	}
}

# Setup
$flock = "1"; # Bei Windows Server auf 0 setzen ansonsten auf 1.
$kick = "120"; # In Sekunden angeben wielange ein eintrag in der Liste bleibt. z.b. 900 Sekunden = 15 Minuten
$proxy = "0"; # Falls Proxy User mitgezählt werden sollen auf 0 ansonsten auf 1 !
$color1 = "000000"; # Farbwert 1 - Hex (HTML)
$color2 = "FFFFFF"; # Farbwert 2 - Hex (HTML)

# Liste für $kick:
# 60 Sekunden	 = 1 Minute
# 120 Sekunden	 = 2 Minute
# 300 Sekunden	 = 5 Minute
# 600 Sekunden	 = 10 Minute
# 900 Sekunden	 = 15 Minute
# 3600 Sekunden  = 1 Stunde
# 43200 Sekunden = 12 Stunden
# 86400 Sekunden = 1 Tag / 24 Stunden

# End

$color1 = &deztohex("$color1");
$color2 = &deztohex("$color2");

read(STDIN, $input, $ENV{'CONTENT_LENGTH'});@pairs = split(/&/, $input);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;$FORM{$name} = $value;}@vars = split(/&/, $ENV{QUERY_STRING});foreach $var (@vars) {($v,$i) = split(/=/, $var);$v =~ tr/+/ /;$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;$i =~ tr/+/ /;$i =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;$i =~ s/<!--(.|\n)*-->//g;$INFO{$v} = $i;}$action = $INFO{'action'};

if($action =~ /index/){&$action;}
if($action =~ /admin/){&$action;}
&index;

sub index {
	open(F,"<data/1.dat");
	flock(F,2) if($flock);
	@dat = <F>;
	flock(F,8) if($flock);
	close(F);

	$time = time;

	if($ENV{'REMOTE_ADDR'}){
		$ip = $ENV{'REMOTE_ADDR'};
	}else{
		$ip = $ENV{HTTP_X_FORWARDED_FOR};
	}

	if($proxy == 1 && $ENV{HTTP_VIA} ne ""){
		if ( $ENV{HTTP_VIA} ){
			if( $ENV{HTTP_X_FORWARDED_FOR} ){
				$prox = 0;
			}else{
				$prox = 1;
			}
		}
	}

	if($prox != 1){
		open(F,">data/1.dat");
		flock(F,2) if($flock);
		foreach my $i (@dat){
			$i =~ s/[\n\r]//g;
			($ipx , $zeit2) = split(/\|/ , $i);
			$zeit = $zeit2 + $kick;
			if($ipx ne $ip && $zeit > $time){print F "$ipx\|$zeit2\n";}
		}
		print F "$ip\|$time\n";
		flock(F,8) if($flock);
		close(F);
	}

	open(F,"<data/1.dat");
	flock(F,2) if($flock);
	@dat = <F>;
	flock(F,8) if($flock);
	close(F);

	$online = @dat;

	if($INFO{'e'} eq "ssi"){
		print "Content-Type: text/html\n\n";
		print "$online";
	}elsif($INFO{'e'} eq "js"){
		print "Content-Type: text/html\n\n";
		print "document.write('$online');";
	}elsif($INFO{'e'} eq "grafik" && $gd == 1){
		$lang = length($online)*8+4;
		$img = new GD::Image($lang,18);
		($color1a,$color1b,$color1c) = split(/\,/ , $color1);
		($color2a,$color2b,$color2c) = split(/\,/ , $color2);
		$white = $img->colorAllocate($color1a,$color1b,$color1c);
		$black = $img->colorAllocate($color2a,$color2b,$color2c);
		$img->filledRectangle(0,0,$lang,18,$black);
		$img->string(gdLargeFont,2,1,$online,$white);
		binmode STDOUT;
		print "Content-type: image/jpeg\n\n";
		print $img->jpeg;
	}elsif($INFO{'e'} eq "grafik2" && $gd == 1){
		$online = "";
		$lang = length($online)*8+4;
		$img = new GD::Image($lang,18);
		($color1a,$color1b,$color1c) = split(/\,/ , $color1);
		($color2a,$color2b,$color2c) = split(/\,/ , $color2);
		$white = $img->colorAllocate($color1a,$color1b,$color1c);
		$black = $img->colorAllocate($color2a,$color2b,$color2c);
		$img->filledRectangle(0,0,$lang,18,$black);
		$img->string(gdLargeFont,2,1,$online,$white);
		binmode STDOUT;
		print "Content-type: image/jpeg\n\n";
		print $img->jpeg;
	}else{
		print "Content-Type: text/html\n\n";
	}
	exit(0);
}

sub deztohex {
	local($x) = @_[0];
	($dez1,$dez2,$dez3) = split(/\./,$x);

	$one2 = uc(sprintf("%lx","$dez1"));
	if(length($one2) eq 1){$one2 = "$one2$one2";}
	$two2 = uc(sprintf("%lx","$dez2"));
	if(length($two2) eq 1){$two2 = "$two2$two2";}
	$three2 = uc(sprintf("%lx","$dez3"));
	if(length($three2) eq 1){$three2 = "$three2$three2";}

	return ("$one2$two2$three2");
}

sub hextodez {
	local($e) = @_[0];
	($hex1,$hex2,$hex3) = unpack('a2a2a2',$e);

	$one = hex("$hex1");
	$two = hex("$hex2");
	$three = hex("$hex3");

	return ("$one\,$two\,$three");
}