package Vulture::OutputFilterHandler;
use base qw(Apache2::Filter);
use Apache2::Const qw(OK DECLINED FORBIDDEN :conn_keepalive);
use Apache2::Connection ();
use Apache2::RequestRec;
use Apache2::RequestUtil;
use APR::Table;
use APR::URI;
use constant BUFF_LEN => 8000;
use Apache2::ServerRec;
use Apache2::URI;
use Vulture qw(&get_app $proto &read_conf &get_cookie &session);

%Vulture::OutputFilterHandler::linkElements = (
	'a'       => ['href'],
	'applet'  => ['archive', 'codebase', 'code'],
	'area'    => ['href'],
	'bgsound' => ['src'],
	'blockquote' => ['cite'],
	'body'    => ['background'],
	'del'     => ['cite'],
	'embed'   => ['pluginspage', 'src'],
	'form'    => ['action'],
	'frame'   => ['src', 'longdesc'],
	'iframe'  => ['src', 'longdesc'],
	'ilayer'  => ['background'],
	'img'     => ['src', 'lowsrc', 'longdesc', 'usemap'],
	'input'   => ['src', 'usemap'],
	'ins'     => ['cite'],
	'isindex' => ['action'],
	'head'    => ['profile'],
	'layer'   => ['background', 'src'],
	'link'    => ['href'],
	'object'  => ['classid', 'codebase', 'data', 'archive', 'usemap'],
	'q'       => ['cite'],
	'script'  => ['src', 'for'],
	'table'   => ['background'],
	'td'      => ['background'],
	'th'      => ['background'],
	'tr'      => ['background'],
	'xmp'     => ['href'],
);
sub handler {
	my $f = shift;
	my $r = $f->r;
	my $log = $r->server->log;
	my $dbh = DBI->connect($r->dir_config('VultureDSN'));
	my $app = get_app($log, $r->hostname, $dbh, $r->dir_config('VultureID')); 
	$log->debug($app->{'rewrite'});
	unless ($f->ctx) {
	if (my $proxy_rules = $app->{'rewrite'}) {
		$proxy_rules =~ s/\r//g;
		$log->debug($proxy_rules);
		$log->debug($r->content_type);
		foreach (split ("\n",$proxy_rules)) {
			$_ =~ /(.*) \[([A-Z0-9]+)\]/;
			my ($cond) = $2;
			$log->debug($2);
			if ($cond eq "H") {
				my ($header, $value) = split (/ =>/, $1);
				$r->headers_out->unset($header);
				$r->headers_out->set($header => $value);
			}
			if ($cond eq "MH") {
				my ($mime, $header, $value) = split (/ => /, $1);
				if ($r->content_type =~ m/$mime/i ) {
					$r->headers_out->unset($header);
					$r->headers_out->set($header => $value);
				}
			}
			if ($cond eq "F") {
				if ($r->content_type =~ m/$1/i) {
					return Apache2::Const::FORBIDDEN;
				}
			}
			if ($cond eq "UH") {
				$r->headers_out->unset($1);
			}
			if ($cond eq "L") {
#-------------------------------------------------------------------------------------------#
#							Code from ModProxyPerlHtml										#
#-------------------------------------------------------------------------------------------#
# Project  : Reverse Proxy HTML link rewriter												#
# Name     : ModProxyPerlHtml.pm															#
# Language : perl 5.8 built for i686-linux													#
# OS       : linux Slackware 10 kernel 2.4.26												#
# Authors  : Gilles Darold, gilles@darold.net												#
# Copyright: Copyright (c) 2005 : Gilles Darold - All rights reserved -						#
# Description : This mod_perl2 module is a replacement for mod_proxy_html.c					#
#		with much better URL HTML rewriting.												#
# Usage    : See documentation in this file with perldoc.									#
#-------------------------------------------------------------------------------------------#
# This program is free software; you can redistribute it and/or modify it under				#
# the same terms as Perl itself.															#
#-------------------------------------------------------------------------------------------#
				my $content_type = $f->r->content_type() || '';
				
					$f->r->headers_out->unset('Content-Length');
					my @pattern = $1;
					$log->debug($1);
					my $ct = $f->ctx;
					$ct->{data} = '';
					foreach my $p (@pattern) {
						push(@{$ct->{pattern}}, $p);
					}
					$f->ctx($ct);
			}
		}
	}
	}
	my $ctx = $f->ctx;
	while ($f->read(my $buffer, BUFF_LEN)) {
		$ctx->{data} .= $buffer;
		$ctx->{keepalives} = $f->c->keepalives;
		$f->ctx($ctx);
	}
	# Thing we do at end
	if ($f->seen_eos) { 
		# Skip content that should not have links
		my $parsed_uri = $f->r->construct_url();
		my $encoding = $f->r->headers_in->{'Accept-Encoding'} || '';
	       	# if Accept-Encoding: gzip,deflate try to uncompress
		if ($encoding =~ /gzip|deflate/) {
			use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ;
			my $output = '';
			anyinflate  \$ctx->{data} => \$output or die "anyinflate failed: $AnyInflateError\n";
			if ($ctx->{data} ne $output) {
				$ctx->{data} = $output;
			} else {
				$encoding = '';
			}
		}
		if ($r->content_type =~ /(text\/html|text\/css|application\/x-javascript)/) {
			# Replace links if pattern match
			foreach my $p (@{$ctx->{pattern}}) {
				my ($match, $substitute) = split (/ => /, $p);
				$log->debug($match);
				$log->debug($substitute);
				&link_replacement(\$ctx->{data}, $match, $substitute, $parsed_uri);

			}
		}

		if ($encoding =~ /gzip/) {
			use IO::Compress::Gzip qw(gzip $GzipError) ;
			my $output = '';
			my $status = gzip \$ctx->{data} => \$output or die "gzip failed: $GzipError\n";
			$ctx->{data} = $output;
		} elsif ($encoding =~ /deflate/) {
			use IO::Compress::Deflate qw(deflate $DeflateError) ;
			my $output = '';
			my $status = deflate \$ctx->{data} => \$output or die "deflate failed: $DeflateError\n";
			$ctx->{data} = $output;
		}
		$f->ctx($ctx);

		# Dump datas out
		$f->print($f->ctx->{data});
		my $c = $f->c;
		if ($c->keepalive == Apache2::Const::CONN_KEEPALIVE && $ctx->{data} && $c->keepalives > $ctx->{keepalives}) {
			if ($debug) {
				warn "[ModProxyPerlHtml] cleaning context for keep alive request\n";
			}
			$ctx->{data} = '';
			$ctx->{pattern} = ();
			$ctx->{keepalives} = $c->keepalives;
		}
			
	}

	return Apache2::Const::OK;
}

sub link_replacement
{
	my ($data, $pattern, $replacement, $uri) = @_;

	return if (!$$data);

	my $old_terminator = $/;
	$/ = '';
	my @TODOS = ();
	my $i = 0;
	# Replace standard link into attributes of any element
	foreach my $tag (keys %Vulture::OutputFilterHandler::linkElements) {
		next if ($$data !~ /<$tag/i);
		foreach my $attr (@{$Vulture::OutputFilterHandler::linkElements{$tag}}) {
			while ($$data =~ s/(<$tag[\t\s]+[^>]*\b$attr=['"]*)($replacement|$pattern)([^'"\s>]+)/NEEDREPLACE_$i$$/i) {
				push(@TODOS, "$1$replacement$3");
				$i++;
			}
		
		}
	}
	# Replace all links in javascript code
	$$data =~ s/([^\\]['"])($replacement|$pattern)([^'"]*['"])/$1$replacement$3/ig;

	# Try to set a fully qualified URI	
	$uri =~ s/$replacement.*//;
        # Replace meta refresh URLs
	$$data =~ s/(<meta\b[^>]+content=['"]*.*url=)($replacement|$pattern)([^>]+)/$1$uri$replacement$3/i;
	# Replace base URI
	$$data =~ s/(<base\b[^>]+href=['"]*)($replacement|$pattern)([^>]+)/$1$uri$replacement$3/i;

	# The single ended tag broke mod_proxy parsing
	$$data =~ s/($replacement|$pattern)>/\/>/ig;
	
	# Replace todos now
	for ($i = 0; $i <= $#TODOS; $i++) {

		$$data =~ s/NEEDREPLACE_$i$$/$TODOS[$i]/i;
	}

	$/ = $old_terminator;

}
#																							#
#-------------------------------------------------------------------------------------------#
1;