package WebGUI;

#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2006 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com			info@plainblack.com
#-------------------------------------------------------------------

use strict qw(vars subs);
use Tie::CPHash;
use Time::HiRes;
use WebGUI::Affiliate;
use WebGUI::Asset;
use WebGUI::Cache;
use WebGUI::Config;
use WebGUI::HTMLForm;
use WebGUI::International;
use WebGUI::Operation;
use WebGUI::Session;
use WebGUI::User;
use WebGUI::Utility;
use WebGUI::PassiveProfiling;
use Apache2::Upload;
use Apache2::Request;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND DIR_MAGIC_TYPE);
use Apache2::ServerUtil ();
use LWP::MediaTypes qw(guess_media_type);

our $VERSION = "7.2.0";
our $STATUS = "beta";

#-------------------------------------------------------------------

=head2 handler ( requestObject )

Primary http init/response handler for WebGUI.  This method decides whether to hand off the request to contentHandler() or uploadsHandler()

=head3 requestObject

The Apache2::RequestRec object passed in by Apache's mod_perl.

=cut

sub handler {
	my $r = shift;
	my $configFile = shift || $r->dir_config('WebguiConfig');
	my $s = Apache2::ServerUtil->server;
	my $config = WebGUI::Config->new($s->dir_config('WebguiRoot'), $configFile);
	$r->push_handlers(PerlFixupHandler => \&fixupHandler) if (defined $config->get("passthruUrls"));
	foreach my $url ($config->get("extrasURL"), @{$config->get("passthruUrls")}) {
		return Apache2::Const::DECLINED if ($r->uri =~ m/^$url/);
	}
	my $uploads = $config->get("uploadsURL");
	if ($r->uri =~ m!^$uploads/dictionaries!) {
		# Do not allow web-access to personal dictionaries.
		$r->push_handlers(PerlAccessHandler => sub { return 401 } );
	} elsif($r->uri =~ m/^$uploads/) {
		$r->push_handlers(PerlAccessHandler => sub { return uploadsHandler($r, $configFile); } );
	} else {
		$r->push_handlers(PerlResponseHandler => sub { return contentHandler($r, $configFile); } );
		$r->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK });
	}
	return Apache2::Const::DECLINED;
}


#-------------------------------------------------------------------	

=head2 contentHandler ( requestObject )

Creates the WebGUI session, handles exceptional request 
headers, handles special states, prints the response headers,
and (usually) prints the output of page().

=head3 requestObject

The Apache2::RequestRec object passed in by Apache's mod_perl.

=cut

sub contentHandler {
	### inherit Apache request.
	my $r = shift;
	my $configFile = shift || $r->dir_config('WebguiConfig');
	### nstantiate the API for this httpd instance.
	my $s = Apache2::ServerUtil->server;
	### Open new or existing user session based on user-agent's cookie.
	my $request = Apache2::Request->new($r);
	my $session = WebGUI::Session->open($s->dir_config('WebguiRoot'),$configFile, $request, $s);
	my ($env, $http, $setting, $output, $errorHandler, $config) = $session->quick(qw(env http setting output errorHandler config));
	if ($session->env->get("HTTP_X_MOZ") eq "prefetch") { # browser prefetch is a bad thing
		$http->setStatus("403","We don't allow prefetch, because it increases bandwidth, hurts stats, and can break web sites.");
		$http->sendHeader;
	} elsif ($setting->get("specialState") eq "upgrading") {
		upgrading($session);
	} else {
		my $out = processOperations($session);
		if ($out ne "") {
			# do nothing because we have operation output to display
			$out = undef if ($out eq "chunked");
		} elsif ($setting->get("specialState") eq "init") {
			$out = setup($session);
		} elsif ($errorHandler->canShowPerformanceIndicators) {
			my $t = [Time::HiRes::gettimeofday()];
			$out = page($session);
			$t = Time::HiRes::tv_interval($t) ;
			if ($out =~ /<\/title>/) {
				$out =~ s/<\/title>/ : ${t} seconds<\/title>/i;
			} else {
				# Kludge.
				my $mimeType = $http->getMimeType();
				if ($mimeType eq 'text/css') {
					$output->print("\n/* Page generated in $t seconds. */\n");
				} elsif ($mimeType eq 'text/html') {
					$output->print("\nPage generated in $t seconds.\n");
				} else {
					# Don't apply to content when we don't know how
					# to modify it semi-safely.
				}
			}
		} else {
			$out = page($session);
		}
		my $filename = $http->getStreamedFile();
		if ((defined $filename) && ($config->get("enableStreamingUploads") eq "1")) {
			my $ct = guess_media_type($filename);
            		my $oldContentType = $r->content_type($ct);
            		if ($r->sendfile($filename) ) {
    				return Apache2::Const::OK();
			} else {
                		$r->content_type($oldContentType);
			}
		}
		$http->sendHeader();
		unless ($http->isRedirect()) {
			$output->print($out);
			if ($errorHandler->canShowDebug()) {
				$output->print($errorHandler->showDebug(),1);
			}
		}
		WebGUI::Affiliate::grabReferral($session);	# process affiliate tracking request
	}
	$session->close;
	return Apache2::Const::OK;
}

#-------------------------------------------------------------------

=head2 fixupHandler ( requestObject )

This method is here to allow proper handling of DirectoryIndexes
when someone is using the passthruUrls feature.

=head3 requestObject

The Apache2::RequestRec object passed in by Apache's mod_perl.

=cut

sub fixupHandler {
	my $r = shift;
	
	if ($r->handler eq 'perl-script' &&  # Handler is Perl
	    -d $r->filename              &&  # Filename requested is a directory
	    $r->is_initial_req)		     # and this is the initial request
	{
	    $r->handler(Apache2::Const::DIR_MAGIC_TYPE);  # Hand off to mod_dir
	    return Apache2::Const::OK;
	}
	return Apache2::Const::DECLINED;  # just pass it on
}

#-------------------------------------------------------------------

=head2 page ( session , [ assetUrl ] )

Processes operations (if any), then tries the requested method on the asset corresponding to the requested URL.  If that asset fails to be created, it tries the default page.

=head3 session

The current WebGUI::Session object.

=head3 assetUrl

Optionally pass in a URL to be loaded.

=cut

sub page {
	my $session = shift;
	my $assetUrl = shift || $session->url->getRequestedUrl;
	my $asset = eval{WebGUI::Asset->newByUrl($session,$assetUrl,$session->form->process("revision"))};
	if ($@) {
		$session->errorHandler->warn("Couldn't instantiate asset for url: ".$assetUrl." Root cause: ".$@);
	}
	my $output = undef;
	if (defined $asset) {
		my $method = "view";
		if ($session->form->param("func")) {
			$method = $session->form->param("func");
			unless ($method =~ /^[A-Za-z0-9]+$/) {
				$session->errorHandler->security("to call a non-existent method $method on $assetUrl");
				$method = "view";
			}
		}
		$output = tryAssetMethod($session,$asset,$method);
		$output = tryAssetMethod($session,$asset,"view") unless ($output || ($method eq "view"));
	}
	if ($output eq "") {
		if ($session->var->isAdminOn) { # they're expecting it to be there, so let's help them add it
			my $asset = WebGUI::Asset->newByUrl($session, $session->url->getRefererUrl) || WebGUI::Asset->getDefault($session);
			$output = $asset->addMissing($assetUrl);
		} else { # not in admin mode, so can't create it,  so display not found
			$session->http->setStatus("404","Page Not Found");
			my $notFound = WebGUI::Asset->getNotFound($session);
			if (defined $notFound) {
				$output = tryAssetMethod($session,$notFound,'view');
			} else {
				$session->errorHandler->error("The notFound page could not be instanciated!");
				$output = "An error was encountered while processing your request.";
			}
			$output = "An error was encountered while processing your request." if $output eq '';
		}
	}
	if ($output eq "chunked") {
		$output = undef;
	}
	return $output;
}


#-------------------------------------------------------------------

=head2 processOperations ( session )

Calls the operation dispatcher using the requested operation. 

=head3 session

The current WebGUI::Session object.

=cut

sub processOperations {
	my $session = shift;
	my $output = "";
	my $op = $session->form->process("op");
	if ($op) {
		$output = WebGUI::Operation::execute($session,$op);
	}
	return $output;
}


#-------------------------------------------------------------------

=head2 setup ( session )

Handles a specialState: "setup"

=head3 session

The current WebGUI::Session object.

=cut

sub setup {
	my $session = shift;
	my $i18n = WebGUI::International->new($session, "WebGUI");
	my $output = '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
	<head>
		<title>WebGUI Initial Configuration</title>
		<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
		<style type="text/css">
		a { color: black; }
		a:visited { color: black;}
		</style>
	</head>
	<body><div style="font-family: georgia, helvetica, arial, sans-serif; color: white; z-index: 10; width: 550px; height: 400px; top: 20%; left: 20%; position: absolute;"><h1>WebGUI Initial Configuration</h1><fieldset>';
	if ($session->form->process("step") eq "2") {
		$output .= '<legend align="left">Company Information</legend>';
		my $u = WebGUI::User->new($session,"3");
		$u->username($session->form->process("username","text","Admin"));
		$u->profileField("email",$session->form->email("email"));
		$u->identifier(Digest::MD5::md5_base64($session->form->process("identifier","password","123qwe")));
		my $f = WebGUI::HTMLForm->new($session,action=>$session->url->gateway());
		$f->hidden(
			-name=>"step",
			-value=>"3"
			);
		$f->text(
			-name=>"companyName",
			-value=>$session->setting->get("companyName"),
			-label=>$i18n->get(125),
			-hoverHelp=>$i18n->get('125 description'),
			);
		$f->email(
			-name=>"companyEmail",
			-value=>$session->setting->get("companyEmail"),
			-label=>$i18n->get(126),
			-hoverHelp=>$i18n->get('126 description'),
			);
		$f->url(
			-name=>"companyURL",
			-value=>$session->setting->get("companyURL"),
			-label=>$i18n->get(127),
			-hoverHelp=>$i18n->get('127 description'),
			);
		$f->submit;
		$output .= $f->print;
	} elsif ($session->form->process("step") eq "3") {
		$session->setting->remove('specialState');
		$session->setting->set('companyName',$session->form->text("companyName"));
		$session->setting->set('companyURL',$session->form->url("companyURL"));
		$session->setting->set('companyEmail',$session->form->email("companyEmail"));
		$session->http->setRedirect($session->url->gateway());
		return undef;
	} else {
		$output .= '<legend align="left">Admin Account</legend>';
		my $u = WebGUI::User->new($session,'3');
		my $f = WebGUI::HTMLForm->new($session,action=>$session->url->gateway());
		$f->hidden(
			-name=>"step",
			-value=>"2"
			);
		$f->text(
			-name=>"username",
			-value=>$u->username,
			-label=>$i18n->get(50),
			-hoverHelp=>$i18n->get('50 setup description'),
			);
		$f->text(
			-name=>"identifier",
			-value=>"123qwe",
			-label=>$i18n->get(51),
			-hoverHelp=>$i18n->get('51 description'),
			-subtext=>'<div style=\"font-size: 10px;\">('.$i18n->get("password clear text").')</div>'
			);
		$f->email(
			-name=>"email",
			-value=>$u->profileField("email"),
			-label=>$i18n->get(56),
			-hoverHelp=>$i18n->get('56 description'),
			);
		$f->submit;
		$output .= $f->print; 
	}
	$output .= '</fieldset></div>
		<img src="'.$session->url->extras('background.jpg').'" style="border-style:none;position: absolute; top: 0; left: 0; width: 100%; height: 100%; z-index: 5;" />
	</body>
</html>';
	$session->http->setCacheControl("none");
	$session->http->setMimeType("text/html");
	return $output;
}


#-------------------------------------------------------------------

=head2 tryAssetMethod ( session )

Tries an asset method on the requested asset.  Tries the "view" method if that method fails.

=head3 session

The current WebGUI::Session object.

=cut

sub tryAssetMethod {
	my $session = shift;
	my $asset = shift;
	my $method = shift;
	my $state = $asset->get("state");
	return undef if ($state ne "published" && $state ne "archived" && !$session->var->isAdminOn); # can't interact with an asset if it's not published
	$session->asset($asset);
	my $methodToTry = "www_".$method;
	my $output = eval{$asset->$methodToTry()};
	if ($@) {
		$session->errorHandler->warn("Couldn't call method ".$method." on asset for url: ".$session->url->getRequestedUrl." Root cause: ".$@);
		if ($method ne "view") {
			$output = tryAssetMethod($session,$asset,'view');
		} else {
			# fatals return chunked
			$output = 'chunked';
		}
	}
	return $output;
}

#-------------------------------------------------------------------

=head2 uploadsHandler ( requestObject )

Primary http init/response handler for WebGUI.  

=head3 requestObject

The Apache2::RequestRec object passed in by handler().

=cut

sub uploadsHandler {
	my $r = shift;
	my $configFile = shift || $r->dir_config('WebguiConfig');
	my $ok = Apache2::Const::OK;
	my $notfound = Apache2::Const::NOT_FOUND;
	if (-e $r->filename) {
		my $path = $r->filename;
		$path =~ s/^(\/.*\/).*$/$1/;
		if (-e $path.".wgaccess") {
			my $fileContents;
			open(my $FILE,"<",$path.".wgaccess");
			while (<$FILE>) {
				$fileContents .= $_;
			}
			close($FILE);
			my @privs = split("\n",$fileContents);
			unless ($privs[1] eq "7" || $privs[1] eq "1") {
				my $s = Apache2::ServerUtil->server;
				my $request = Apache2::Request->new($r);
				my $session = WebGUI::Session->open($s->dir_config('WebguiRoot'),$configFile, $request, $s);
				my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2]));
				$session->close();
				if ($hasPrivs) {
					return $ok;
				} else {
					return 401;
				}
			}
		}
		return $ok;
	} else {
		return $notfound;
	}
}


#-------------------------------------------------------------------

=head2 upgrading ( session )

Handles a specialState: "upgrading"

=head3 session

The current WebGUI::Session object.

=cut

sub upgrading {
	my $session = shift;
	$session->http->sendHeader;
	open(my $FILE,"<",$session->config->getWebguiRoot."/docs/maintenance.html");
	while (<$FILE>) {
		$session->output->print($_);
	}
	close($FILE);
}

1;