#!/usr/bin/perl -w
#------------------------------------------------------------------------------
# Location security and authentication configuration CGI
#------------------------------------------------------------------------------

use strict;
use utf8;
use CGI;
use HTML::Template;
use TF::CommonUtils;
use TF::SingleLock;

binmode(STDOUT, ':utf8');

my $LOCATION = $ENV{'TF_LOCATION'} || '';
my $BRAND = $ENV{'TF_BRANDNAME'} || '';
my $TF_VERSION = $ENV{'TF_VERSION'} || '';
my $USERTYPE = $ENV{'TF_USERTYPE'} || 'normal';
my $LANGPARAM = TF::CommonUtils::getLangPriority();
my $TF_TOKEN = $ENV{'TF_TOKEN'} || undef;
my $CONFIG_ROOT = $ENV{'TF_CONFIG_ROOT'} || '/usr/local/teamfile/www/conf/conf.d';
my $LOCATION_NAME = $LOCATION;
$LOCATION_NAME =~ s/\///g;

my $TEMPLATE_NAME = 'securityconf.tmpl.' . $LANGPARAM;
my $SETTINGS_URI = $LOCATION . '/.cgi-bin/admin/settings';
my $OVERRIDE_DIR = $CONFIG_ROOT . '/location-overrides/' . $LOCATION_NAME;
my $OVERRIDE_FILE = $OVERRIDE_DIR . '/security.conf';
my $GENERAL_FILE = $OVERRIDE_DIR . '/general.conf';
my $BASE_FILE = $CONFIG_ROOT . '/new_' . $LOCATION_NAME . '.conf';
my $SERVER_DEFAULT_FILE = $CONFIG_ROOT . '/mod_dav_tf.conf.default';
my $SERVER_FILE = $CONFIG_ROOT . '/mod_dav_tf.conf';
my $LOCK_FILE = $OVERRIDE_DIR . '/.securityconf.lock';

my @SECTIONS = (
	{ key => 'password', ja => 'パスワードポリシー', en => 'Password policy' },
	{ key => 'login', ja => 'ログイン保護', en => 'Login protection' },
	{ key => 'saml', ja => 'SAML認証', en => 'SAML authentication' },
);

my @FIELDS = (
	field('TfPassPolicy', 'password', 'パスワードポリシー', 'Password policy', 'on', 'flag'),
	field('TfPassPolicyOptions', 'password', 'ポリシーオプション', 'Policy options', '+Base', 'readonly'),
	field('TfPassPolicyExclusion', 'password', 'ポリシー除外条件', 'Policy exclusion rule', '', 'raw'),
	field('TfFailedLoginLimit', 'login', 'ロックアウトまでの失敗回数', 'Failures before lockout', '5', 'uint'),
	field('TfFailedLoginUnlockTime', 'login', '再チャレンジまでの秒数', 'Seconds before retry', '60', 'uint'),
	field('TfFailedLoginRetryCount', 'login', '再チャレンジ可能回数', 'Retry cycle limit', '3', 'uint'),
	field('TfAuthloginignoreinspectionipaddrs', 'login', '認証検査除外IPアドレス', 'Authentication-excluded IP addresses', '', 'iplist'),
	field('TfUseSAML', 'saml', 'SAML認証', 'SAML authentication', 'off', 'flag'),
	field('TfSAMLIdPMetaDataPath', 'saml', 'IdPメタデータファイル', 'IdP metadata file', '', 'path'),
	field('TfSAMLXMLPrivateKeyPath', 'saml', '署名秘密鍵ファイル', 'Signing private key file', '', 'path'),
	field('TfSAMLXMLPublicCertificatePath', 'saml', '公開証明書ファイル', 'Public certificate file', '', 'path'),
	field('TfSAMLMatchedMailAddr', 'saml', 'NameIDをメールアドレスと照合', 'Match NameID to mail address', 'off', 'flag'),
);

my %READONLY_DEFAULT = (TfUseSession => 'on', TfSessionTimeOut => '0');
my %MSG = $LANGPARAM eq 'ja' ? (
	invalid => '値が不正です', write => '設定の書き込みに失敗しました',
	nowrite => '設定ディレクトリに書き込みできません', busy => 'サーバがビジーです',
	saved => '設定を保存しました。反映にはApacheのgraceful restartが必要です。',
) : (
	invalid => 'Invalid value.', write => 'Failed to write settings.',
	nowrite => 'The settings directory is not writable.', busy => 'The server is busy.',
	saved => 'Settings were saved. An Apache graceful restart is required to apply them.',
);

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

my $cgi = CGI->new;
if (!$cgi || $cgi->cgi_error) {
	TF::CommonUtils::showErrorPage($MSG{invalid}, $LANGPARAM);
	exit;
}

if (($cgi->param('hidCmd') || '') eq 'set') {
	storeSettings($cgi);
} else {
	showResponse($cgi, '');
}

sub field {
	my ($key, $section, $ja, $en, $default, $type) = @_;
	return { key => $key, section => $section, ja => $ja, en => $en,
		default => $default, type => $type };
}

sub storeSettings {
	my $cgi = shift;
	if (!defined $TF_TOKEN || ($cgi->param('hidcsrftoken') || '') ne $TF_TOKEN) {
		TF::CommonUtils::showErrorPage($MSG{invalid}, $LANGPARAM);
		return;
	}

	my %values;
	foreach my $item (@FIELDS) {
		next if $item->{type} eq 'readonly';
		my $value = TF::CommonUtils::decodeUTF8($cgi->param($item->{key}) || '');
		$value =~ s/^\s+|\s+$//g;
		$value = normalizeIPList($value) if $item->{type} eq 'iplist';
		if (!validateValue($item, $value)) {
			showResponse($cgi, "$MSG{invalid} ($item->{key})");
			return;
		}
		$values{$item->{key}} = $value if $value ne '';
	}
	if (lc($values{TfUseSAML} || 'off') eq 'on') {
		foreach my $required (qw(TfSAMLIdPMetaDataPath TfSAMLXMLPrivateKeyPath TfSAMLXMLPublicCertificatePath)) {
			if (!defined $values{$required} || $values{$required} eq '') {
				showResponse($cgi, "$MSG{invalid} ($required)");
				return;
			}
		}
	}

	if (!-d $OVERRIDE_DIR && !mkdirParents($OVERRIDE_DIR)) {
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	}
	if (!-w $OVERRIDE_DIR) {
		TF::CommonUtils::showErrorPage($MSG{nowrite}, $LANGPARAM);
		return;
	}
	my $lock = TF::SingleLock->new($LOCK_FILE);
	if (!$lock->waitForLocking(5)) {
		TF::CommonUtils::showErrorPage($MSG{busy}, $LANGPARAM);
		return;
	}
	my $tmp = $OVERRIDE_FILE . ".$$.tmp";
	my $fh;
	if (!open($fh, '>', $tmp)) {
		$lock->release();
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	}
	binmode($fh, ':utf8');
	print $fh "# This file is managed by TeamFile CGI.\n# Location: $LOCATION_NAME\n\n";
	foreach my $item (@FIELDS) {
		my $key = $item->{key};
		next if $item->{type} eq 'readonly' || $item->{type} eq 'uint';
		next if !defined $values{$key};
		print $fh sprintf("%-38s %s\n", $key, formatValue($item, $values{$key}));
	}
	print $fh sprintf("%-38s %s %s %s\n", 'TfFailedLoginControl',
		$values{TfFailedLoginLimit}, $values{TfFailedLoginUnlockTime}, $values{TfFailedLoginRetryCount});
	close($fh);
	chmod(0644, $tmp);
	if (!rename($tmp, $OVERRIDE_FILE)) {
		unlink($tmp);
		$lock->release();
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	}
	$lock->release();
	showResponse($cgi, $MSG{saved});
}

sub showResponse {
	my ($cgi, $status) = @_;
	my %values;
	readDirectiveFile($SERVER_DEFAULT_FILE, \%values);
	readDirectiveFile($SERVER_FILE, \%values);
	readDirectiveFile($BASE_FILE, \%values);
	readDirectiveFile($GENERAL_FILE, \%values);
	readDirectiveFile($OVERRIDE_FILE, \%values);

	my @sections;
	foreach my $section (@SECTIONS) {
		my @rows;
		foreach my $item (@FIELDS) {
			next if $item->{section} ne $section->{key};
			my $value = defined $values{$item->{key}} ? $values{$item->{key}} : $item->{default};
			push @rows, {
				key => $item->{key}, label => localized($item), value => escape($value),
				isFlag => $item->{type} eq 'flag', isIPList => $item->{type} eq 'iplist',
				isNumber => $item->{type} eq 'uint', isReadonly => $item->{type} eq 'readonly',
				isText => $item->{type} =~ /^(?:raw|path)$/ ? 1 : 0,
				onSelected => lc($value) eq 'on', offSelected => lc($value) ne 'on',
			};
		}
		push @sections, { title => $LANGPARAM eq 'ja' ? $section->{ja} : $section->{en}, rows => \@rows };
	}
	my @readonly;
	foreach my $key (qw(TfUseSession TfSessionTimeOut)) {
		push @readonly, { key => $key, value => escape(defined $values{$key} ? $values{$key} : $READONLY_DEFAULT{$key}) };
	}

	my $template = findTemplateFile($TEMPLATE_NAME);
	my $fh;
	if (!open($fh, '<', $template)) {
		TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
		return;
	}
	binmode($fh, ':utf8');
	my $html = HTML::Template->new(filehandle => $fh, case_sensitive => 1, die_on_bad_params => 0);
	$html->param(brandname => $BRAND, tfversion => $TF_VERSION, backUri => $SETTINGS_URI,
		token => $TF_TOKEN, status => $status, sections => \@sections, readonly => \@readonly);
	print $cgi->header(-charset => 'utf-8');
	print $html->output;
	close($fh);
}

sub validateValue {
	my ($item, $value) = @_;
	return 0 if $value =~ /[\r\n\0]/;
	return 0 if $value eq '' && $item->{type} eq 'uint';
	return 1 if $value eq '';
	return $value =~ /^(?:on|off)$/i if $item->{type} eq 'flag';
	return $value =~ /^\d+$/ && $value <= 2147483647 if $item->{type} eq 'uint';
	return isValidIPList($value) if $item->{type} eq 'iplist';
	return $value !~ /#/ if $item->{type} eq 'path';
	return $value !~ /#/;
}

sub formatValue {
	my ($item, $value) = @_;
	return $value if $item->{type} =~ /^(?:raw|iplist)$/;
	return quoteApacheValue($value);
}

sub readDirectiveFile {
	my ($path, $values) = @_;
	return if !$path || !-f $path || !open(my $fh, '<', $path);
	while (my $line = <$fh>) {
		$line =~ s/^\s+|\s+$//g;
		next if $line eq '' || $line =~ /^#/;
		next if $line !~ /^([A-Za-z][A-Za-z0-9]*)\s+(.+?)\s*$/;
		my ($key, $value) = ($1, $2);
		next if !isKnownDirective($key);
		$value =~ s/\s+#.*$//;
		$value =~ s/^"(.*)"$/$1/;
		$value =~ s/^'(.*)'$/$1/;
		if ($key eq 'TfFailedLoginControl') {
			my @parts = split(/\s+/, $value);
			$values->{TfFailedLoginLimit} = $parts[0] if defined $parts[0];
			$values->{TfFailedLoginUnlockTime} = $parts[1] if defined $parts[1];
			$values->{TfFailedLoginRetryCount} = $parts[2] if defined $parts[2];
		} else {
			$values->{$key} = $value;
		}
	}
	close($fh);
}

sub isKnownDirective {
	my $key = shift;
	return 1 if $key eq 'TfFailedLoginControl';
	return 1 if exists $READONLY_DEFAULT{$key};
	foreach my $item (@FIELDS) { return 1 if $item->{key} eq $key; }
	return 0;
}

sub normalizeIPList {
	my $raw = shift || '';
	my %seen;
	my @tokens;
	foreach my $token (split(/[\s,]+/, $raw)) {
		next if $token eq '' || $seen{$token};
		$seen{$token} = 1;
		push @tokens, $token;
	}
	return join(' ', @tokens);
}

sub isValidIPList {
	my $raw = shift || '';
	return 1 if $raw eq '';
	foreach my $token (split(/\s+/, $raw)) { return 0 if !isValidIPCidr($token); }
	return 1;
}

sub isValidIPCidr {
	my $token = shift || '';
	my ($addr, $prefix) = split(/\//, $token, 2);
	return 0 if $addr eq '' || $token =~ m{//};
	if ($addr =~ /:/) {
		return 0 if $addr !~ /^[0-9A-Fa-f:.]+$/;
		return 0 if defined $prefix && ($prefix !~ /^\d+$/ || $prefix > 128);
		return 1;
	}
	return 0 if $addr !~ /^(\d{1,3}\.){3}\d{1,3}$/;
	foreach my $octet (split(/\./, $addr)) { return 0 if $octet > 255; }
	return 0 if defined $prefix && ($prefix !~ /^\d+$/ || $prefix > 32);
	return 1;
}

sub localized { my $item = shift; return $LANGPARAM eq 'ja' ? $item->{ja} : $item->{en}; }
sub escape {
	my $value = defined $_[0] ? $_[0] : '';
	return '0' if $value eq '0';
	return scalar TF::CommonUtils::escapeHTML($value, 0);
}

sub quoteApacheValue {
	my $value = shift;
	if ($value =~ /[\s"#]/) {
		$value =~ s/\\/\\\\/g;
		$value =~ s/"/\\"/g;
		return '"' . $value . '"';
	}
	return $value;
}

sub mkdirParents {
	my $dir = shift;
	my $path = '';
	foreach my $part (split(/\//, $dir)) {
		next if $part eq '';
		$path .= '/' . $part;
		next if -d $path;
		return 0 if !mkdir($path);
		chmod(0777, $path);
	}
	return 1;
}

sub findTemplateFile {
	my $name = shift;
	foreach my $path ("./tmpl/$name", "../tmpl/$name") { return $path if -f $path; }
	return "./tmpl/$name";
}
