#!/usr/bin/perl -w 
#------------------------------------------------------------------------------
# $Id$
#------------------------------------------------------------------------------
# BOX file CGI
#
# Copyright (c) BAYBITS LLC. All rights reserved.
#------------------------------------------------------------------------------

use strict;
use CGI;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use utf8;
use XML::DOM;
use TF::XMLUtils;
use TF::CommonUtils;
use HTML::Template;

binmode(STDOUT, ":utf8");

# global
my $LOCATION      = $ENV{'TF_LOCATION'};
my $TF_VERSION    = $ENV{'TF_VERSION'};
my $USERID        = $ENV{'REMOTE_USER'};
my $PASSWD        = $ENV{'TF_USERPLAINPASSWORD'};
my $BRAND         = $ENV{'TF_BRANDNAME'} || '';
my $LANGPARAM     = TF::CommonUtils::getLangPriority();
my $ACCEPTLANG_H  = $ENV{'HTTP_ACCEPT_LANGUAGE'} || '';
my $TEMPLATE_FILE = './tmpl/box.tmpl.' . $LANGPARAM;
my $BOXLIMIT      = $ENV{'TF_BOXPOLICYLIMIT'} || 0;
my $BOXDISABLEFMT = $ENV{'TF_BOXDISABLE_FORMAT'} || "";
my $BOXWITHOUTMAIL= $ENV{'TF_BOXWITHOUTMAIL'} || "off";
my $SUPPORTED2FA  = ($ENV{'TF_TWO_FACTOR_AUTHENTICATION'} eq 'on') ? 1 : 0;
my $RESULTSTATE   = "";
my %form;
my ($SCHEMA,$SERVER_PORT,$URI_PREFIX) = TF::CommonUtils::getCgiConnectInfo();

my $ERRORTABLE_ja = {
					CGIError => "CGIエラーです",
					templateError => "テンプレートオブジェクトが生成できません",
                    readTemplateError => "テンプレートファイルの読み込みに失敗しました",
					serverBusy => "サーバがビジーです。しばらく経ってからやり直してください",
					writeError => "設定の書き込みに失敗しました",
					notfound => "対象のメッセージはありません",
					};

my $ERRORTABLE_en = {
					CGIError => "CGI error found.",
					templateError => "Can not create template object.",
					readTemplateError => "Failed to read template file.",
					serverBusy => "The server is busy. Please retry this operation after a while.",
					writeError => "Failed to write setting.",
					notfound => "message not found.",
					};

my $ERRORTABLE    = ($LANGPARAM eq 'ja') ? $ERRORTABLE_ja : $ERRORTABLE_en;

if (!$LOCATION) {
	TF::CommonUtils::showAccessDeny();
	die '';
}

main();

#
# main 
#
sub main {

	my $cgi = new CGI;

	if( ! $cgi ) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{CGIError}, $LANGPARAM);
		print STDERR "CGI Object error";
		return;
	}

	if( $cgi->cgi_error ) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{CGIError} . '(' . $cgi->cgi_error . ')', $LANGPARAM);
		print STDERR "CGI Error (" . $cgi->cgi->error . ")";
		return;
	}

	my $cmd = $cgi->param('hidCmd');
	my $parentURI = $cgi->param('hidParentFolderUri');
	my $currentURI= $cgi->param('hidCurrentFolderUri');
	my $accesscode = $cgi->param('accesscode');
	my $allowedorigin = $cgi->param('allowedorigin');
	my $detail = $cgi->param('detail');
	my $expiration = $cgi->param('hidExpirationdate');
	my $greeting = $cgi->param('greeting');
	my $sealingwax = $cgi->param('sealingwax');
	my $privacy = $cgi->param('privacy');
	my $tomailaddr = $cgi->param('tomailaddr');

	# 登録
	if ($cmd && $cmd eq "update") {
		&updatebox($currentURI, $sealingwax, $privacy, $greeting, $detail, $accesscode, $expiration, $allowedorigin, $tomailaddr, $cgi->remote_addr());
	}

	# 削除
	if ($cmd && $cmd eq "delete") {
		&deletebox($currentURI);
		TF::CommonUtils::redirectPage($parentURI, $LANGPARAM);
		return;
	}

	&printHTML($parentURI, $currentURI);
}

#
# sub
#
sub printHTML
{
	my $PARENT_URI = shift|| '';
	my $folder = shift || '';
	my %boxinfo = ();

	if (!$folder) {
		TF::CommonUtils::showAccessDeny();
		return;
	}
	my ($CURRENT_URI, $seq) = split(/\?seq=/, $folder);

	%boxinfo  = &getBOX($CURRENT_URI);

	if (open(TEMPLATE, "<$TEMPLATE_FILE")) {
		binmode(TEMPLATE, ":utf8");
		my $htmltmpl = HTML::Template->new(	filehandle => *TEMPLATE,
											case_sensitive => 1,
											die_on_bad_params => 0);
		if ($htmltmpl) {
			$htmltmpl->param(	brandname => $BRAND,
								tfversion => $TF_VERSION,
								lang      => $LANGPARAM,
								currenturi => $CURRENT_URI,
								parenturi  => $PARENT_URI,
								boxlimit   => $BOXLIMIT,
								disablefmt => $BOXDISABLEFMT,
								withoutmail=> $BOXWITHOUTMAIL,
								supportd2fa=> $SUPPORTED2FA,
								sealingwax=> $boxinfo{'sealingwax'},
								privacy   => $boxinfo{'privacy'},
								greeting  => $boxinfo{'greeting'},
								message   => $boxinfo{'message'},
								parentname=> $boxinfo{'name'},
								accesscode=> $boxinfo{'accesscode'},
								linkurl   => $boxinfo{'linkurl'},
								allowedorigin => $boxinfo{'allowedorigin'},
								publicationdate => $boxinfo{'publicationdate'},
								expiration      => $boxinfo{'expiration'},
								tomailaddr      => $boxinfo{'tomailaddr'},
								resultstate     => $RESULTSTATE
							);
			print "Content-type: text/html; charset=UTF-8\n\n";
			print $htmltmpl->output;
		}
		close(TEMPLATE);
	}
	else {
		TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
	}
}

sub getBOX {
	my $CURRENT_URI = shift || '';

	my $ua  = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0});
	my $req = HTTP::Request->new;
	my %boxinfo = ();
	my $URI = $URI_PREFIX . $CURRENT_URI || '';

	if (!$URI || !$CURRENT_URI) {
		return %boxinfo;
	}

	#---------------
	# PROPFIND
	#---------------
	$req->uri($URI);
	$req->method("PROPFIND");
	$req->protocol("HTTP/1.1");
	$req->header("Accept-Language", $ACCEPTLANG_H);
	$req->authorization_basic($USERID, $PASSWD);
	$req->header('Depth' => '0');
	my $content = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?><D:propfind xmlns:D=\"DAV:\" xmlns:TF=\"http://www.teamfile.com/DTD/TF/\"><D:prop><D:displayname/><D:resourcetype/><TF:resourcestate/></D:prop></D:propfind>";

	$req->content($content);
	$ua->agent(TF::CommonUtils::getCgiUserAgent());
	my $res = $ua->request($req);
	if ($res->is_success && $res->code == 207) {
		my $policyheader = $res->header('X-Tf-BoxPolicy');
		my $data = $res->content();
		if ($data) {
			my $xml = new XML::DOM::Parser;
			my $doc = $xml->parse($data);

			$boxinfo{'name'} = TF::XMLUtils::getText($doc, "lp1:displayname");
			my $box = $doc->getElementsByTagName("lp3:box")->item(0);
			if ($box) {
				my $sealingwax = $box->getElementsByTagName("lp3:sealingwax");
				my $privacy  = $box->getElementsByTagName("lp3:privacy");
				my $greeting = TF::XMLUtils::getText($box, "lp3:greeting");
				my $message  = TF::XMLUtils::getText($box, "lp3:message");
				my $publicationdate = TF::XMLUtils::getText($box, "lp3:publicationdate");
				my $expiration  = TF::XMLUtils::getText($box, "lp3:expiration");
				my $password = TF::XMLUtils::getText($box, "lp3:password");
				my $linkurl  = TF::XMLUtils::getText($box, "lp3:linkurl");
				my $allowedorigin = TF::XMLUtils::getText($box, "lp3:allowedorigin");
				my $pubdate  = TF::XMLUtils::getText($box, "lp3:publicationdate");
				my $tomailaddr = TF::XMLUtils::getText($box, "lp3:tomailaddr");
				# 既存データ対応
				if ($tomailaddr eq '(null)') { $tomailaddr = '' }

				if ($linkurl) {
					#
					# CGIは必ずlocalhostへのアクセスになります。
					# linkのURLはサーバ側でリクエストに応じて変更しますが、
					# リバースプロキシ対策ではスキーマとポート番号だけが
					# 置換されサーバ名は対象外になっています（当然ですが）
					# サーバ名は本スクリプト内で変更し対応します
					# 
					$linkurl =~ s/127\.0\.0\.1/$ENV{'SERVER_NAME'}/;
				}
				
				$boxinfo{'sealingwax'}      = $sealingwax->getLength(); 
				$boxinfo{'privacy'}			= $privacy->getLength();
				$boxinfo{'greeting'}        = $greeting;
				$boxinfo{'message'}         = $message;
				$boxinfo{'publicationdate'} = $publicationdate;
				$boxinfo{'accesscode'}      = $password;
				$boxinfo{'linkurl'}         = $linkurl;
				$boxinfo{'allowedorigin'}	= $allowedorigin;
				$boxinfo{'publicationdate'} = $pubdate;
				$boxinfo{'expiration'}      = $expiration;
				$boxinfo{'policyheader'}	= $policyheader;
				$boxinfo{'tomailaddr'}      = $tomailaddr;
			}


			$doc->dispose;
		}
	}

	return %boxinfo;
}

#
# update box proerty
#
sub updatebox {
	my $CURRENT_URI = shift || '';
	my $sealingwax = shift || '';
	my $privacy = shift || '';
	my $greeting = shift || '';
	my $detail = shift || '';
	my $accesscode = shift || '';
	my $expiration = shift || '';
	my $allowedorigin = shift || '';
	my $tomailaddr = shift || '';
	my $remoteaddr = shift || '';

	my $URI = $URI_PREFIX . $CURRENT_URI || '';

	my $ua  = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0});
	my $req = HTTP::Request->new;
	my $ret = undef;

	my $tag_sealingwax = ($sealingwax eq 'on') ? '<TF:sealingwax/>' : '';
	my $tag_privacy    = ($privacy eq 'on') ? '<TF:privacy/>' : '';

	if (!$URI || !$CURRENT_URI) {
		return $ret;
	}

	#---------------
	# PROPPATCH
	#---------------
	$req->uri($URI);
	$req->method("PROPPATCH");
	$req->protocol("HTTP/1.1");
	$req->header("Accept-Language", $ACCEPTLANG_H);
	$req->header("X-Tf-RemoteAddr", $remoteaddr);
	$req->authorization_basic($USERID, $PASSWD);
	my $content = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?><D:propertyupdate xmlns:D=\"DAV:\" xmlns:TF=\"http://www.teamfile.com/DTD/TF/\"><D:set><D:prop><TF:resourcestate><TF:box>$tag_sealingwax$tag_privacy<TF:greeting><![CDATA[$greeting]]></TF:greeting><TF:message><![CDATA[$detail]]></TF:message><TF:password><![CDATA[$accesscode]]></TF:password><TF:allowedorigin>$allowedorigin</TF:allowedorigin><TF:expiration>$expiration</TF:expiration><TF:tomailaddr><![CDATA[$tomailaddr]]></TF:tomailaddr></TF:box></TF:resourcestate></D:prop></D:set></D:propertyupdate>";

	$req->content($content);
	$ua->agent(TF::CommonUtils::getCgiUserAgent());
	my $res = $ua->request($req);
	my $status = "";
	if ($res->is_success && $res->code == 207) {
		$RESULTSTATE = $res->header("TF-RESULTSTATE");
		my $data = $res->content();
		if ($data) {
			my $xml = new XML::DOM::Parser;
			my $doc = $xml->parse($data);

			my $line = TF::XMLUtils::getText($doc, "D:status");
			my ($p, $c, $m) = split(/ /, $line);
			$ret = $c if ($c);
		}
	}
	return $ret;
}


#
# remove box property
#
sub deletebox {

	my $CURRENT_URI = shift || '';
	my $URI = $URI_PREFIX . $CURRENT_URI || '';

	my $ua  = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0});
	my $req = HTTP::Request->new;
	my $ret = undef;

	if (!$URI || !$CURRENT_URI) {
		return $ret;
	}

	#---------------
	# PROPPATCH
	#---------------
	$req->uri($URI);
	$req->method("PROPPATCH");
	$req->protocol("HTTP/1.1");
	$req->header("Accept-Language", $ACCEPTLANG_H);
	$req->authorization_basic($USERID, $PASSWD);
	my $content = "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\" ?><D:propertyupdate xmlns:D=\"DAV:\" xmlns:TF=\"http://www.teamfile.com/DTD/TF/\"><D:remove><D:prop><TF:resourcestate><TF:box/></TF:resourcestate></D:prop></D:remove></D:propertyupdate>";

	$req->content($content);
	$ua->agent(TF::CommonUtils::getCgiUserAgent());
	my $res = $ua->request($req);
	my $status = "";
	if ($res->is_success && $res->code == 207) {
		my $data = $res->content();
		if ($data) {
			my $xml = new XML::DOM::Parser;
			my $doc = $xml->parse($data);

			my $line = TF::XMLUtils::getText($doc, "D:status");
			my ($p, $c, $m) = split(/ /, $line);
			$status = $c if ($c);
		}
	}
	return $ret;
}
