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

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

binmode(STDOUT, ":utf8");

use constant TF_SUCCESS				=> 1;
use constant TF_ERROR				=> 0;
use constant TF_FAIL				=> -1;

# global
my $LOCATION      = $ENV{'TF_LOCATION'} || '';
my $USERID        = $ENV{'REMOTE_USER'};
my $PASSWD        = $ENV{'TF_USERPLAINPASSWORD'};
my $BRAND         = $ENV{'TF_BRANDNAME'} || '';
my $sname         = $ENV{'SCRIPT_NAME'};
my $ACTION        = $LOCATION . $sname || '#';
my $LANGPARAM     = TF::CommonUtils::getLangPriority();
my $TEMPLATE_FILE = './tmpl/chpass.tmpl.' . $LANGPARAM;
my $PAGETITLE     = $ENV{''};
my @policy_ja     =
			( ['password-too-short',	 'パスワードは %d 文字以上必要です'],
			  ['userid-character-found', 'ユーザIDが含まれてはいけません'],
			  ['cycle-character-found',  '文字が連続しています'],
			  ['upper-alphabet-notfound','大文字のアルファベットを含めてください'],
			  ['lower-alphabet-notfound','小文字のアルファベットを含めてください'],
			  ['numeric-character-notfound','数字を含めてください'],
			  ['symbol-character-notfound','記号を含めてください'],
			  ['ngword-character-found','禁則文字が含まれています 禁則文字: %s'],
			  ['previously-used-password-found','過去に利用したパスワードは使えません'],
			  ['same-password-found', '前回と同じパスワードには変更できません']
	  		 );
my @policy_en     =
			( ['password-too-short',	  'Please input the password that is longer than %d characters.'],
			  ['userid-character-found',  'You can not use userid string in the password.'],
			  ['cycle-character-found',   'The same character appears continuously two times or more.'],
			  ['upper-alphabet-notfound',    'Please include the capital letter alphabet in the password.'],
			  ['lower-alphabet-notfound',    'Please include the small letter alphabet in the password.'],
			  ['numeric-character-notfound', 'Please include the numeric character in the password.'],
			  ['symbol-character-notfound',  'Please include the symbol character in the password.'],
			  ['ngword-character-found',     'You can not use following words. words : %s'],
			  ['previously-used-password-found', 'You can not use previous password.'],
			  ['same-password-found', 'You can not use same password.']
	  		 );
my @policy        = ($LANGPARAM eq 'ja') ? @policy_ja : @policy_en;
my $MSGTABLE_ja   = {
				E_MISTAKE_PASSWORD => 'パスワードに誤りがあります',
				E_EMPTY_PASSWORD   => 'パスワードを入力してください',
				S_COMPLITE         => 'パスワード変更しました',
				E_POLICY_FAIL      => '変更に失敗しました。以下のポリシーにしたがって再入力してください',
				E_SERVERERROR      => 'サーバエラーが発生しました',
				S_RETURN           => '元の画面へ戻ります。',
			};
my $MSGTABLE_en   = {
				E_MISTAKE_PASSWORD => 'The password is mismatch.',
				E_EMPTY_PASSWORD   => 'Please input password.',
				S_COMPLITE         => 'Password changed successfully.',
				E_POLICY_FAIL      => 'Could not change password. Please input password following the password policy rule.',
				E_SERVERERROR      => 'The server error found.',
				S_RETURN           => 'Return to previous page',
			};
my $MSGTABLE      = ($LANGPARAM eq 'ja') ? $MSGTABLE_ja : $MSGTABLE_en;
my %form;

my ($SCHEMA,$SERVER_PORT,$URI_PREFIX) = TF::CommonUtils::getCgiConnectInfo();
my $URL         = $URI_PREFIX . $LOCATION . '/.management/USER/';

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

main();

#
# main 
#
sub main {
	my $buf;
	my $ret       = TF_SUCCESS;
	my $message   = '';
	my $next      = '';
	my $errheader = undef;
	my $sid       = undef;

	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
		my @pairs = split(/&/, $buf);
		foreach my $pair (@pairs) {
			my ($name, $value) = split(/=/, $pair);
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			$form{$name} = $value;
		}

		if ($form{'newpass'} eq "" || $form{'verify'} eq "") {
			$ret     = TF_ERROR;
			$message = $MSGTABLE->{E_EMPTY_PASSWORD};
		}
		elsif ($form{'newpass'} ne $form{'verify'}) {
			$ret     = TF_ERROR;
			$message = $MSGTABLE->{E_MISTAKE_PASSWORD};
		}

		# CrossSiteScripting 対策
		if ($form{'next'}) {
			$next = TF::CommonUtils::escapeHTML($form{'next'});
			$next =~ s!//!/!g;
		}

		if ($next && index($next, $LOCATION) != 0) { 
			TF::CommonUtils::showAccessDeny();
			die '';
		}

		@pairs = split(/;\s*/, $ENV{'HTTP_COOKIE'});
		foreach my $pair (@pairs) {
			my ($key, $val) = split(/=/, $pair);
			if ($key eq "tf-session") {
				$sid = $val; last;
			}
		}

		if ($ret == TF_SUCCESS) {
			$errheader = &requestTF($sid);
			if ($errheader) {
				if ($errheader eq "SERVERERROR") {
					$ret = TF_FAIL;
					$message = $MSGTABLE->{E_SERVERERROR};
				}
				else {
					$ret = TF_ERROR;
					$message = $MSGTABLE->{E_POLICY_FAIL};
				}
			}
			else {
				$message = $MSGTABLE->{S_COMPLITE};
				if ($next) {
					$message .= "<p><a href='" . $next . "'>" . $MSGTABLE->{S_RETURN} . "</a></p>";
				}
			}
		}

	}
	else {
		# GET 
		my @pairs = split(/&/,$ENV{'QUERY_STRING'});
		foreach my $pair(@pairs) {
			my ($name, $value) = split(/=/,$pair);
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			$form{$name} = $value;
		}
	}

	&printHTML($ret, $message, $errheader, $next?$next:undef);
}

#
# sub
#
sub requestTF {
		my $ua  = LWP::UserAgent->new(ssl_opts => {verify_hostname => 0});
		my $req = HTTP::Request->new;
		my $ret = undef;
		my $errheader = "";
		my $sid = shift;

		#---------------
		# PROPPATCH
		#---------------

		$req->uri($URL . $USERID);
		$req->method("PROPPATCH");
		$req->protocol("HTTP/1.1");
		$req->authorization_basic($USERID, $PASSWD);
		if ($sid) { $req->header("x-tf-session" => $sid); }
		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:changepassword><![CDATA[$form{'newpass'}]]></TF:changepassword></D:prop></D:set></D:propertyupdate>";

		$req->content($content);
		$ua->agent(TF::CommonUtils::getCgiUserAgent());
		my $res = $ua->request($req);
		my $data = $res->content();
		if ($data && $res->code == 207) {
			my $xml = new XML::DOM::Parser;
			my $doc = $xml->parse($data);
			my $e   = $doc->getElementsByTagName("D:status");
			my $node = $e->item(0);
			my $str = $node->toString();
			my ($p, $c, $m) = split(/ /, $str);
			if ($c && $c ne "200") {
				my $header = $res->headers;
				if ($header) {
					$errheader = $header->header("TF-PASSWORD-ERROR");
					if (!$errheader) {
						$errheader = "SERVERERROR";
					}
				}
				else {
					$errheader = "SERVERERROR";
				}
			}
		}
		else {
			$errheader = "SERVERERROR";
		}

		return $errheader;
}

sub printHTML
{
	my $code      = shift;
	my $message   = shift || '';
	my $errheader = shift || undef;
	my $next      = shift || undef;
	my $isPassPolicyError = 0;
	my @policyerr = ();
	my $msg;

	if ($code == TF_ERROR && $errheader) {
		$isPassPolicyError = 1;
		my @err = split(/,/, $errheader);
		foreach (@err) {
			s/ //g;	# 空白を乗り除く
			$msg = &getPolicyError($_);
			push(@policyerr, { msg => $msg });
		}
	}

	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,
								isPassPolicyError => $isPassPolicyError,
								message => $message,
								policyerr => \@policyerr,
								nexturi => $next,
							);
			print "Content-type: text/html; charset=UTF-8\n\n";
			print $htmltmpl->output;
		}
		close(TEMPLATE);
	}
	else {
		TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
	}
}

sub getPolicyError
{
	my ($name, $valtmp) = split(/;/);
	my $tmp = undef;
	my $val = undef;

	if ($valtmp) {
		($tmp, $val) = split(/=/, $valtmp);
	}

	if ($val) {
		$val =~ tr/+/ /;
		$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$val = TF::CommonUtils::escapeHTML($val, 1);
	}
	my $msg = undef;

	for my $i(0 .. $#policy) {
		if ($policy[$i][0] =~ /$name/) {
			$msg = sprintf($policy[$i][1], $val);
			last;
		}
	}

	return $msg;
}
