#!/usr/bin/perl -w
#------------------------------------------------------------------------------
# User management CGI
#------------------------------------------------------------------------------

use strict;
use utf8;
use CGI;
use Encode qw(encode);
use HTML::Template;
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape qw(uri_escape_utf8);
use TF::CommonUtils;
use TF::UserPermissions;
use TF::UserExpiration;
use TF::UserList;

binmode(STDOUT, ":utf8");

my $BRAND         = $ENV{'TF_BRANDNAME'} || '';
my $USERID        = $ENV{'REMOTE_USER'} || '';
my $PASSWD        = $ENV{'TF_USERPLAINPASSWORD'} || '';
my $LOCATION      = $ENV{'TF_LOCATION'} || '';
my $USERTYPE      = $ENV{'TF_USERTYPE'} || 'normal';
my $TF_TOKEN      = $ENV{'TF_TOKEN'} || '';
my $LANGPARAM     = TF::CommonUtils::getLangPriority();
my ($SCHEMA, $SERVER_PORT, $URI_PREFIX) = TF::CommonUtils::getCgiConnectInfo();
my $URL           = $URI_PREFIX . $LOCATION;
my $USER_MGMT_URL = $URL . '/.management/USER/';
my $TEMPLATE_FILE = './tmpl/user.tmpl.' . $LANGPARAM;

my $ERRORTABLE_ja = {
	CGIError => 'CGIエラーです',
	searchError => 'ユーザ一覧の取得に失敗しました',
	invalidToken => '画面を再読み込みしてからやり直してください',
	invalidUserId => 'ユーザIDの形式が不正です',
	updateFailed => 'ユーザ状態の更新に失敗しました',
	selfActiveForbidden => 'ログイン中のユーザは状態を変更できません',
};
my $ERRORTABLE_en = {
	CGIError => 'CGI error found.',
	searchError => 'Failed to retrieve the user list.',
	invalidToken => 'Reload the page and try again.',
	invalidUserId => 'The user ID format is invalid.',
	updateFailed => 'Failed to update the user state.',
	selfActiveForbidden => 'The signed-in user state cannot be changed.',
};
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) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{CGIError}, $LANGPARAM);
		return;
	}
	if ($cgi->cgi_error) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{CGIError} . '(' . $cgi->cgi_error . ')', $LANGPARAM);
		return;
	}

	if (($cgi->request_method || 'GET') eq 'POST' && (($cgi->param('hidCmd') || '') eq 'toggleActive')) {
		my $err = validate_csrf($cgi);
		if ($err) {
			TF::CommonUtils::showErrorPage($err, $LANGPARAM);
			return;
		}
		my $target = trim(TF::CommonUtils::decodeUTF8($cgi->param('userid') || ''));
		if (!is_valid_userid($target)) {
			TF::CommonUtils::showErrorPage($ERRORTABLE->{invalidUserId}, $LANGPARAM);
			return;
		}
		if ($target eq $USERID) {
			TF::CommonUtils::showErrorPage($ERRORTABLE->{selfActiveForbidden}, $LANGPARAM);
			return;
		}
		my $active = (($cgi->param('active') || '') eq 'on') ? 'on' : 'off';
		my ($ok, $errmsg) = toggle_user_active($target, $active);
		if (!$ok) {
			TF::CommonUtils::showErrorPage($errmsg, $LANGPARAM);
			return;
		}
		TF::CommonUtils::redirectPage($LOCATION . '/.cgi-bin/user', $LANGPARAM);
		return;
	}

	my $ulist = TF::UserList->new();
	my $status = $ulist->queryUserList($URL, $USERID, $PASSWD);
	if ($status != 207) {
		TF::CommonUtils::showErrorPage($ERRORTABLE->{searchError} . " ($status)", $LANGPARAM);
		return;
	}

	my @rows;
	my $active_count = 0;
	my $inactive_count = 0;
	foreach my $id ($ulist->getIDList()) {
		next if !$ulist->hasUserItem($id);
		my $is_active = $ulist->isActive($id) ? 1 : 0;
		my $mailaddr = normalized_mailaddr($ulist->getMailAddr($id) || '');
		if ($is_active) {
			$active_count++;
		}
		else {
			$inactive_count++;
		}
		push @rows, {
			rowClass => $is_active ? '' : 'user-row-inactive',
			userid => esc($id),
			useridRaw => esc($id),
			editUri => $LOCATION . '/.cgi-bin/useredit?userid=' . uri_escape_utf8($id),
			token => esc($TF_TOKEN),
			name => esc(TF::CommonUtils::decodeUTF8($ulist->getName($id) || '')),
			mailaddr => html_cell($mailaddr),
			usertype => esc(localizeUserType($ulist->getUserType($id) || '')),
			ownername => esc(TF::CommonUtils::decodeUTF8($ulist->getOwnerName($id) || '')),
			maxusercreation => esc($ulist->getMaxUserCreation($id) || '0'),
			isactive => $is_active ? localize('active') : localize('inactive'),
			activeChecked => $is_active ? 1 : 0,
			nextActiveValue => $is_active ? 'off' : 'on',
			canToggleActive => ($id eq $USERID) ? 0 : 1,
			isotheruser => $ulist->isOtherUser($id) ? localize('yes') : localize('no'),
		};
	}

	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,
			createUri => $LOCATION . '/.cgi-bin/usercreate',
			token => $TF_TOKEN,
			rowCount => scalar(@rows),
			activeCount => $active_count,
			inactiveCount => $inactive_count,
			users => \@rows,
			title => localize('title'),
			subtitle => localize('subtitle'),
			createLabel => localize('createLabel'),
			createHelp => localize('createHelp'),
			colUserId => localize('colUserId'),
			colName => localize('colName'),
			colMail => localize('colMail'),
			colType => localize('colType'),
			colOwner => localize('colOwner'),
			colMaxUserCreation => localize('colMaxUserCreation'),
			colState => localize('colState'),
			colOtherUser => localize('colOtherUser'),
			summaryTotal => localize('summaryTotal'),
			summaryActive => localize('summaryActive'),
			summaryInactive => localize('summaryInactive'),
		);
		print $cgi->header(-charset => 'utf-8');
		print $htmltmpl->output;
		close($tmplfh);
	}
	else {
		TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
	}
}

sub localize {
	my $key = shift || '';
	my %ja = (
		title => 'ユーザ',
		subtitle => '管理可能なユーザの一覧です。',
		createLabel => '新規作成',
		createHelp => '作成画面へ移動',
		colUserId => 'ユーザID',
		colName => '表示名',
		colMail => 'メールアドレス',
		colType => 'ユーザ種別',
		colOwner => 'オーナー',
		colMaxUserCreation => '最大作成数',
		colState => '状態',
		colOtherUser => 'Other',
		summaryTotal => '登録人数',
		summaryActive => 'アクティブ人数',
		summaryInactive => '非アクティブ人数',
		active => '有効',
		inactive => '非アクティブ',
		yes => 'はい',
		no => 'いいえ',
	);
	my %en = (
		title => 'Users',
		subtitle => 'List of manageable users.',
		createLabel => 'Create',
		createHelp => 'Open create form',
		colUserId => 'User ID',
		colName => 'Name',
		colMail => 'Mail address',
		colType => 'User type',
		colOwner => 'Owner',
		colMaxUserCreation => 'Max creations',
		colState => 'State',
		colOtherUser => 'Other',
		summaryTotal => 'Total users',
		summaryActive => 'Active users',
		summaryInactive => 'Inactive users',
		active => 'Active',
		inactive => 'Inactive',
		yes => 'Yes',
		no => 'No',
	);
	return ($LANGPARAM eq 'ja') ? $ja{$key} : $en{$key};
}

sub localizeUserType {
	my $type = shift || '';
	return $type if $LANGPARAM ne 'ja';

	my %labels = (
		admin => '管理者',
		groupleader => 'グループ管理者',
		normal => '一般ユーザ',
		limited => '制限ユーザ',
	);
	return $labels{$type} || $type;
}

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

sub toggle_user_active {
	my ($target, $active) = @_;
	my $values = load_user_values($target);
	return (0, $ERRORTABLE->{updateFailed}) if !$values;
	$values->{active} = $active;
	return request_update_user($target, $values, get_session_id());
}

sub normalized_mailaddr {
	my $mailaddr = shift || '';
	$mailaddr =~ s/^[\s\x{3000}]+//;
	$mailaddr =~ s/[\s\x{3000}]+$//;
	return '' if $mailaddr eq 'userType' || $mailaddr eq 'usertype';
	return $mailaddr;
}

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

sub html_cell {
	my $value = shift || '';
	return '&nbsp;' if $value eq '';
	return esc($value);
}

sub load_user_values {
	my $target = shift || '';
	my $ulist = TF::UserList->new();
	my $status = $ulist->queryUser($URL, $USERID, $PASSWD, $target);
	return undef if $status != 207 || !$ulist->hasUserItem($target);

	return {
		active => $ulist->isActive($target) ? 'on' : 'off',
		usertype => $ulist->getUserType($target) || 'normal',
		fullname => TF::CommonUtils::decodeUTF8($ulist->getName($target) || ''),
		mailaddr => normalized_mailaddr($ulist->getMailAddr($target) || ''),
		password => $ulist->getPassword($target) || '',
		maxstorage => $ulist->getMaxStorage($target) || '0',
		maxresource => $ulist->getMaxResource($target) || '0',
		accessdeny => $ulist->getAccessDeny($target) || '',
		comment => $ulist->getComment($target) || '',
		maxusercreation => $ulist->getMaxUserCreation($target),
		TF::UserExpiration::from_iso8601($ulist->getExpiration($target) || ''),
		TF::UserPermissions::from_user($ulist, $target),
	};
}

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

	$req->uri($USER_MGMT_URL . uri_escape_utf8($target));
	$req->method('PROPPATCH');
	# List actions do not edit allowhosts; keep access-control compatibility off.
	$req->header('TF-Client-Info' => '001100000');
	$req->protocol('HTTP/1.1');
	$req->authorization_basic($USERID, $PASSWD);
	$req->header('x-tf-session' => $sid) if $sid;
	$req->header('Content-Type' => 'text/xml; charset=UTF-8');
	$req->content(encode('UTF-8', build_user_update_xml($values)));
	$ua->agent(TF::CommonUtils::getCgiUserAgent());

	my $res = $ua->request($req);
	if ($res->is_success && (($res->code || 0) == 207)) {
		my $code = multistatus_code($res->content());
		return (1, '') if !$code || $code == 200;
		print STDERR "user: toggle PROPPATCH propstat failed ($code)\n";
		return (0, $ERRORTABLE->{updateFailed} . " ($code)");
	}

	my $code = $res->code || 500;
	my $status = $res->status_line || '';
	print STDERR "user: toggle PROPPATCH failed ($code) $status\n";
	return (0, $ERRORTABLE->{updateFailed} . " ($code)");
}

sub build_user_update_xml {
	my $values = shift;
	my $state_tag = ($values->{active} eq 'on') ? '<TF:active/>' : '<TF:inactive/>';
	my $usertype_tag = '<TF:normal/>';
	if ($values->{usertype} eq 'groupleader') {
		$usertype_tag = '<TF:groupleader/>';
	}
	elsif ($values->{usertype} eq 'admin') {
		$usertype_tag = '<TF:admin/>';
	}
	elsif ($values->{usertype} eq 'limited') {
		$usertype_tag = '<TF:limited/>';
	}

	my $mail_tag = ($values->{mailaddr} || '') ne ''
		? '<TF:mailaddr>' . escape_xml($values->{mailaddr}) . '</TF:mailaddr>'
		: '<TF:mailaddr/>';

	my $privilege_tag = build_privilege_xml($values);
	my $expiration_tag = TF::UserExpiration::build_xml($values);
	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:userdiscovery><TF:userinfo>'
		. '<TF:name>' . escape_xml($values->{fullname}) . '</TF:name>'
		. $mail_tag
		. '<TF:password>' . escape_xml($values->{password}) . '</TF:password>'
		. '<TF:maxstorage>' . escape_xml($values->{maxstorage}) . '</TF:maxstorage>'
		. '<TF:maxresource>' . escape_xml($values->{maxresource}) . '</TF:maxresource>'
		. '<TF:maxusercreation>' . escape_xml($values->{maxusercreation} || '0') . '</TF:maxusercreation>'
		. '<TF:accessdeny>' . escape_xml($values->{accessdeny} || '') . '</TF:accessdeny>'
		. '<TF:comment>' . escape_xml($values->{comment} || '') . '</TF:comment>'
		. '<TF:state>' . $state_tag . '</TF:state>'
		. $expiration_tag
		. $privilege_tag
		. '<TF:usertype>' . $usertype_tag . '</TF:usertype>'
		. '</TF:userinfo></TF:userdiscovery></D:prop></D:set></D:propertyupdate>';
}

sub build_privilege_xml {
	return TF::UserPermissions::build_xml(shift || {});
}

sub multistatus_code {
	my $data = shift || '';
	return undef if $data !~ m{<D:status>\s*HTTP/\S+\s+(\d+)}s;
	return int($1);
}

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

sub is_valid_userid {
	my $userid = shift || '';
	return 0 if $userid eq '';
	return 0 if $userid =~ m{/};
	return 0 if $userid =~ /^\./;
	return 1;
}

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 trim {
	my $str = shift;
	return '' if !defined $str;
	$str =~ s/^[\s\x{3000}]+//;
	$str =~ s/[\s\x{3000}]+$//;
	return $str;
}
