#!/usr/bin/perl -w
#------------------------------------------------------------------------------
# Group create CGI
#------------------------------------------------------------------------------

use strict;
use utf8;
use CGI;
use Encode qw(decode encode);
use HTML::Template;
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape qw(uri_escape_utf8 uri_unescape);
use TF::CommonUtils;
use TF::GroupList;

binmode(STDOUT, ":utf8");

my $BRAND         = $ENV{'TF_BRANDNAME'} || '';
my $LOCATION      = $ENV{'TF_LOCATION'} || '';
my $USERTYPE      = $ENV{'TF_USERTYPE'} || 'normal';
my $REMOTE_USER   = $ENV{'REMOTE_USER'} || '';
my $PASSWD        = $ENV{'TF_USERPLAINPASSWORD'} || '';
my $TF_TOKEN      = $ENV{'TF_TOKEN'} || '';
my $LANGPARAM     = TF::CommonUtils::getLangPriority();
my $TEMPLATE_FILE = './tmpl/groupcreate.tmpl.' . $LANGPARAM;
my $BACKURI       = $LOCATION . '/.cgi-bin/groupmembers';
my ($SCHEMA, $SERVER_PORT, $URI_PREFIX) = TF::CommonUtils::getCgiConnectInfo();
my $BASE_URL       = $URI_PREFIX . $LOCATION;
my $GROUP_MGMT_URL = $URI_PREFIX . $LOCATION . '/.management/GROUP/';

my $ERRORTABLE_ja = {
	CGIError => 'CGIエラーです',
	invalidToken => '画面を再読み込みしてからやり直してください',
	required => '未入力の項目があります',
	invalidGroupName => 'グループ名の形式が不正です',
	createFailed => 'グループ作成に失敗しました',
	alreadyExists => '同じグループ名が既に存在します',
	forbidden => 'このグループは作成できません',
};
my $ERRORTABLE_en = {
	CGIError => 'CGI error found.',
	invalidToken => 'Reload the page and try again.',
	required => 'Some required fields are missing.',
	invalidGroupName => 'The group name format is invalid.',
	createFailed => 'Failed to create the group.',
	alreadyExists => 'The same group name already exists.',
	forbidden => 'This group cannot be created.',
};
my $ERRORTABLE = ($LANGPARAM eq 'ja') ? $ERRORTABLE_ja : $ERRORTABLE_en;

if (!$LOCATION || !$USERTYPE || ($USERTYPE ne 'admin' && $USERTYPE ne 'groupleader')) {
	TF::CommonUtils::showAccessDeny();
	die '';
}

main();

sub main {
	my $cgi = CGI->new;
	if (!$cgi || $cgi->cgi_error) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{CGIError}, $LANGPARAM);
		return;
	}

	my %values = default_values();
	my $status = '';
	my $parent_groupid = trim(TF::CommonUtils::decodeUTF8($cgi->param('parent') || ''));
	my ($parent_ref, $parent_error) = $parent_groupid ? load_parent_group($parent_groupid) : (undef, '');
	if ($parent_error) {
		TF::CommonUtils::showErrorPage($parent_error, $LANGPARAM);
		return;
	}
	$values{parent} = $parent_groupid;
	$values{parentName} = $parent_ref ? $parent_ref->{name} : '';
	$values{parentPath} = $parent_ref ? group_management_path($parent_ref->{grpcoluri}, $parent_ref->{managementuri}) : '';

	if (($cgi->request_method || 'GET') eq 'POST' && (($cgi->param('hidCmd') || '') eq 'set')) {
		%values = submitted_values($cgi);
		if ($parent_groupid) {
			$values{parentName} = $parent_ref->{name};
			$values{parentPath} = group_management_path($parent_ref->{grpcoluri}, $parent_ref->{managementuri});
		}
		my $err = validate_csrf($cgi);
		if ($err) {
			$status = $err;
		}
		else {
			$err = validate_values(\%values);
			if ($err) {
				$status = $err;
			}
			else {
				my ($ok, $errmsg) = request_create_group(\%values, get_session_id());
				if ($ok) {
					my $redirect = $values{parent} ? ($BACKURI . '?groupid=' . uri_escape_utf8($values{parent})) : $BACKURI;
					TF::CommonUtils::redirectPage($redirect, $LANGPARAM);
					return;
				}
				$status = $errmsg;
			}
		}
	}

	show_response($cgi, \%values, $status);
}

sub show_response {
	my ($cgi, $values_ref, $status) = @_;
	my %values = %{$values_ref || {}};

	if (open(my $tmplfh, '<', $TEMPLATE_FILE)) {
		binmode($tmplfh, ':utf8');
		my $htmltmpl = HTML::Template->new(
			filehandle => $tmplfh,
			case_sensitive => 1,
			die_on_bad_params => 0,
		);
		$htmltmpl->param(
			brandname => $BRAND,
			title => localize('title'),
			subtitle => $values{parent} ? localize('childSubtitle') : localize('subtitle'),
			backUri => $values{parent} ? ($BACKURI . '?groupid=' . uri_escape_utf8($values{parent})) : $BACKURI,
			backLabel => localize('backLabel'),
			saveLabel => localize('saveLabel'),
			saveHelp => localize('saveHelp'),
			status => $status,
			hasStatus => $status ? 1 : 0,
			token => $TF_TOKEN,
			parent => esc($values{parent}),
			parentLabel => localize('parentLabel'),
			parentValue => esc($values{parentName} || localize('topGroupLabel')),
			isChildCreate => $values{parent} ? 1 : 0,
			sectionState => localize('sectionState'),
			sectionBasic => localize('sectionBasic'),
			sectionMeta => localize('sectionMeta'),
			groupNameLabel => localize('groupNameLabel'),
			groupNameDesc => $values{parent} ? localize('childGroupNameDesc') : localize('groupNameDesc'),
			groupNameValue => esc($values{groupname}),
			commentLabel => localize('commentLabel'),
			commentDesc => localize('commentDesc'),
			commentValue => esc($values{comment}),
			activeLabel => localize('activeLabel'),
			activeDesc => localize('activeDesc'),
			activeChecked => $values{active} eq 'on' ? 1 : 0,
			sectionAttributes => localize('sectionAttributes'),
			restrictWriteLabel => localize('restrictWriteLabel'),
			restrictWriteDesc => localize('restrictWriteDesc'),
			restrictWriteChecked => $values{restrict_write} eq 'on' ? 1 : 0,
			restrictShowpropLabel => localize('restrictShowpropLabel'),
			restrictShowpropDesc => localize('restrictShowpropDesc'),
			restrictShowpropChecked => $values{restrict_showprop} eq 'on' ? 1 : 0,
			restrictOplogLabel => localize('restrictOplogLabel'),
			restrictOplogDesc => localize('restrictOplogDesc'),
			restrictOplogChecked => $values{restrict_oplog} eq 'on' ? 1 : 0,
			boxLabel => localize('boxLabel'),
			boxDesc => localize('boxDesc'),
			boxChecked => $values{box} eq 'on' ? 1 : 0,
			toggleOnLabel => localize('toggleOnLabel'),
			toggleOffLabel => localize('toggleOffLabel'),
			createdLabel => localize('createdLabel'),
			updatedLabel => localize('updatedLabel'),
			notCreatedLabel => localize('notCreatedLabel'),
		);
		print $cgi->header(-charset => 'UTF-8');
		print $htmltmpl->output;
		close($tmplfh);
		return;
	}
	TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
}

sub submitted_values {
	my $cgi = shift;
	my %values = default_values();
	$values{parent} = trim(TF::CommonUtils::decodeUTF8($cgi->param('parent') || ''));
	$values{groupname} = trim(TF::CommonUtils::decodeUTF8($cgi->param('groupname') || ''));
	$values{comment} = TF::CommonUtils::decodeUTF8($cgi->param('comment') || '');
	$values{active} = (($cgi->param('active') || '') eq 'on') ? 'on' : 'off';
	$values{restrict_write} = (($cgi->param('restrict_write') || '') eq 'on') ? 'on' : 'off';
	$values{restrict_oplog} = (($cgi->param('restrict_oplog') || '') eq 'on') ? 'on' : 'off';
	$values{restrict_showprop} = (($cgi->param('restrict_showprop') || '') eq 'on') ? 'on' : 'off';
	$values{box} = (($cgi->param('box') || '') eq 'on') ? 'on' : 'off';
	return %values;
}

sub default_values {
	return (
		parent => '',
		parentName => '',
		parentPath => '',
		groupname => '',
		comment => '',
		active => 'on',
		restrict_write => 'off',
		restrict_oplog => 'off',
		restrict_showprop => 'off',
		box => 'off',
	);
}

sub validate_csrf {
	my $cgi = shift;
	return $ERRORTABLE->{invalidToken} if !$TF_TOKEN || (($cgi->param('hidcsrftoken') || '') ne $TF_TOKEN);
	return '';
}

sub validate_values {
	my $values = shift || {};
	return $ERRORTABLE->{forbidden} if !$values->{parent} && $USERTYPE ne 'admin';
	return $ERRORTABLE->{forbidden} if $values->{parent} && !$values->{parentPath};
	return $ERRORTABLE->{required} if !$values->{groupname};
	return $ERRORTABLE->{invalidGroupName} if !is_valid_groupname($values->{groupname});
	return '';
}

sub load_parent_group {
	my $groupid = shift || '';
	my $glist = TF::GroupList->new();
	my $code = $glist->queryGroupList($BASE_URL, $REMOTE_USER, $PASSWD, $groupid);
	if ($code < 200 || $code >= 300 || !$glist->isExist($groupid)) {
		print STDERR "groupcreate: parent group SEARCH failed ($code) parent=$groupid\n";
		return (undef, $ERRORTABLE->{forbidden});
	}
	return ({
		id => $groupid,
		name => $glist->getName($groupid) || $groupid,
		managementuri => $glist->getManagementUri($groupid) || '',
		grpcoluri => $glist->getGroupFolderUri($groupid) || '',
	}, '');
}

sub group_management_path {
	my $grpcoluri = shift || '';
	my $managementuri = shift || '';

	if ($managementuri =~ m{/\.management/GROUP/(.+)$}) {
		my $path = $1;
		$path =~ s/[?#].*$//;
		$path =~ s{/$}{};
		return $path;
	}

	return '' if $grpcoluri !~ m{/Group(?:%20| )Folder/(.+)$};
	my $path = $1;
	$path =~ s/[?#].*$//;
	$path =~ s{/$}{};
	my @segments = grep { $_ ne '' } split(m{/+}, $path);
	return join('/', map { uri_escape_utf8(decode('UTF-8', uri_unescape($_))) } @segments);
}

sub request_create_group {
	my ($values, $sid) = @_;
	my $ua  = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
	my $req = HTTP::Request->new;

	my $parent_path = $values->{parentPath} ? ($values->{parentPath} . '/') : '';
	$req->uri($GROUP_MGMT_URL . $parent_path . uri_escape_utf8($values->{groupname}));
	$req->method('MKCOL');
	$req->protocol('HTTP/1.1');
	$req->authorization_basic($REMOTE_USER, $PASSWD);
	$req->header('x-tf-session' => $sid) if $sid;
	$req->header('Content-Type' => 'text/xml; charset=UTF-8');
	$req->content(encode('UTF-8', build_groupcreate_xml($values)));
	$ua->agent(TF::CommonUtils::getCgiUserAgent());

	my $res = $ua->request($req);
	return (1, '') if $res->is_success;

	my $code = $res->code || 500;
	my $status = $res->status_line || '';
	print STDERR "groupcreate: MKCOL failed ($code) $status\n";

	return (0, $ERRORTABLE->{forbidden}) if $code == 403;
	return (0, $ERRORTABLE->{alreadyExists}) if $code == 405 || $code == 409;
	return (0, $ERRORTABLE->{invalidGroupName}) if $code == 400;
	return (0, $ERRORTABLE->{createFailed} . " ($code)");
}

sub build_groupcreate_xml {
	my $values = shift || {};
	my $state_tag = ($values->{active} eq 'on') ? '<TF:active/>' : '<TF:inactive/>';
	my $comment_tag = ($values->{comment} ne '') ? '<TF:comment>' . escape_xml($values->{comment}) . '</TF:comment>' : '';
	my $restrict_write = $values->{restrict_write} eq 'on';
	my $restrict_oplog = $values->{restrict_oplog} eq 'on';
	my $restrict_showprop = $values->{restrict_showprop} eq 'on';
	if ($values->{box} eq 'on') {
		$restrict_write = 0;
		$restrict_oplog = 1;
		$restrict_showprop = 1;
	}
	my $constraints = '<TF:constraints>'
		. ($restrict_write ? '<TF:write/>' : '')
		. ($restrict_oplog ? '<TF:operationlog/>' : '')
		. ($restrict_showprop ? '<TF:showproperty/>' : '')
		. '</TF:constraints>';
	my $box_tag = $values->{box} eq 'on' ? '<TF:box><TF:active/></TF:box>' : '<TF:box><TF:inactive/></TF:box>';

	return '<?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:groupdiscovery><TF:groupinfo>'
		. '<TF:name>' . escape_xml($values->{groupname}) . '</TF:name>'
		. $comment_tag
		. '<TF:state>' . $state_tag . '</TF:state>'
		. $box_tag . $constraints
		. '</TF:groupinfo></TF:groupdiscovery></D:prop></D:set></D:propertyupdate>';
}

sub get_session_id {
	my @pairs = split(/;\s*/, $ENV{'HTTP_COOKIE'} || '');
	foreach my $pair (@pairs) {
		my ($key, $val) = split(/=/, $pair, 2);
		return $val || '' if defined $key && $key eq 'tf-session';
	}
	return '';
}

sub is_valid_groupname {
	my $groupname = shift || '';
	return 0 if $groupname eq '';
	return 0 if $groupname =~ m{/};
	return 0 if $groupname =~ /^\./;
	return 0 if $groupname =~ /[\x00-\x1f]/;
	return 1;
}

sub trim {
	my $str = shift;
	return '' if !defined $str;
	$str =~ s/^[\s\x{3000}]+//;
	$str =~ s/[\s\x{3000}]+$//;
	return $str;
}

sub escape_xml {
	my $str = shift;
	return '' if !defined $str;
	$str =~ s/&/&amp;/g;
	$str =~ s/</&lt;/g;
	$str =~ s/>/&gt;/g;
	$str =~ s/"/&quot;/g;
	$str =~ s/'/&apos;/g;
	return $str;
}

sub esc {
	my $str = shift;
	return '' if !defined $str || $str eq '';
	my $escaped = TF::CommonUtils::escapeHTML($str, 0);
	return defined $escaped ? $escaped : '';
}

sub localize {
	my $key = shift || '';
	my %ja = (
		title => 'グループ作成',
		subtitle => 'トップ直下に新しいグループを作成します。',
		childSubtitle => '選択したグループの下に新しいグループを作成します。',
		backLabel => 'グループ管理へ戻る',
		saveLabel => '作成',
		saveHelp => '入力内容でグループを作成します。',
		sectionState => '状態',
		sectionBasic => '基本設定',
		sectionAttributes => '属性',
		restrictWriteLabel => '書き込み制約',
		restrictWriteDesc => '一般ユーザによる書き込みを制限します',
		restrictShowpropLabel => 'プロパティ表示制約',
		restrictShowpropDesc => '所属ユーザなどのプロパティ表示を制限します',
		restrictOplogLabel => '操作ログ表示制約',
		restrictOplogDesc => '一般ユーザによる操作ログ表示を制限します',
		boxLabel => 'BOXグループ',
		boxDesc => '外部公開用のBOXとして利用します',
		sectionMeta => '管理情報',
		parentLabel => '作成先',
		topGroupLabel => 'トップ直下',
		groupNameLabel => 'グループ名',
		groupNameDesc => 'トップ直下に作成するグループ名',
		childGroupNameDesc => '選択したグループ配下に作成するグループ名',
		commentLabel => 'コメント',
		commentDesc => 'グループの説明として表示されます',
		activeLabel => '有効状態',
		activeDesc => '作成直後に利用可能とするか',
		toggleOnLabel => 'ON',
		toggleOffLabel => 'OFF',
		createdLabel => '登録日時',
		updatedLabel => '更新日時',
		notCreatedLabel => '作成後に表示されます',
	);
	my %en = (
		title => 'Create Group',
		subtitle => 'Create a new top-level group.',
		childSubtitle => 'Create a new group under the selected group.',
		backLabel => 'Back to group management',
		saveLabel => 'Create',
		saveHelp => 'Create the group with the current values.',
		sectionState => 'State',
		sectionBasic => 'Basic Settings',
		sectionAttributes => 'Attributes',
		restrictWriteLabel => 'Write restriction',
		restrictWriteDesc => 'Restrict write operations by normal users',
		restrictShowpropLabel => 'Property visibility restriction',
		restrictShowpropDesc => 'Restrict display of members and other properties',
		restrictOplogLabel => 'Operation log restriction',
		restrictOplogDesc => 'Restrict operation log access by normal users',
		boxLabel => 'BOX group',
		boxDesc => 'Use this group as an externally published BOX',
		sectionMeta => 'Metadata',
		parentLabel => 'Destination',
		topGroupLabel => 'Top level',
		groupNameLabel => 'Group name',
		groupNameDesc => 'Name of the top-level group to create',
		childGroupNameDesc => 'Name of the group to create under the selected group',
		commentLabel => 'Comment',
		commentDesc => 'Displayed as the group description',
		activeLabel => 'Active state',
		activeDesc => 'Whether the group is usable immediately after creation',
		toggleOnLabel => 'ON',
		toggleOffLabel => 'OFF',
		createdLabel => 'Created at',
		updatedLabel => 'Updated at',
		notCreatedLabel => 'Shown after creation',
	);
	my $table = ($LANGPARAM eq 'ja') ? \%ja : \%en;
	return exists $table->{$key} ? $table->{$key} : $key;
}
